diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 158d9094315d0a1fc7e6780e6834e2c8633eeefe..06954551e4db6a2f9a0cbe5c066ef80d826e0e61 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,46 @@
+2009-09-16 Thomas Quinot <quinot@adacore.com>
+
+ * freeze.adb, exp_intr.adb (Expand_Intrinsic_Call): Leave calls to
+ intrinsics untouched (to be expanded later on by gigi) if an external
+ name has been specified.
+ (Freeze_Entity): Do not generate a default external name for
+ imported subprograms with convention Intrinsic (so that the above code
+ can identify the case where an external name has been explicitly
+ provided).
+
+ * s-oscons-tmplt.c: Quote TARGET_OS early so that it is not erroneously
+ replaced by something else due to an existing #define clause.
+
+2009-09-16 Ed Schonberg <schonberg@adacore.com>
+
+ * sinfo.ads, sinfo.adb (Is_Accessibility_Actual): New flag on
+ Parameter_Association node, created for the extra actual generated for
+ an access parameter of a function that dispatches on result, to prevent
+ double generation of such actuals when the call is rewritten is a
+ dispatching call.
+ * exp_ch6.adb (Expand_Call): Set Is_Accessibility_Actual when needed.
+ * exp_disp.adb (Expand_Dispatching_Call): Do not transfer extra actuals
+ that carry this flag when rewriting the original call as a dispatching
+ call, after propagating the controlling tag.
+
+2009-09-16 Vincent Celier <celier@adacore.com>
+
+ * prj-nmsc.adb (Add_Source): New parameter Source_Dir_Rank to be put
+ in the source data.
+ (Check_File): New parameter Source_Dir_Rank, to check if a duplicate
+ source is allowed.
+ (Find_Source_Dirs): New parameter Rank to be recorded with the source
+ directories.
+ (Search_Directories): Call Check_File with the rank of the directory
+ * prj.adb (Project_Empty): Add new component Source_Dir_Ranks
+ (Free): Free also Number_Lists
+ (Reset): Init also Number_Lists
+ * prj.ads (Number_List_Table): New dynamic table for lists of numbers
+ (Source_Data): New component Source_Dir_Rank. Remove component
+ Known_Order_Of_Source_Dirs, no longer needed.
+ (Project_Data): New component Source_Dir_Ranks
+ (Project_Tree_Data): New components Number_Lists
+
2009-09-16 Vincent Celier <celier@adacore.com>
* gprep.adb (Yes_No): New global constant
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 8827870432d5fc6bd3906ebeed4f189832254d2b..238aad61043ffc3af06a4582ff040141b0509fb6 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -496,6 +496,7 @@ package body Exp_Ch6 is
declare
Activation_Chain_Actual : Node_Id;
Activation_Chain_Formal : Node_Id;
+
begin
-- Locate implicit activation chain parameter in the called function
@@ -1807,6 +1808,10 @@ package body Exp_Ch6 is
Make_Identifier (Loc, Chars (EF))));
Analyze_And_Resolve (Expr, Etype (EF));
+
+ if Nkind (N) = N_Function_Call then
+ Set_Is_Accessibility_Actual (Parent (Expr));
+ end if;
end Add_Extra_Actual;
---------------------------
@@ -2282,31 +2287,15 @@ package body Exp_Ch6 is
when N_Attribute_Reference =>
case Get_Attribute_Id (Attribute_Name (Prev_Orig)) is
- -- For X'Access, pass on the level of the prefix X.
- -- If the call is a rewritten attribute reference to
- -- 'Input and the prefix is a tagged type, prevent
- -- double expansion (once as a function call and once
- -- as a dispatching call)
+ -- For X'Access, pass on the level of the prefix X
when Attribute_Access =>
- declare
- Onode : constant Node_Id :=
- Original_Node (Parent (N));
- begin
- if Nkind (Onode) = N_Attribute_Reference
- and then Attribute_Name (Onode) = Name_Input
- and then Is_Tagged_Type (Etype (Subp))
- then
- null;
- else
- Add_Extra_Actual
- (Make_Integer_Literal (Loc,
- Intval =>
- Object_Access_Level
- (Prefix (Prev_Orig))),
+ Add_Extra_Actual
+ (Make_Integer_Literal (Loc,
+ Intval =>
+ Object_Access_Level
+ (Prefix (Prev_Orig))),
Extra_Accessibility (Formal));
- end if;
- end;
-- Treat the unchecked attributes as library-level
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 671b6633e4ac68bd9cd93d0d6a6e7019d46f4f7b..34aacef8c2557d73d74f08b4fad0864fc6148fab 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -692,7 +692,9 @@ package body Exp_Disp is
Append_To (New_Params,
Duplicate_Subexpr_Move_Checks (Param));
- else
+ elsif Nkind (Parent (Param)) /= N_Parameter_Association
+ or else not Is_Accessibility_Actual (Parent (Param))
+ then
Append_To (New_Params, Relocate_Node (Param));
end if;
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index b35c35ea9df39419f725ee2ecfd1715dc7f99a71..da1314c3aa7803b8d1ec2682bc226ff2782772df 100644
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -394,6 +394,13 @@ package body Exp_Intr is
Nam : Name_Id;
begin
+ -- If an external name is specified for the intrinsic, it is handled
+ -- by the back-end: leave the call node unchanged for now.
+
+ if Present (Interface_Name (E)) then
+ return;
+ end if;
+
-- If the intrinsic subprogram is generic, gets its original name
if Present (Parent (E))
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 14ba41c9956c12d13abc0301d02f3a2683906c1c..56389bb053559d8eb493beb21751e6d51d7e9c04 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -2443,11 +2443,16 @@ package body Freeze is
-- If entity is exported or imported and does not have an external
-- name, now is the time to provide the appropriate default name.
-- Skip this if the entity is stubbed, since we don't need a name
- -- for any stubbed routine.
+ -- for any stubbed routine. For the case on intrinsics, if no
+ -- external name is specified, then calls will be handled in
+ -- Exp_Intr.Expand_Intrinsic_Call, and no name is needed; if
+ -- an external name is provided, then Expand_Intrinsic_Call leaves
+ -- calls in place for expansion by GIGI.
if (Is_Imported (E) or else Is_Exported (E))
and then No (Interface_Name (E))
and then Convention (E) /= Convention_Stubbed
+ and then Convention (E) /= Convention_Intrinsic
then
Set_Encoded_Interface_Name
(E, Get_Default_External_Name (E));
@@ -3335,9 +3340,7 @@ package body Freeze is
-- For bit-packed arrays, check the size
- if Is_Bit_Packed_Array (E)
- and then Known_RM_Size (E)
- then
+ if Is_Bit_Packed_Array (E) and then Known_RM_Size (E) then
declare
SizC : constant Node_Id := Size_Clause (E);
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 1a0371855c5f2d04824767f00485720604027673..33f389327c8194bd3d94e525719e015d85952cd7 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -192,6 +192,7 @@ package body Prj.Nmsc is
(Id : out Source_Id;
Data : in out Tree_Processing_Data;
Project : Project_Id;
+ Source_Dir_Rank : Natural;
Lang_Id : Language_Ptr;
Kind : Source_Kind;
File_Name : File_Name_Type;
@@ -295,6 +296,7 @@ package body Prj.Nmsc is
procedure Check_File
(Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data;
+ Source_Dir_Rank : Natural;
Path : Path_Name_Type;
File_Name : File_Name_Type;
Display_File_Name : File_Name_Type;
@@ -539,6 +541,7 @@ package body Prj.Nmsc is
(Id : out Source_Id;
Data : in out Tree_Processing_Data;
Project : Project_Id;
+ Source_Dir_Rank : Natural;
Lang_Id : Language_Ptr;
Kind : Source_Kind;
File_Name : File_Name_Type;
@@ -598,7 +601,7 @@ package body Prj.Nmsc is
if Data.Flags.Allow_Duplicate_Basenames then
Add_Src := True;
- elsif Project.Known_Order_Of_Source_Dirs then
+ elsif Source_Dir_Rank /= Source.Source_Dir_Rank then
Add_Src := False;
else
@@ -610,7 +613,7 @@ package body Prj.Nmsc is
end if;
else
- if Project.Known_Order_Of_Source_Dirs then
+ if Source_Dir_Rank /= Source.Source_Dir_Rank then
Add_Src := False;
-- We might be seeing the same file through a different path
@@ -722,6 +725,7 @@ package body Prj.Nmsc is
end if;
Id.Project := Project;
+ Id.Source_Dir_Rank := Source_Dir_Rank;
Id.Language := Lang_Id;
Id.Kind := Kind;
Id.Alternate_Languages := Alternate_Languages;
@@ -2807,6 +2811,7 @@ package body Prj.Nmsc is
(Id => Source,
Data => Data,
Project => Project,
+ Source_Dir_Rank => 0,
Lang_Id => Lang_Id,
Kind => Kind,
File_Name => File_Name,
@@ -2916,16 +2921,17 @@ package body Prj.Nmsc is
if Unit /= No_Name then
Add_Source
- (Id => Source,
- Data => Data,
- Project => Project,
- Lang_Id => Lang_Id,
- Kind => Kind,
- File_Name => File_Name,
- Display_File => File_Name_Type (Element.Value.Value),
- Unit => Unit,
- Index => Index,
- Location => Element.Value.Location,
+ (Id => Source,
+ Data => Data,
+ Project => Project,
+ Source_Dir_Rank => 0,
+ Lang_Id => Lang_Id,
+ Kind => Kind,
+ File_Name => File_Name,
+ Display_File => File_Name_Type (Element.Value.Value),
+ Unit => Unit,
+ Index => Index,
+ Location => Element.Value.Location,
Naming_Exception => True);
end if;
@@ -4675,7 +4681,8 @@ package body Prj.Nmsc is
(Name_Source_Files,
Project.Decl.Attributes, Data.Tree);
- Last_Source_Dir : String_List_Id := Nil_String;
+ Last_Source_Dir : String_List_Id := Nil_String;
+ Last_Src_Dir_Rank : Number_List_Index := No_Number_List;
Languages : constant Variable_Value :=
Prj.Util.Value_Of
@@ -4684,6 +4691,7 @@ package body Prj.Nmsc is
procedure Find_Source_Dirs
(From : File_Name_Type;
Location : Source_Ptr;
+ Rank : Natural;
Removed : Boolean := False);
-- Find one or several source directories, and add (or remove, if
-- Removed is True) them to list of source directories of the project.
@@ -4695,6 +4703,7 @@ package body Prj.Nmsc is
procedure Find_Source_Dirs
(From : File_Name_Type;
Location : Source_Ptr;
+ Rank : Natural;
Removed : Boolean := False)
is
Directory : constant String := Get_Name_String (From);
@@ -4714,6 +4723,8 @@ package body Prj.Nmsc is
Last : Natural;
List : String_List_Id;
Prev : String_List_Id;
+ Rank_List : Number_List_Index;
+ Prev_Rank : Number_List_Index;
Element : String_Element;
Found : Boolean := False;
@@ -4756,6 +4767,8 @@ package body Prj.Nmsc is
List := Project.Source_Dirs;
Prev := Nil_String;
+ Rank_List := Project.Source_Dir_Ranks;
+ Prev_Rank := No_Number_List;
while List /= Nil_String loop
Element := Data.Tree.String_Elements.Table (List);
@@ -4766,6 +4779,8 @@ package body Prj.Nmsc is
Prev := List;
List := Element.Next;
+ Prev_Rank := Rank_List;
+ Rank_List := Data.Tree.Number_Lists.Table (Rank_List).Next;
end loop;
-- If directory is not already in list, put it there
@@ -4785,11 +4800,15 @@ package body Prj.Nmsc is
Next => Nil_String,
Index => 0);
+ Number_List_Table.Increment_Last (Data.Tree.Number_Lists);
+
-- Case of first source directory
if Last_Source_Dir = Nil_String then
Project.Source_Dirs :=
String_Element_Table.Last (Data.Tree.String_Elements);
+ Project.Source_Dir_Ranks :=
+ Number_List_Table.Last (Data.Tree.Number_Lists);
-- Here we already have source directories
@@ -4798,7 +4817,11 @@ package body Prj.Nmsc is
Data.Tree.String_Elements.Table
(Last_Source_Dir).Next :=
- String_Element_Table.Last (Data.Tree.String_Elements);
+ String_Element_Table.Last (Data.Tree.String_Elements);
+ Data.Tree.Number_Lists.Table
+ (Last_Src_Dir_Rank).Next :=
+ Number_List_Table.Last (Data.Tree.Number_Lists);
+
end if;
-- And register this source directory as the new last
@@ -4806,14 +4829,22 @@ package body Prj.Nmsc is
Last_Source_Dir :=
String_Element_Table.Last (Data.Tree.String_Elements);
Data.Tree.String_Elements.Table (Last_Source_Dir) := Element;
+ Last_Src_Dir_Rank :=
+ Number_List_Table.Last (Data.Tree.Number_Lists);
+ Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank) :=
+ (Number => Rank, Next => No_Number_List);
elsif Removed and Found then
if Prev = Nil_String then
Project.Source_Dirs :=
Data.Tree.String_Elements.Table (List).Next;
+ Project.Source_Dir_Ranks :=
+ Data.Tree.Number_Lists.Table (Rank_List).Next;
else
Data.Tree.String_Elements.Table (Prev).Next :=
Data.Tree.String_Elements.Table (List).Next;
+ Data.Tree.Number_Lists.Table (Prev_Rank).Next :=
+ Data.Tree.Number_Lists.Table (Rank_List).Next;
end if;
end if;
@@ -4872,6 +4903,8 @@ package body Prj.Nmsc is
if Current_Verbosity = High and then not Removed then
Write_Str ("Find_Source_Dirs (""");
Write_Str (Directory);
+ Write_Str (",");
+ Write_Str (Rank'Img);
Write_Line (""")");
end if;
@@ -4884,10 +4917,6 @@ package body Prj.Nmsc is
or else
Directory (Directory'Last - 2) = Directory_Separator)
then
- if not Removed then
- Project.Known_Order_Of_Source_Dirs := False;
- end if;
-
Name_Len := Directory'Length - 3;
if Name_Len = 0 then
@@ -4960,6 +4989,8 @@ package body Prj.Nmsc is
Path_Name : Path_Information;
List : String_List_Id;
Prev : String_List_Id;
+ Rank_List : Number_List_Index;
+ Prev_Rank : Number_List_Index;
Dir_Exists : Boolean;
begin
@@ -5011,70 +5042,105 @@ package body Prj.Nmsc is
(Display_Path'First .. Last_Display_Path));
Display_Path_Id := Name_Find;
+ -- Check if the directory is already in the list
+
+ Prev := Nil_String;
+ Prev_Rank := No_Number_List;
+
+ -- Look for source dir in current list
+
+ List := Project.Source_Dirs;
+ Rank_List := Project.Source_Dir_Ranks;
+ while List /= Nil_String loop
+ Element := Data.Tree.String_Elements.Table (List);
+ exit when Element.Value = Path_Id;
+ Prev := List;
+ List := Element.Next;
+ Prev_Rank := Rank_List;
+ Rank_List :=
+ Data.Tree.Number_Lists.Table (Prev_Rank).Next;
+ end loop;
+
+ -- The directory is in the list if List is not Nil_String
+
if not Removed then
-- As it is an existing directory, we add it to the
- -- list of directories.
+ -- list of directories, if it is not already in the
+ -- list.
- String_Element_Table.Increment_Last
- (Data.Tree.String_Elements);
- Element :=
- (Value => Path_Id,
- Index => 0,
- Display_Value => Display_Path_Id,
- Location => No_Location,
- Flag => False,
- Next => Nil_String);
+ if List = Nil_String then
+ String_Element_Table.Increment_Last
+ (Data.Tree.String_Elements);
+ Element :=
+ (Value => Path_Id,
+ Index => 0,
+ Display_Value => Display_Path_Id,
+ Location => No_Location,
+ Flag => False,
+ Next => Nil_String);
+ Number_List_Table.Increment_Last
+ (Data.Tree.Number_Lists);
- if Last_Source_Dir = Nil_String then
+ if Last_Source_Dir = Nil_String then
- -- This is the first source directory
+ -- This is the first source directory
- Project.Source_Dirs := String_Element_Table.Last
- (Data.Tree.String_Elements);
+ Project.Source_Dirs :=
+ String_Element_Table.Last
+ (Data.Tree.String_Elements);
+ Project.Source_Dir_Ranks :=
+ Number_List_Table.Last
+ (Data.Tree.Number_Lists);
- else
- -- We already have source directories, link the
- -- previous last to the new one.
+ else
+ -- We already have source directories, link the
+ -- previous last to the new one.
+
+ Data.Tree.String_Elements.Table
+ (Last_Source_Dir).Next :=
+ String_Element_Table.Last
+ (Data.Tree.String_Elements);
+ Data.Tree.Number_Lists.Table
+ (Last_Src_Dir_Rank).Next :=
+ Number_List_Table.Last
+ (Data.Tree.Number_Lists);
- Data.Tree.String_Elements.Table
- (Last_Source_Dir).Next :=
+ end if;
+
+ -- And register this source directory as the new
+ -- last.
+
+ Last_Source_Dir :=
String_Element_Table.Last
(Data.Tree.String_Elements);
+ Data.Tree.String_Elements.Table
+ (Last_Source_Dir) := Element;
+ Last_Src_Dir_Rank :=
+ Number_List_Table.Last
+ (Data.Tree.Number_Lists);
+ Data.Tree.Number_Lists.Table
+ (Last_Src_Dir_Rank) :=
+ (Number => Rank, Next => No_Number_List);
end if;
- -- And register this source directory as the new last
-
- Last_Source_Dir := String_Element_Table.Last
- (Data.Tree.String_Elements);
- Data.Tree.String_Elements.Table
- (Last_Source_Dir) := Element;
-
else
-- Remove source dir, if present
- Prev := Nil_String;
-
- -- Look for source dir in current list
-
- List := Project.Source_Dirs;
- while List /= Nil_String loop
- Element := Data.Tree.String_Elements.Table (List);
- exit when Element.Value = Path_Id;
- Prev := List;
- List := Element.Next;
- end loop;
-
if List /= Nil_String then
-- Source dir was found, remove it from the list
if Prev = Nil_String then
Project.Source_Dirs :=
Data.Tree.String_Elements.Table (List).Next;
+ Project.Source_Dir_Ranks :=
+ Data.Tree.Number_Lists.Table (Rank_List).Next;
else
Data.Tree.String_Elements.Table (Prev).Next :=
Data.Tree.String_Elements.Table (List).Next;
+ Data.Tree.Number_Lists.Table (Prev_Rank).Next :=
+ Data.Tree.Number_Lists.Table (Rank_List).Next;
end if;
end if;
end if;
@@ -5276,6 +5342,13 @@ package body Prj.Nmsc is
Project.Source_Dirs :=
String_Element_Table.Last (Data.Tree.String_Elements);
+ Number_List_Table.Append
+ (Data.Tree.Number_Lists,
+ (Number => 1, Next => No_Number_List));
+
+ Project.Source_Dir_Ranks :=
+ Number_List_Table.Last (Data.Tree.Number_Lists);
+
if Current_Verbosity = High then
Write_Attr
("Default source directory",
@@ -5296,15 +5369,17 @@ package body Prj.Nmsc is
declare
Source_Dir : String_List_Id;
Element : String_Element;
-
+ Rank : Natural;
begin
-- Process the source directories for each element of the list
Source_Dir := Source_Dirs.Values;
+ Rank := 0;
while Source_Dir /= Nil_String loop
Element := Data.Tree.String_Elements.Table (Source_Dir);
+ Rank := Rank + 1;
Find_Source_Dirs
- (File_Name_Type (Element.Value), Element.Location);
+ (File_Name_Type (Element.Value), Element.Location, Rank);
Source_Dir := Element.Next;
end loop;
end;
@@ -5326,6 +5401,7 @@ package body Prj.Nmsc is
Find_Source_Dirs
(File_Name_Type (Element.Value),
Element.Location,
+ 0,
Removed => True);
Source_Dir := Element.Next;
end loop;
@@ -6582,6 +6658,7 @@ package body Prj.Nmsc is
procedure Check_File
(Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data;
+ Source_Dir_Rank : Natural;
Path : Path_Name_Type;
File_Name : File_Name_Type;
Display_File_Name : File_Name_Type;
@@ -6606,6 +6683,14 @@ package body Prj.Nmsc is
Kind : Source_Kind := Spec;
begin
+ if Current_Verbosity = High then
+ Write_Line ("Checking file:");
+ Write_Str (" Path = ");
+ Write_Line (Get_Name_String (Path));
+ Write_Str (" Rank =");
+ Write_Line (Source_Dir_Rank'Img);
+ end if;
+
if Name_Loc = No_Name_Location then
Check_Name := For_All_Sources;
@@ -6615,7 +6700,7 @@ package body Prj.Nmsc is
-- Check if it is OK to have the same file name in several
-- source directories.
- if not Project.Project.Known_Order_Of_Source_Dirs then
+ if Source_Dir_Rank = Name_Loc.Source.Source_Dir_Rank then
Error_Msg_File_1 := File_Name;
Error_Msg
(Data.Flags,
@@ -6689,6 +6774,7 @@ package body Prj.Nmsc is
Add_Source
(Id => Source,
Project => Project.Project,
+ Source_Dir_Rank => Source_Dir_Rank,
Lang_Id => Language,
Kind => Kind,
Data => Data,
@@ -6713,6 +6799,8 @@ package body Prj.Nmsc is
is
Source_Dir : String_List_Id;
Element : String_Element;
+ Src_Dir_Rank : Number_List_Index;
+ Num_Nod : Number_Node;
Dir : Dir_Type;
Name : String (1 .. 1_000);
Last : Natural;
@@ -6727,12 +6815,21 @@ package body Prj.Nmsc is
-- Loop through subdirectories
Source_Dir := Project.Project.Source_Dirs;
+ Src_Dir_Rank := Project.Project.Source_Dir_Ranks;
while Source_Dir /= Nil_String loop
begin
+ Num_Nod := Data.Tree.Number_Lists.Table (Src_Dir_Rank);
Element := Data.Tree.String_Elements.Table (Source_Dir);
+
if Element.Value /= No_Name then
Get_Name_String (Element.Display_Value);
+ if Current_Verbosity = High then
+ Write_Str ("Directory: ");
+ Write_Str (Name_Buffer (1 .. Name_Len));
+ Write_Line (Num_Nod.Number'Img);
+ end if;
+
declare
Source_Directory : constant String :=
Name_Buffer (1 .. Name_Len) &
@@ -6819,7 +6916,7 @@ package body Prj.Nmsc is
-- still need to add it to the list: if we
-- don't, the file will not appear in the
-- mapping file and will cause the compiler
- -- to fail
+ -- to fail.
To_Remove := True;
end if;
@@ -6827,6 +6924,7 @@ package body Prj.Nmsc is
Check_File
(Project => Project,
+ Source_Dir_Rank => Num_Nod.Number,
Data => Data,
Path => Path,
File_Name => File_Name,
@@ -6847,6 +6945,7 @@ package body Prj.Nmsc is
end;
Source_Dir := Element.Next;
+ Src_Dir_Rank := Num_Nod.Next;
end loop;
if Current_Verbosity = High then
@@ -7176,7 +7275,13 @@ package body Prj.Nmsc is
begin
if Current_Verbosity = High then
Write_Str ("Removing source ");
- Write_Line (Get_Name_String (Id.File) & " at" & Id.Index'Img);
+ Write_Str (Get_Name_String (Id.File));
+
+ if Id.Index /= 0 then
+ Write_Str (" at" & Id.Index'Img);
+ end if;
+
+ Write_Eol;
end if;
if Replaced_By /= No_Source then
diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index 2bed1a81dc29a09fbf0a8d235c1567fea2420442..b485f706829bc6edcb5c9d51a38fcaab3648c2a3 100644
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -89,7 +89,7 @@ package body Prj is
Include_Path => null,
Include_Data_Set => False,
Source_Dirs => Nil_String,
- Known_Order_Of_Source_Dirs => True,
+ Source_Dir_Ranks => No_Number_List,
Object_Directory => No_Path_Information,
Library_TS => Empty_Time_Stamp,
Exec_Directory => No_Path_Information,
@@ -841,6 +841,7 @@ package body Prj is
begin
if Tree /= null then
Name_List_Table.Free (Tree.Name_Lists);
+ Number_List_Table.Free (Tree.Number_Lists);
String_Element_Table.Free (Tree.String_Elements);
Variable_Element_Table.Free (Tree.Variable_Elements);
Array_Element_Table.Free (Tree.Array_Elements);
@@ -868,6 +869,7 @@ package body Prj is
-- Visible tables
Name_List_Table.Init (Tree.Name_Lists);
+ Number_List_Table.Init (Tree.Number_Lists);
String_Element_Table.Init (Tree.String_Elements);
Variable_Element_Table.Init (Tree.Variable_Elements);
Array_Element_Table.Init (Tree.Array_Elements);
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index 76eb59aecbb1e7368f032d13499c3a24cb8a6fa8..502ace95f8df52a9137134f8afa3fe19577a07c0 100644
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -314,7 +314,23 @@ package Prj is
Table_Low_Bound => 1,
Table_Initial => 10,
Table_Increment => 100);
- -- The table for lists of names used in package Language_Processing
+ -- The table for lists of names
+
+ type Number_List_Index is new Nat;
+ No_Number_List : constant Number_List_Index := 0;
+
+ type Number_Node is record
+ Number : Natural := 0;
+ Next : Number_List_Index := No_Number_List;
+ end record;
+
+ package Number_List_Table is new GNAT.Dynamic_Tables
+ (Table_Component_Type => Number_Node,
+ Table_Index_Type => Number_List_Index,
+ Table_Low_Bound => 1,
+ Table_Initial => 10,
+ Table_Increment => 100);
+ -- The table for lists of numbers
package Mapping_Files_Htable is new Simple_HTable
(Header_Num => Header_Num,
@@ -623,6 +639,12 @@ package Prj is
Project : Project_Id := No_Project;
-- Project of the source
+ Source_Dir_Rank : Natural := 0;
+ -- The rank of the source directory in list declared with attribute
+ -- Source_Dirs. Two source files with the same name cannot appears in
+ -- different directory with the same rank. That can happen when the
+ -- recursive notation <dir>/** is used in attribute Source_Dirs.
+
Language : Language_Ptr := No_Language_Index;
-- Index of the language. This is an index into
-- Project_Tree.Languages_Data.
@@ -717,6 +739,7 @@ package Prj is
No_Source_Data : constant Source_Data :=
(Project => No_Project,
+ Source_Dir_Rank => 0,
Language => No_Language_Index,
In_Interfaces => True,
Declared_In_Interfaces => False,
@@ -1155,10 +1178,7 @@ package Prj is
Source_Dirs : String_List_Id := Nil_String;
-- The list of all the source directories
- Known_Order_Of_Source_Dirs : Boolean := True;
- -- False, if there is any /** in the Source_Dirs, because in this case
- -- the ordering of the source subdirs depend on the OS. If True,
- -- duplicate file names in the same project file are allowed.
+ Source_Dir_Ranks : Number_List_Index := No_Number_List;
Ada_Include_Path : String_Access := null;
-- The cached value of source search path for this project file. Set by
@@ -1273,6 +1293,7 @@ package Prj is
type Project_Tree_Data is
record
Name_Lists : Name_List_Table.Instance;
+ Number_Lists : Number_List_Table.Instance;
String_Elements : String_Element_Table.Instance;
Variable_Elements : Variable_Element_Table.Instance;
Array_Elements : Array_Element_Table.Instance;
diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c
index a2ae16e35c3082112ee56fd670da116be8a81782..bce8648209b53aec0cd534e4b72c281cf0bc7c5a 100644
--- a/gcc/ada/s-oscons-tmplt.c
+++ b/gcc/ada/s-oscons-tmplt.c
@@ -231,13 +231,13 @@ TXT(" Target_Name : constant String := " STR(TARGET) ";")
type Target_OS_Type is (Windows, VMS, Other_OS);
*/
#if defined (__MINGW32__)
-# define TARGET_OS Windows
+# define TARGET_OS "Windows"
#elif defined (__VMS)
-# define TARGET_OS VMS
+# define TARGET_OS "VMS"
#else
-# define TARGET_OS Other_OS
+# define TARGET_OS "Other_OS"
#endif
-TXT(" Target_OS : constant Target_OS_Type := " STR(TARGET_OS) ";")
+TXT(" Target_OS : constant Target_OS_Type := " TARGET_OS ";")
/*
-------------------
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 816adcf5afcf4d870bf21028aedf0c56a5820e41..dd4aaafce9acdfed3be20dc96141d2a2f6220dc5 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -1583,6 +1583,14 @@ package body Sinfo is
return Uint3 (N);
end Intval;
+ function Is_Accessibility_Actual
+ (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Parameter_Association);
+ return Flag12 (N);
+ end Is_Accessibility_Actual;
+
function Is_Asynchronous_Call_Block
(N : Node_Id) return Boolean is
begin
@@ -4435,6 +4443,14 @@ package body Sinfo is
Set_Uint3 (N, Val);
end Set_Intval;
+ procedure Set_Is_Accessibility_Actual
+ (N : Node_Id; Val : Boolean := True) is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Parameter_Association);
+ Set_Flag12 (N, Val);
+ end Set_Is_Accessibility_Actual;
+
procedure Set_Is_Asynchronous_Call_Block
(N : Node_Id; Val : Boolean := True) is
begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index b598b771de36676231b8e4bebb1cc6e42fb174b4..2e666c49a640c38c9c8298b28eacabc44d6d7633 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1179,6 +1179,13 @@ package Sinfo is
-- to the node for the spec of the instance, inserted as part of the
-- semantic processing for instantiations in Sem_Ch12.
+ -- Is_Accessibility_Actual (Flag12-Sem)
+ -- Present in N_Parameter_Association nodes. True if the parameter is
+ -- an extra actual that carries the accessibility level of the actual
+ -- for an access parameter, in a function that dispatches on result and
+ -- is called in a dispatching context. Used to prevent a formal/actual
+ -- mismatch when the call is rewritten as a dispatching call.
+
-- Is_Asynchronous_Call_Block (Flag7-Sem)
-- A flag set in a Block_Statement node to indicate that it is the
-- expansion of an asynchronous entry call. Such a block needs cleanup
@@ -4450,6 +4457,7 @@ package Sinfo is
-- Selector_Name (Node2) (always non-Empty)
-- Explicit_Actual_Parameter (Node3)
-- Next_Named_Actual (Node4-Sem)
+ -- Is_Accessibility_Actual (Flag12-Sem)
---------------------------
-- 6.4 Actual Parameter --
@@ -8070,6 +8078,9 @@ package Sinfo is
function Intval
(N : Node_Id) return Uint; -- Uint3
+ function Is_Accessibility_Actual
+ (N : Node_Id) return Boolean; -- Flag12
+
function Is_Asynchronous_Call_Block
(N : Node_Id) return Boolean; -- Flag7
@@ -8979,6 +8990,9 @@ package Sinfo is
procedure Set_Intval
(N : Node_Id; Val : Uint); -- Uint3
+ procedure Set_Is_Accessibility_Actual
+ (N : Node_Id; Val : Boolean := True); -- Flag12
+
procedure Set_Is_Asynchronous_Call_Block
(N : Node_Id; Val : Boolean := True); -- Flag7
@@ -11246,6 +11260,7 @@ package Sinfo is
pragma Inline (In_Present);
pragma Inline (Instance_Spec);
pragma Inline (Intval);
+ pragma Inline (Is_Accessibility_Actual);
pragma Inline (Is_Asynchronous_Call_Block);
pragma Inline (Is_Component_Left_Opnd);
pragma Inline (Is_Component_Right_Opnd);
@@ -11545,6 +11560,7 @@ package Sinfo is
pragma Inline (Set_In_Present);
pragma Inline (Set_Instance_Spec);
pragma Inline (Set_Intval);
+ pragma Inline (Set_Is_Accessibility_Actual);
pragma Inline (Set_Is_Asynchronous_Call_Block);
pragma Inline (Set_Is_Component_Left_Opnd);
pragma Inline (Set_Is_Component_Right_Opnd);