diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 21 | ||||
| -rw-r--r-- | gcc/ada/clean.adb | 64 | ||||
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/gnatcmd.adb | 79 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 96 | ||||
| -rw-r--r-- | gcc/ada/mlib-prj.adb | 73 | ||||
| -rw-r--r-- | gcc/ada/prj-env.adb | 165 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 114 | ||||
| -rw-r--r-- | gcc/ada/prj.ads | 19 |
9 files changed, 340 insertions, 306 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8a097f4..40d738e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,26 @@ 2009-06-24 Javier Miranda <miranda@adacore.com> + * exp_ch4.adb (Expand_N_Type_Conversion): Handle entities that are + visible through limited-with context clauses. In addition, avoid an + extra tag check that is not required when the class-wide + designated types of the operand and target types are + the same entity. + (Tagged_Membership): Handle entities from the limited view. + +2009-06-24 Emmanuel Briot <briot@adacore.com> + + * gnatcmd.adb, make.adb, mlib-prj.adb, prj.ads, clean.adb, + prj-nmsc.adb, prj-env.adb (File_Name_Data): removed + (Spec_Or_Body): now a subtype of Source_Kind, to avoid using two + different vocabularies for similar concepts (Impl/Body_Part and + Spec/Specification). + (Unit_Data): now points directly to a Source_Id, rather than duplicating + some of the information in File_Name_Data. This also saves a bit of + memory. However, since we are now using a pointer we need to test + for null explicitly in several places of the code + +2009-06-24 Javier Miranda <miranda@adacore.com> + * exp_ch4.adb (Expand_N_Type_Conversion): return immediately from processing the type conversion when the node is replaced by an N_Raise_Program_Error node. diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 2c08d49..933a97b 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -577,22 +577,23 @@ package body Clean is loop Unit := Project_Tree.Units.Table (Index); - if Ultimate_Extending_Project_Of - (Unit.File_Names (Body_Part).Project) = Project + if Unit.File_Names (Impl) /= null + and then Ultimate_Extending_Project_Of + (Unit.File_Names (Impl).Project) = Project and then - Get_Name_String - (Unit.File_Names (Body_Part).Name) = - Name (1 .. Last) + Get_Name_String (Unit.File_Names (Impl).File) + = Name (1 .. Last) then Delete_File := True; exit; end if; - if Ultimate_Extending_Project_Of - (Unit.File_Names (Specification).Project) = Project + if Unit.File_Names (Spec) /= null + and then Ultimate_Extending_Project_Of + (Unit.File_Names (Spec).Project) = Project and then Get_Name_String - (Unit.File_Names (Specification).Name) = + (Unit.File_Names (Spec).File) = Name (1 .. Last) then Delete_File := True; @@ -741,15 +742,16 @@ package body Clean is loop Unit := Project_Tree.Units.Table (Index); - if Unit.File_Names (Body_Part).Project /= + if Unit.File_Names (Impl) /= null + and then Unit.File_Names (Impl).Project /= No_Project then if Ultimate_Extending_Project_Of - (Unit.File_Names (Body_Part).Project) = + (Unit.File_Names (Impl).Project) = Project then Get_Name_String - (Unit.File_Names (Body_Part).Name); + (Unit.File_Names (Impl).File); Name_Len := Name_Len - File_Extension (Name (1 .. Name_Len))'Length; @@ -761,12 +763,13 @@ package body Clean is end if; end if; - elsif Ultimate_Extending_Project_Of - (Unit.File_Names (Specification).Project) = + elsif Unit.File_Names (Spec) /= null + and then Ultimate_Extending_Project_Of + (Unit.File_Names (Spec).Project) = Project then Get_Name_String - (Unit.File_Names (Specification).Name); + (Unit.File_Names (Spec).File); Name_Len := Name_Len - File_Extension (Name (1 .. Name_Len))'Length; @@ -887,16 +890,33 @@ package body Clean is -- project, check for the corresponding ALI file in the -- object directory. - if In_Extension_Chain - (U_Data.File_Names (Body_Part).Project, Project) + if (U_Data.File_Names (Impl) /= null + and then + In_Extension_Chain + (U_Data.File_Names (Impl).Project, Project)) or else - In_Extension_Chain - (U_Data.File_Names (Specification).Project, Project) + (U_Data.File_Names (Spec) /= null + and then In_Extension_Chain + (U_Data.File_Names + (Spec).Project, Project)) then - File_Name1 := U_Data.File_Names (Body_Part).Name; - Index1 := U_Data.File_Names (Body_Part).Index; - File_Name2 := U_Data.File_Names (Specification).Name; - Index2 := U_Data.File_Names (Specification).Index; + if U_Data.File_Names (Impl) /= null then + File_Name1 := U_Data.File_Names (Impl).File; + Index1 := U_Data.File_Names (Impl).Index; + else + File_Name1 := No_File; + Index1 := 0; + end if; + + if U_Data.File_Names (Spec) /= null then + File_Name2 := + U_Data.File_Names (Spec).File; + Index2 := + U_Data.File_Names (Spec).Index; + else + File_Name2 := No_File; + Index2 := 0; + end if; -- If there is no body file name, then there may be -- only a spec. diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 1862cb5..9c124ad 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -7955,9 +7955,13 @@ package body Exp_Ch4 is begin if Is_Access_Type (Target_Type) then - Actual_Op_Typ := Designated_Type (Operand_Type); - Actual_Targ_Typ := Designated_Type (Target_Type); + -- Handle entities from the limited view + + Actual_Op_Typ := + Available_View (Designated_Type (Operand_Type)); + Actual_Targ_Typ := + Available_View (Designated_Type (Target_Type)); else Actual_Op_Typ := Operand_Type; Actual_Targ_Typ := Target_Type; @@ -7978,6 +7982,7 @@ package body Exp_Ch4 is -- conversion. if Is_Class_Wide_Type (Actual_Op_Typ) + and then Actual_Op_Typ /= Actual_Targ_Typ and then Root_Op_Typ /= Actual_Targ_Typ and then Is_Ancestor (Root_Op_Typ, Actual_Targ_Typ) then @@ -9486,8 +9491,10 @@ package body Exp_Ch4 is Obj_Tag : Node_Id; begin - Left_Type := Etype (Left); - Right_Type := Etype (Right); + -- Handle entities from the limited view + + Left_Type := Available_View (Etype (Left)); + Right_Type := Available_View (Etype (Right)); if Is_Class_Wide_Type (Left_Type) then Left_Type := Root_Type (Left_Type); diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 3f5bb6d..5b86cf6 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -418,21 +418,18 @@ procedure GNATCmd is -- spec, but not the subunits. if The_Command = List then - if - Unit_Data.File_Names (Body_Part).Name /= No_File - and then - Unit_Data.File_Names (Body_Part).Path.Name /= Slash + if Unit_Data.File_Names (Impl) /= null + and then Unit_Data.File_Names (Impl).Path.Name /= Slash then -- There is a body, check if it is for this project if All_Projects or else - Unit_Data.File_Names (Body_Part).Project = Project + Unit_Data.File_Names (Impl).Project = Project then Subunit := False; - if Unit_Data.File_Names (Specification).Name = No_File - or else Unit_Data.File_Names - (Specification).Path.Name = Slash + if Unit_Data.File_Names (Spec) = null + or else Unit_Data.File_Names (Spec).Path.Name = Slash then -- We have a body with no spec: we need to check if -- this is a subunit, because gnatls will complain @@ -443,7 +440,7 @@ procedure GNATCmd is Sinput.P.Load_Project_File (Get_Name_String (Unit_Data.File_Names - (Body_Part).Path.Name)); + (Impl).Path.Name)); begin Subunit := Sinput.P.Source_File_Is_Subunit (Src_Ind); @@ -456,27 +453,25 @@ procedure GNATCmd is new String' (Get_Name_String (Unit_Data.File_Names - (Body_Part).Display_Name)); + (Impl).Display_File)); end if; end if; - elsif - Unit_Data.File_Names (Specification).Name /= No_File - and then - Unit_Data.File_Names (Specification).Path.Name /= Slash + elsif Unit_Data.File_Names (Spec) /= null + and then Unit_Data.File_Names (Spec).Path.Name /= Slash then -- We have a spec with no body. Check if it is for this -- project. if All_Projects or else - Unit_Data.File_Names (Specification).Project = Project + Unit_Data.File_Names (Spec).Project = Project then Last_Switches.Increment_Last; Last_Switches.Table (Last_Switches.Last) := new String' (Get_Name_String (Unit_Data.File_Names - (Specification).Display_Name)); + (Spec).Display_File)); end if; end if; @@ -486,21 +481,19 @@ procedure GNATCmd is -- but not the subunits. elsif The_Command = Stack then - if Unit_Data.File_Names (Body_Part).Name /= No_File - and then - Unit_Data.File_Names (Body_Part).Path.Name /= Slash + if Unit_Data.File_Names (Impl) /= null + and then Unit_Data.File_Names (Impl).Path.Name /= Slash then -- There is a body. Check if .ci files for this project -- must be added. if Check_Project - (Unit_Data.File_Names (Body_Part).Project, Project) + (Unit_Data.File_Names (Impl).Project, Project) then Subunit := False; - if Unit_Data.File_Names (Specification).Name = No_File - or else Unit_Data.File_Names - (Specification).Path.Name = Slash + if Unit_Data.File_Names (Spec) = null + or else Unit_Data.File_Names (Spec).Path.Name = Slash then -- We have a body with no spec: we need to check -- if this is a subunit, because .ci files are not @@ -511,7 +504,7 @@ procedure GNATCmd is Sinput.P.Load_Project_File (Get_Name_String (Unit_Data.File_Names - (Body_Part).Path.Name)); + (Impl).Path.Name)); begin Subunit := Sinput.P.Source_File_Is_Subunit (Src_Ind); @@ -524,40 +517,37 @@ procedure GNATCmd is new String' (Get_Name_String (Unit_Data.File_Names - (Body_Part).Project. + (Impl).Project. Object_Directory.Name) & Directory_Separator & MLib.Fil.Ext_To (Get_Name_String (Unit_Data.File_Names - (Body_Part).Display_Name), + (Impl).Display_File), "ci")); end if; end if; - elsif Unit_Data.File_Names (Specification).Name /= No_File - and then - Unit_Data.File_Names (Specification).Path.Name /= Slash + elsif Unit_Data.File_Names (Spec) /= null + and then Unit_Data.File_Names (Spec).Path.Name /= Slash then -- We have a spec with no body. Check if it is for this -- project. if Check_Project - (Unit_Data.File_Names (Specification).Project, - Project) + (Unit_Data.File_Names (Spec).Project, Project) then Last_Switches.Increment_Last; Last_Switches.Table (Last_Switches.Last) := new String' (Get_Name_String (Unit_Data.File_Names - (Specification).Project. + (Spec).Project. Object_Directory.Name) & Dir_Separator & MLib.Fil.Ext_To (Get_Name_String - (Unit_Data.File_Names - (Specification).Name), + (Unit_Data.File_Names (Spec).File), "ci")); end if; end if; @@ -568,14 +558,13 @@ procedure GNATCmd is -- specified. for Kind in Spec_Or_Body loop - if Check_Project - (Unit_Data.File_Names (Kind).Project, Project) - and then Unit_Data.File_Names (Kind).Name /= No_File + if Unit_Data.File_Names (Kind) /= null + and then Check_Project + (Unit_Data.File_Names (Kind).Project, Project) and then Unit_Data.File_Names (Kind).Path.Name /= Slash then Get_Name_String - (Unit_Data.File_Names - (Kind).Path.Display_Name); + (Unit_Data.File_Names (Kind).Path.Display_Name); if FD /= Invalid_FD then Name_Len := Name_Len + 1; @@ -833,20 +822,20 @@ procedure GNATCmd is loop Udata := Project_Tree.Units.Table (Unit); - if Udata.File_Names (Specification).Name /= No_File + if Udata.File_Names (Spec) /= null and then - Get_Name_String (Udata.File_Names (Specification).Name) = + Get_Name_String (Udata.File_Names (Spec).File) = Line (1 .. Last) then - Path := Udata.File_Names (Specification).Path.Name; + Path := Udata.File_Names (Spec).Path.Name; exit; - elsif Udata.File_Names (Body_Part).Name /= No_File + elsif Udata.File_Names (Impl) /= null and then - Get_Name_String (Udata.File_Names (Body_Part).Name) = + Get_Name_String (Udata.File_Names (Impl).File) = Line (1 .. Last) then - Path := Udata.File_Names (Body_Part).Path.Name; + Path := Udata.File_Names (Impl).Path.Name; exit; end if; end loop; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index d1bfec9..fcbe4fe 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -1473,8 +1473,11 @@ package body Make is if UID /= Prj.No_Unit_Index then U_Data := Project_Tree.Units.Table (UID); - if U_Data.File_Names (Body_Part).Name /= Sfile - and then U_Data.File_Names (Specification).Name /= Sfile + if (U_Data.File_Names (Impl) = null + or else U_Data.File_Names (Impl).File /= Sfile) + and then + (U_Data.File_Names (Spec) = null + or else U_Data.File_Names (Spec).File /= Sfile) then Verbose_Msg (Uname, "sources do not include ", Name_Id (Sfile)); return True; @@ -1945,15 +1948,18 @@ package body Make is for U in 1 .. Unit_Table.Last (Project_Tree.Units) loop Udata := Project_Tree.Units.Table (U); - if Udata.File_Names (Body_Part).Name = Source_File then - ALI_Project := Udata.File_Names (Body_Part).Project; + if Udata.File_Names (Impl) /= null + and then Udata.File_Names (Impl).File = Source_File + then + ALI_Project := Udata.File_Names (Impl).Project; exit; - elsif - Udata.File_Names (Specification).Name = Source_File + elsif Udata.File_Names (Spec) /= null + and then Udata.File_Names (Spec).File = + Source_File then ALI_Project := - Udata.File_Names (Specification).Project; + Udata.File_Names (Spec).Project; exit; end if; end loop; @@ -2053,16 +2059,20 @@ package body Make is UID in 1 .. Unit_Table.Last (Project_Tree.Units) loop if Project_Tree.Units.Table (UID). - File_Names (Body_Part).Name = Dep.Sfile + File_Names (Impl) /= null + and then Project_Tree.Units.Table (UID). + File_Names (Impl).File = Dep.Sfile then Proj := Project_Tree.Units.Table (UID). - File_Names (Body_Part).Project; + File_Names (Impl).Project; elsif Project_Tree.Units.Table (UID). - File_Names (Specification).Name = Dep.Sfile + File_Names (Spec) /= null + and then Project_Tree.Units.Table (UID). + File_Names (Spec).File = Dep.Sfile then Proj := Project_Tree.Units.Table (UID). - File_Names (Specification).Project; + File_Names (Spec).Project; end if; -- If a source is in a project, check if it is one @@ -3608,28 +3618,24 @@ package body Make is if Uid /= Prj.No_Unit_Index then Udata := Project_Tree.Units.Table (Uid); - if - Udata.File_Names (Body_Part).Name /= - No_File + if Udata.File_Names (Impl) /= null and then - Udata.File_Names (Body_Part).Path.Name /= + Udata.File_Names (Impl).Path.Name /= Slash then - Sfile := Udata.File_Names (Body_Part).Name; + Sfile := Udata.File_Names (Impl).File; Source_Index := - Udata.File_Names (Body_Part).Index; + Udata.File_Names (Impl).Index; - elsif - Udata.File_Names (Specification).Name /= - No_File + elsif Udata.File_Names (Spec) /= null and then Udata.File_Names - (Specification).Path.Name /= Slash + (Spec).Path.Name /= Slash then Sfile := - Udata.File_Names (Specification).Name; + Udata.File_Names (Spec).File; Source_Index := - Udata.File_Names (Specification).Index; + Udata.File_Names (Spec).Index; end if; end if; end; @@ -4400,8 +4406,8 @@ package body Make is -- If there is a body, put it in the mapping - if Unit.File_Names (Body_Part).Name /= No_File - and then Unit.File_Names (Body_Part).Project /= + if Unit.File_Names (Impl) /= No_Source + and then Unit.File_Names (Impl).Project /= No_Project then Get_Name_String (Unit.Name); @@ -4409,14 +4415,14 @@ package body Make is ALI_Unit := Name_Find; ALI_Name := Lib_File_Name - (Unit.File_Names (Body_Part).Display_Name); - ALI_Project := Unit.File_Names (Body_Part).Project; + (Unit.File_Names (Impl).Display_File); + ALI_Project := Unit.File_Names (Impl).Project; -- Otherwise, if there is a spec, put it in the -- mapping. - elsif Unit.File_Names (Specification).Name /= No_File - and then Unit.File_Names (Specification).Project /= + elsif Unit.File_Names (Spec) /= No_Source + and then Unit.File_Names (Spec).Project /= No_Project then Get_Name_String (Unit.Name); @@ -4424,8 +4430,8 @@ package body Make is ALI_Unit := Name_Find; ALI_Name := Lib_File_Name - (Unit.File_Names (Specification).Display_Name); - ALI_Project := Unit.File_Names (Specification).Project; + (Unit.File_Names (Spec).Display_File); + ALI_Project := Unit.File_Names (Spec).Project; else ALI_Name := No_File; @@ -7014,17 +7020,17 @@ package body Make is -- If there is a source for the body, and the body has not been -- locally removed. - if Unit.File_Names (Body_Part).Name /= No_File - and then Unit.File_Names (Body_Part).Path.Name /= Slash + if Unit.File_Names (Impl) /= null + and then Unit.File_Names (Impl).Path.Name /= Slash then -- And it is a source for the specified project - if Check_Project (Unit.File_Names (Body_Part).Project) then + if Check_Project (Unit.File_Names (Impl).Project) then -- If we don't have a spec, we cannot consider the source -- if it is a subunit. - if Unit.File_Names (Specification).Name = No_File then + if Unit.File_Names (Spec) = null then declare Src_Ind : Source_File_Index; @@ -7042,7 +7048,7 @@ package body Make is begin Src_Ind := Sinput.P.Load_Project_File (Get_Name_String - (Unit.File_Names (Body_Part).Path.Name)); + (Unit.File_Names (Impl).Path.Name)); -- If it is a subunit, discard it @@ -7050,27 +7056,27 @@ package body Make is Sfile := No_File; Index := 0; else - Sfile := Unit.File_Names (Body_Part).Display_Name; - Index := Unit.File_Names (Body_Part).Index; + Sfile := Unit.File_Names (Impl).Display_File; + Index := Unit.File_Names (Impl).Index; end if; end; else - Sfile := Unit.File_Names (Body_Part).Display_Name; - Index := Unit.File_Names (Body_Part).Index; + Sfile := Unit.File_Names (Impl).Display_File; + Index := Unit.File_Names (Impl).Index; end if; end if; - elsif Unit.File_Names (Specification).Name /= No_File - and then Unit.File_Names (Specification).Path.Name /= Slash - and then Check_Project (Unit.File_Names (Specification).Project) + elsif Unit.File_Names (Spec) /= null + and then Unit.File_Names (Spec).Path.Name /= Slash + and then Check_Project (Unit.File_Names (Spec).Project) then -- If there is no source for the body, but there is a source -- for the spec which has not been locally removed, then we take -- this one. - Sfile := Unit.File_Names (Specification).Display_Name; - Index := Unit.File_Names (Specification).Index; + Sfile := Unit.File_Names (Spec).Display_File; + Index := Unit.File_Names (Spec).Index; end if; -- If Put_In_Q is True, we insert into the Q diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 67d9330..42b1ba6 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -948,21 +948,20 @@ package body MLib.Prj is loop Unit := In_Tree.Units.Table (Source); - if Unit.File_Names (Body_Part).Name /= No_File - and then Unit.File_Names (Body_Part).Path.Name /= Slash + if Unit.File_Names (Impl) /= null + and then Unit.File_Names (Impl).Path.Name /= Slash then if - Check_Project (Unit.File_Names (Body_Part).Project) + Check_Project (Unit.File_Names (Impl).Project) then - if Unit.File_Names (Specification).Name = No_File then + if Unit.File_Names (Spec) = null then declare Src_Ind : Source_File_Index; begin Src_Ind := Sinput.P.Load_Project_File (Get_Name_String - (Unit.File_Names - (Body_Part).Path.Name)); + (Unit.File_Names (Impl).Path.Name)); -- Add the ALI file only if it is not a subunit @@ -970,23 +969,23 @@ package body MLib.Prj is Sinput.P.Source_File_Is_Subunit (Src_Ind) then Add_ALI_For - (Unit.File_Names (Body_Part).Name); + (Unit.File_Names (Impl).File); exit when not Bind; end if; end; else - Add_ALI_For (Unit.File_Names (Body_Part).Name); + Add_ALI_For (Unit.File_Names (Impl).File); exit when not Bind; end if; end if; - elsif Unit.File_Names (Specification).Name /= No_File - and then Unit.File_Names (Specification).Path.Name /= Slash + elsif Unit.File_Names (Spec) /= null + and then Unit.File_Names (Spec).Path.Name /= Slash and then Check_Project - (Unit.File_Names (Specification).Project) + (Unit.File_Names (Spec).Project) then - Add_ALI_For (Unit.File_Names (Specification).Name); + Add_ALI_For (Unit.File_Names (Spec).File); exit when not Bind; end if; end loop; @@ -1424,30 +1423,29 @@ package body MLib.Prj is loop if In_Tree.Units.Table (Index).File_Names - (Body_Part).Name /= No_File + (Impl) /= null then Proj := In_Tree.Units.Table (Index). File_Names - (Body_Part).Project; + (Impl).Project; Fname := In_Tree.Units.Table (Index). - File_Names (Body_Part).Name; + File_Names (Impl).File; elsif In_Tree.Units.Table (Index).File_Names - (Specification).Name /= - No_File + (Spec) /= null then Proj := In_Tree.Units.Table (Index).File_Names - (Specification).Project; + (Spec).Project; Fname := In_Tree.Units.Table (Index).File_Names - (Specification).Name; + (Spec).File; else Proj := No_Project; @@ -1842,15 +1840,16 @@ package body MLib.Prj is loop Unit := In_Tree.Units.Table (Index); - if Unit.File_Names (Body_Part).Project /= + if Unit.File_Names (Impl) /= null + and then Unit.File_Names (Impl).Project /= No_Project then if Ultimate_Extending_Project_Of - (Unit.File_Names (Body_Part).Project) = + (Unit.File_Names (Impl).Project) = For_Project then Get_Name_String - (Unit.File_Names (Body_Part).Name); + (Unit.File_Names (Impl).File); Name_Len := Name_Len - File_Extension (Name (1 .. Name_Len))'Length; @@ -1862,12 +1861,13 @@ package body MLib.Prj is end if; end if; - elsif Ultimate_Extending_Project_Of - (Unit.File_Names (Specification).Project) = - For_Project + elsif Unit.File_Names (Spec) /= null + and then Ultimate_Extending_Project_Of + (Unit.File_Names (Spec).Project) = + For_Project then Get_Name_String - (Unit.File_Names (Specification).Name); + (Unit.File_Names (Spec).File); Name_Len := Name_Len - File_Extension @@ -1983,23 +1983,25 @@ package body MLib.Prj is for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop Unit := In_Tree.Units.Table (Index); - if Ultimate_Extending_Project_Of - (Unit.File_Names (Body_Part).Project) = For_Project + if Unit.File_Names (Impl) /= null + and then Ultimate_Extending_Project_Of + (Unit.File_Names (Impl).Project) = For_Project and then Get_Name_String - (Unit.File_Names (Body_Part).Name) = + (Unit.File_Names (Impl).File) = Name (1 .. Last) then Delete := True; exit; end if; - if Ultimate_Extending_Project_Of - (Unit.File_Names (Specification).Project) = + if Unit.File_Names (Spec) /= null + and then Ultimate_Extending_Project_Of + (Unit.File_Names (Spec).Project) = For_Project and then Get_Name_String - (Unit.File_Names (Specification).Name) = + (Unit.File_Names (Spec).File) = Name (1 .. Last) then Delete := True; @@ -2193,9 +2195,10 @@ package body MLib.Prj is -- Find and copy the immediate or inherited source for J in Data.File_Names'Range loop - if Is_Same_Or_Extension - (For_Project, Data.File_Names (J).Project) - and then Data.File_Names (J).Name = File_Name + if Data.File_Names (J) /= null + and then Is_Same_Or_Extension + (For_Project, Data.File_Names (J).Project) + and then Data.File_Names (J).File = File_Name then Copy_File (Get_Name_String (Data.File_Names (J).Path.Name), diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 0a06975..1d135cf 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -598,7 +598,7 @@ package body Prj.Env is Put (File, "pragma Source_File_Name_Project ("); Put (File, Namet.Get_Name_String (Unit_Name)); - if Unit_Kind = Specification then + if Unit_Kind = Spec then Put (File, ", Spec_File_Name => """); else Put (File, ", Body_File_Name => """); @@ -681,18 +681,22 @@ package body Prj.Env is In_Tree.Units.Table (Current_Unit); begin - if Unit.File_Names (Specification).Needs_Pragma then + if Unit.File_Names (Spec) /= null + and then Unit.File_Names (Spec).Naming_Exception + then Put (Unit.Name, - Unit.File_Names (Specification).Name, - Specification, - Unit.File_Names (Specification).Index); + Unit.File_Names (Spec).File, + Spec, + Unit.File_Names (Spec).Index); end if; - if Unit.File_Names (Body_Part).Needs_Pragma then + if Unit.File_Names (Impl) /= null + and then Unit.File_Names (Impl).Naming_Exception + then Put (Unit.Name, - Unit.File_Names (Body_Part).Name, - Body_Part, - Unit.File_Names (Body_Part).Index); + Unit.File_Names (Impl).File, + Impl, + Unit.File_Names (Impl).Index); end if; Current_Unit := Current_Unit + 1; @@ -743,7 +747,7 @@ package body Prj.Env is procedure Create_Mapping (In_Tree : Project_Tree_Ref) is The_Unit_Data : Unit_Data; - Data : File_Name_Data; + Data : Source_Id; begin Fmap.Reset_Tables; @@ -754,32 +758,32 @@ package body Prj.Env is -- Process only if the unit has a valid name if The_Unit_Data.Name /= No_Name then - Data := The_Unit_Data.File_Names (Specification); + Data := The_Unit_Data.File_Names (Spec); -- If there is a spec, put it in the mapping - if Data.Name /= No_File then + if Data /= null then if Data.Path.Name = Slash then - Fmap.Add_Forbidden_File_Name (Data.Name); + Fmap.Add_Forbidden_File_Name (Data.File); else Fmap.Add_To_File_Map (Unit_Name => Unit_Name_Type (The_Unit_Data.Name), - File_Name => Data.Name, + File_Name => Data.File, Path_Name => File_Name_Type (Data.Path.Name)); end if; end if; - Data := The_Unit_Data.File_Names (Body_Part); + Data := The_Unit_Data.File_Names (Impl); -- If there is a body (or subunit) put it in the mapping - if Data.Name /= No_File then + if Data /= null then if Data.Path.Name = Slash then - Fmap.Add_Forbidden_File_Name (Data.Name); + Fmap.Add_Forbidden_File_Name (Data.File); else Fmap.Add_To_File_Map (Unit_Name => Unit_Name_Type (The_Unit_Data.Name), - File_Name => Data.Name, + File_Name => Data.File, Path_Name => File_Name_Type (Data.Path.Name)); end if; end if; @@ -807,7 +811,7 @@ package body Prj.Env is Source : Source_Id; Suffix : File_Name_Type; The_Unit_Data : Unit_Data; - Data : File_Name_Data; + Data : Source_Id; Iter : Source_Iterator; procedure Put_Name_Buffer; @@ -861,7 +865,7 @@ package body Prj.Env is -- Line with the file name - Get_Name_String (Data.Name); + Get_Name_String (Data.File); Put_Name_Buffer; -- Line with the path name @@ -928,23 +932,23 @@ package body Prj.Env is -- Case of unit has a valid name if The_Unit_Data.Name /= No_Name then - Data := The_Unit_Data.File_Names (Specification); + Data := The_Unit_Data.File_Names (Spec); -- If there is a spec, put it mapping in the file if it is -- from a project in the closure of Project. - if Data.Name /= No_File + if Data /= No_Source and then Project_Boolean_Htable.Get (Present, Data.Project) then Put_Data (Spec => True); end if; - Data := The_Unit_Data.File_Names (Body_Part); + Data := The_Unit_Data.File_Names (Impl); -- If there is a body (or subunit) put its mapping in the -- file if it is from a project in the closure of Project. - if Data.Name /= No_File + if Data /= No_Source and then Project_Boolean_Htable.Get (Present, Data.Project) then Put_Data (Spec => False); @@ -1160,16 +1164,18 @@ package body Prj.Env is -- Check for body if not Main_Project_Only - or else Unit.File_Names (Body_Part).Project = The_Project + or else + (Unit.File_Names (Impl) /= null + and then Unit.File_Names (Impl).Project = The_Project) then declare - Current_Name : constant File_Name_Type := - Unit.File_Names (Body_Part).Name; - + Current_Name : File_Name_Type; begin -- Case of a body present - if Current_Name /= No_File then + if Unit.File_Names (Impl) /= null then + Current_Name := Unit.File_Names (Impl).File; + if Current_Verbosity = High then Write_Str (" Comparing with """); Write_Str (Get_Name_String (Current_Name)); @@ -1190,7 +1196,7 @@ package body Prj.Env is if Full_Path then return Get_Name_String - (Unit.File_Names (Body_Part).Path.Name); + (Unit.File_Names (Impl).Path.Name); else return Get_Name_String (Current_Name); @@ -1206,7 +1212,7 @@ package body Prj.Env is if Full_Path then return Get_Name_String - (Unit.File_Names (Body_Part).Path.Name); + (Unit.File_Names (Impl).Path.Name); else return Extended_Body_Name; @@ -1224,16 +1230,19 @@ package body Prj.Env is -- Check for spec if not Main_Project_Only - or else Unit.File_Names (Specification).Project = The_Project + or else + (Unit.File_Names (Spec) /= null + and then Unit.File_Names (Spec).Project = + The_Project) then declare - Current_Name : constant File_Name_Type := - Unit.File_Names (Specification).Name; + Current_Name : File_Name_Type; begin -- Case of spec present - if Current_Name /= No_File then + if Unit.File_Names (Spec) /= null then + Current_Name := Unit.File_Names (Spec).File; if Current_Verbosity = High then Write_Str (" Comparing with """); Write_Str (Get_Name_String (Current_Name)); @@ -1253,7 +1262,7 @@ package body Prj.Env is if Full_Path then return Get_Name_String - (Unit.File_Names (Specification).Path.Name); + (Unit.File_Names (Spec).Path.Name); else return Get_Name_String (Current_Name); end if; @@ -1268,7 +1277,7 @@ package body Prj.Env is if Full_Path then return Get_Name_String - (Unit.File_Names (Specification).Path.Name); + (Unit.File_Names (Spec).Path.Name); else return Extended_Spec_Name; end if; @@ -1406,40 +1415,43 @@ package body Prj.Env is loop Unit := In_Tree.Units.Table (Id); - if (Unit.File_Names (Specification).Name /= No_File - and then - Namet.Get_Name_String - (Unit.File_Names (Specification).Name) = Original_Name) - or else (Unit.File_Names (Specification).Path /= - No_Path_Information - and then - Namet.Get_Name_String - (Unit.File_Names (Specification).Path.Name) = - Original_Name) + if Unit.File_Names (Spec) /= null + and then Unit.File_Names (Spec).File /= No_File + and then + (Namet.Get_Name_String + (Unit.File_Names (Spec).File) = Original_Name + or else (Unit.File_Names (Spec).Path /= + No_Path_Information + and then + Namet.Get_Name_String + (Unit.File_Names (Spec).Path.Name) = + Original_Name)) then Project := Ultimate_Extension_Of - (Project => Unit.File_Names (Specification).Project); - Path := Unit.File_Names (Specification).Path.Display_Name; + (Project => Unit.File_Names (Spec).Project); + Path := Unit.File_Names (Spec).Path.Display_Name; if Current_Verbosity > Default then - Write_Str ("Done: Specification."); + Write_Str ("Done: Spec."); Write_Eol; end if; return; - elsif (Unit.File_Names (Body_Part).Name /= No_File - and then - Namet.Get_Name_String - (Unit.File_Names (Body_Part).Name) = Original_Name) - or else (Unit.File_Names (Body_Part).Path /= No_Path_Information - and then Namet.Get_Name_String - (Unit.File_Names (Body_Part).Path.Name) = - Original_Name) + elsif Unit.File_Names (Impl) /= null + and then Unit.File_Names (Impl).File /= No_File + and then + (Namet.Get_Name_String + (Unit.File_Names (Impl).File) = Original_Name + or else (Unit.File_Names (Impl).Path /= + No_Path_Information + and then Namet.Get_Name_String + (Unit.File_Names (Impl).Path.Name) = + Original_Name)) then Project := Ultimate_Extension_Of - (Project => Unit.File_Names (Body_Part).Project); - Path := Unit.File_Names (Body_Part).Path.Display_Name; + (Project => Unit.File_Names (Impl).Project); + Path := Unit.File_Names (Impl).Path.Display_Name; if Current_Verbosity > Default then Write_Str ("Done: Body."); @@ -1490,38 +1502,37 @@ package body Prj.Env is Write_Str (" "); Write_Line (Namet.Get_Name_String (Unit.Name)); - if Unit.File_Names (Specification).Name /= No_File then - if Unit.File_Names (Specification).Project = No_Project then + if Unit.File_Names (Spec).File /= No_File then + if Unit.File_Names (Spec).Project = No_Project then Write_Line (" No project"); else Write_Str (" Project: "); Get_Name_String - (Unit.File_Names (Specification).Project.Path.Name); + (Unit.File_Names (Spec).Project.Path.Name); Write_Line (Name_Buffer (1 .. Name_Len)); end if; Write_Str (" spec: "); Write_Line (Namet.Get_Name_String - (Unit.File_Names (Specification).Name)); + (Unit.File_Names (Spec).File)); end if; - if Unit.File_Names (Body_Part).Name /= No_File then - if Unit.File_Names (Body_Part).Project = No_Project then + if Unit.File_Names (Impl).File /= No_File then + if Unit.File_Names (Impl).Project = No_Project then Write_Line (" No project"); else Write_Str (" Project: "); Get_Name_String - (Unit.File_Names (Body_Part).Project.Path.Name); + (Unit.File_Names (Impl).Project.Path.Name); Write_Line (Name_Buffer (1 .. Name_Len)); end if; Write_Str (" body: "); Write_Line - (Namet.Get_Name_String - (Unit.File_Names (Body_Part).Name)); + (Namet.Get_Name_String (Unit.File_Names (Impl).File)); end if; end loop; @@ -1574,13 +1585,10 @@ package body Prj.Env is loop Unit := In_Tree.Units.Table (Current); - -- Check for body - - Current_Name := Unit.File_Names (Body_Part).Name; - -- Case of a body present - if Current_Name /= No_File then + if Unit.File_Names (Impl) /= null then + Current_Name := Unit.File_Names (Impl).File; -- If it has the name of the original name or the body name, -- we have found the project. @@ -1589,16 +1597,15 @@ package body Prj.Env is or else Current_Name = The_Original_Name or else Current_Name = The_Body_Name then - Result := Unit.File_Names (Body_Part).Project; + Result := Unit.File_Names (Impl).Project; exit; end if; end if; -- Check for spec - Current_Name := Unit.File_Names (Specification).Name; - - if Current_Name /= No_File then + if Unit.File_Names (Spec) /= null then + Current_Name := Unit.File_Names (Spec).File; -- If name same as the original name, or the spec name, we have -- found the project. @@ -1607,7 +1614,7 @@ package body Prj.Env is or else Current_Name = The_Original_Name or else Current_Name = The_Spec_Name then - Result := Unit.File_Names (Specification).Project; + Result := Unit.File_Names (Spec).Project; exit; end if; end if; diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index b6ec4fe..a203f83 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -850,9 +850,9 @@ package body Prj.Nmsc is if Get_Mode = Ada_Only then Prepare_Ada_Naming_Exceptions - (Project.Naming.Bodies, In_Tree, Body_Part); + (Project.Naming.Bodies, In_Tree, Impl); Prepare_Ada_Naming_Exceptions - (Project.Naming.Specs, In_Tree, Specification); + (Project.Naming.Specs, In_Tree, Spec); end if; -- Find the sources @@ -1702,7 +1702,7 @@ package body Prj.Nmsc is if Lang_Index /= No_Language_Index then case Current_Array.Name is - when Name_Specification_Suffix | Name_Spec_Suffix => + when Name_Spec_Suffix | Name_Specification_Suffix => -- Attribute Spec_Suffix (<language>) @@ -2978,7 +2978,7 @@ package body Prj.Nmsc is if Exceptions = No_Array_Element then Exceptions := Value_Of - (Name_Specification, + (Name_Spec, In_Arrays => Naming.Decl.Arrays, In_Tree => In_Tree); end if; @@ -3282,7 +3282,7 @@ package body Prj.Nmsc is if Suffix = Nil_Variable_Value then Suffix := Value_Of (Name => Lang, - Attribute_Or_Array_Name => Name_Specification_Suffix, + Attribute_Or_Array_Name => Name_Spec_Suffix, In_Package => Naming_Id, In_Tree => In_Tree); end if; @@ -4133,7 +4133,7 @@ package body Prj.Nmsc is Suffix := Element.Next; end loop; - -- Put the resulting array as the specification suffixes + -- Put the resulting array as the Spec suffixes Project.Naming.Spec_Suffix := Spec_Suffixs; end if; @@ -4541,22 +4541,20 @@ package body Prj.Nmsc is UData := In_Tree.Units.Table (The_Unit_Id); - if UData.File_Names (Body_Part).Name /= No_File + if UData.File_Names (Impl) /= null and then - UData.File_Names (Body_Part).Path.Name /= + UData.File_Names (Impl).Path.Name /= Slash then if Check_Project - (UData.File_Names (Body_Part).Project, + (UData.File_Names (Impl).Project, Project, Extending) then -- There is a body for this unit. -- If there is no spec, we need to check that it -- is not a subunit. - if UData.File_Names (Specification).Name = - No_File - then + if UData.File_Names (Spec) = null then declare Src_Ind : Source_File_Index; @@ -4564,7 +4562,7 @@ package body Prj.Nmsc is Src_Ind := Sinput.P.Load_Project_File (Get_Name_String (UData.File_Names - (Body_Part).Path.Name)); + (Impl).Path.Name)); if Sinput.P.Source_File_Is_Subunit (Src_Ind) @@ -4584,7 +4582,7 @@ package body Prj.Nmsc is -- ALI file for its body to the Interface ALIs. Add_ALI_For - (UData.File_Names (Body_Part).Name); + (UData.File_Names (Impl).File); else Error_Msg @@ -4594,13 +4592,12 @@ package body Prj.Nmsc is (Interfaces).Location); end if; - elsif UData.File_Names (Specification).Name /= - No_File + elsif UData.File_Names (Spec) /= null and then UData.File_Names - (Specification).Path.Name /= Slash + (Spec).Path.Name /= Slash and then Check_Project (UData.File_Names - (Specification).Project, + (Spec).Project, Project, Extending) then @@ -4609,7 +4606,7 @@ package body Prj.Nmsc is -- Interface ALIs. Add_ALI_For - (UData.File_Names (Specification).Name); + (UData.File_Names (Spec).File); else Error_Msg @@ -6360,7 +6357,7 @@ package body Prj.Nmsc is if Info_Id /= No_Ada_Naming_Exception then Exception_Id := Info_Id; Unit_Name := No_Name; - Unit_Kind := Specification; + Unit_Kind := Spec; else Exception_Id := No_Ada_Naming_Exception; @@ -6376,8 +6373,8 @@ package body Prj.Nmsc is In_Tree => In_Tree); case Kind is - when Spec => Unit_Kind := Specification; - when Impl | Sep => Unit_Kind := Body_Part; + when Spec => Unit_Kind := Spec; + when Impl | Sep => Unit_Kind := Impl; end case; end if; end Get_Unit; @@ -7770,7 +7767,7 @@ package body Prj.Nmsc is if Index /= No_Unit_Index then Unit.File_Names (Kind).Path.Name := Slash; - Unit.File_Names (Kind).Needs_Pragma := False; + Unit.File_Names (Kind).Naming_Exception := False; In_Tree.Units.Table (Index) := Unit; end if; @@ -7815,7 +7812,9 @@ package body Prj.Nmsc is Unit := In_Tree.Units.Table (Index); for Kind in Spec_Or_Body'Range loop - if Unit.File_Names (Kind).Name = Excluded.File then + if Unit.File_Names (Kind) /= null + and then Unit.File_Names (Kind).File = Excluded.File + then Exclude (Unit.File_Names (Kind).Project, Index, Kind); exit For_Each_Unit; end if; @@ -7829,7 +7828,7 @@ package body Prj.Nmsc is exit when Source = No_Source; if Source.File = Excluded.File then - Exclude (Source.Project, No_Unit_Index, Specification); + Exclude (Source.Project, No_Unit_Index, Spec); exit; end if; @@ -8105,29 +8104,21 @@ package body Prj.Nmsc is if The_Unit /= No_Unit_Index then UData := In_Tree.Units.Table (The_Unit); - if (UData.File_Names (Unit_Kind).Name = Canonical_File - and then UData.File_Names (Unit_Kind).Path.Name = Slash) - or else UData.File_Names (Unit_Kind).Name = No_File - or else Is_Extending - (Project.Extends, UData.File_Names (Unit_Kind).Project) + if UData.File_Names (Unit_Kind) = null + or else + ((UData.File_Names (Unit_Kind).File = Canonical_File + and then UData.File_Names (Unit_Kind).Path.Name = Slash) + or else UData.File_Names (Unit_Kind).File = No_File + or else Is_Extending + (Project.Extends, UData.File_Names (Unit_Kind).Project)) then - if UData.File_Names (Unit_Kind).Path.Name = Slash then + if UData.File_Names (Unit_Kind) /= null + and then UData.File_Names (Unit_Kind).Path.Name = Slash + then Remove_Forbidden_File_Name - (UData.File_Names (Unit_Kind).Name); + (UData.File_Names (Unit_Kind).File); end if; - -- Record the file name in the hash table Files_Htable - - Files_Htable.Set (Proc_Data.Units, Canonical_File, Project); - - UData.File_Names (Unit_Kind) := - (Name => Canonical_File, - Index => Unit_Ind, - Display_Name => File_Name, - Path => (Canonical_Path, Path_Name), - Project => Project, - Needs_Pragma => Needs_Pragma); - In_Tree.Units.Table (The_Unit) := UData; To_Record := True; Source_Recorded := True; @@ -8189,31 +8180,24 @@ package body Prj.Nmsc is Location); else + UData.Name := Unit_Name; Unit_Table.Increment_Last (In_Tree.Units); The_Unit := Unit_Table.Last (In_Tree.Units); Units_Htable.Set (In_Tree.Units_HT, Unit_Name, The_Unit); - Files_Htable.Set (Proc_Data.Units, Canonical_File, Project); - - UData.Name := Unit_Name; - UData.File_Names (Unit_Kind) := - (Name => Canonical_File, - Index => Unit_Ind, - Display_Name => File_Name, - Path => (Canonical_Path, Path_Name), - Project => Project, - Needs_Pragma => Needs_Pragma); - In_Tree.Units.Table (The_Unit) := UData; - Source_Recorded := True; To_Record := True; end if; end if; if To_Record then + Files_Htable.Set (Proc_Data.Units, Canonical_File, Project); + case Unit_Kind is - when Body_Part => Kind := Impl; - when Specification => Kind := Spec; + when Impl => + Kind := Impl; + when Spec => + Kind := Spec; end case; Add_Source @@ -8226,8 +8210,13 @@ package body Prj.Nmsc is Display_File => File_Name, Unit => Unit_Name, Path => (Canonical_Path, Path_Name), + Naming_Exception => Needs_Pragma, Kind => Kind, + Index => Unit_Ind, Other_Part => No_Source); -- ??? Can we find file ? + + UData.File_Names (Unit_Kind) := Source; + In_Tree.Units.Table (The_Unit) := UData; end if; end Record_Unit; @@ -8451,7 +8440,7 @@ package body Prj.Nmsc is if Specs then if not Check_Project - (The_Unit_Data.File_Names (Specification).Project, + (The_Unit_Data.File_Names (Spec).Project, Project, Extending) then Error_Msg @@ -8462,9 +8451,10 @@ package body Prj.Nmsc is end if; else - if not Check_Project - (The_Unit_Data.File_Names (Body_Part).Project, - Project, Extending) + if The_Unit_Data.File_Names (Impl) = null + or else not Check_Project + (The_Unit_Data.File_Names (Impl).Project, + Project, Extending) then Error_Msg (Project, In_Tree, diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 89f097c..0ea15df 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -626,6 +626,7 @@ package Prj is Lang_Kind : Language_Kind := File_Based; -- Kind of the language + -- ??? Should be in Language itself Compiled : Boolean := True; -- False when there is no compiler for the language @@ -675,6 +676,8 @@ package Prj is Path : Path_Information := No_Path_Information; -- Path name of the source + -- Path.Name is set to Slash for an excluded file that does not belong + -- in the project in fact Source_TS : Time_Stamp_Type := Empty_Time_Stamp; -- Time stamp of the source file @@ -1342,20 +1345,8 @@ package Prj is Project_Error : exception; -- Raised by some subprograms in Prj.Attr - type Spec_Or_Body is (Specification, Body_Part); - - type File_Name_Data is record - Name : File_Name_Type := No_File; - Index : Int := 0; - Display_Name : File_Name_Type := No_File; - Path : Path_Information := No_Path_Information; - Project : Project_Id := No_Project; - Needs_Pragma : Boolean := False; - end record; - -- File and Path name of a spec or body - - type File_Names_Data is array (Spec_Or_Body) of File_Name_Data; - + subtype Spec_Or_Body is Source_Kind range Spec .. Impl; + type File_Names_Data is array (Spec_Or_Body) of Source_Id; type Unit_Index is new Nat; No_Unit_Index : constant Unit_Index := 0; type Unit_Data is record |