diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 30 | ||||
| -rw-r--r-- | gcc/ada/alfa.ads | 13 | ||||
| -rw-r--r-- | gcc/ada/exp_ch9.adb | 24 | ||||
| -rw-r--r-- | gcc/ada/get_alfa.adb | 43 | ||||
| -rw-r--r-- | gcc/ada/inline.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/lib-xref-alfa.adb | 125 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 166 | ||||
| -rw-r--r-- | gcc/ada/makeutl.adb | 78 | ||||
| -rw-r--r-- | gcc/ada/makeutl.ads | 9 | ||||
| -rw-r--r-- | gcc/ada/prj-tree.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/put_alfa.adb | 10 | ||||
| -rwxr-xr-x | gcc/ada/sem_aux.adb | 13 | ||||
| -rwxr-xr-x | gcc/ada/sem_aux.ads | 6 |
13 files changed, 335 insertions, 202 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 90df612..3090c3e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,33 @@ +2011-08-03 Yannick Moy <moy@adacore.com> + + * alfa.ads Update format of ALFA section in ALI file in order to add a + mapping from bodies to specs when both are present + (ALFA_Scope_Record): add components for spec file/scope + * get_alfa.adb (Get_ALFA): read the new file/scope for spec when present + * lib-xref-alfa.adb + (Collect_ALFA): after all scopes have been collected, fill in the spec + information when relevant + * put_alfa.adb (Put_ALFA): write the new file/scope for spec when + present. + +2011-08-03 Eric Botcazou <ebotcazou@adacore.com> + + * inline.adb (Add_Inlined_Subprogram): Do not consider the enclosing + code unit to decide whether to add internally generated subprograms. + +2011-08-03 Javier Miranda <miranda@adacore.com> + + * sem_aux.ads, sem_aux.adb (Is_VM_By_Copy_Actual): New subprogram. + * exp_ch9.adb + (Build_Simple_Entry_Call): Handle actuals that must be handled by copy + in VM targets. + +2011-08-03 Emmanuel Briot <briot@adacore.com> + + * make.adb, makeutl.adb, makeutl.ads (Make.Switches_Of): now shares + code with Makeutl.Get_Switches. + * prj-tree.adb: Update comment. + 2011-08-03 Thomas Quinot <quinot@adacore.com> * sem_cat.adb (Validate_RCI_Subprogram_Declaration): Reject a remote diff --git a/gcc/ada/alfa.ads b/gcc/ada/alfa.ads index cf0e43d..8601a32 100644 --- a/gcc/ada/alfa.ads +++ b/gcc/ada/alfa.ads @@ -89,7 +89,7 @@ package ALFA is -- reading of the ALFA information, and means that the ALFA information -- can stand on its own without needing other parts of the ALI file. - -- FS . scope line type col entity + -- FS . scope line type col entity (-> spec-file . spec-scope)? -- scope is the ones-origin scope number for the current file (e.g. 2 = -- reference to the second FS line in this FD block). @@ -113,6 +113,9 @@ package ALFA is -- entity is the name of the scope entity, with casing in the canonical -- casing for the source file where it is defined. + -- spec-file and spec-scope are respectively the file and scope for the + -- spec corresponding to the current body scope, when they differ. + -- ------------------ -- -- Xref Section -- -- ------------------ @@ -234,6 +237,14 @@ package ALFA is Scope_Num : Nat; -- Set to the scope number for the scope + Spec_File_Num : Nat; + -- Set to the file dependency number for the scope corresponding to the + -- spec of the current scope entity, if different, or else 0. + + Spec_Scope_Num : Nat; + -- Set to the scope number for the scope corresponding to the spec of + -- the current scope entity, if different, or else 0. + Line : Nat; -- Line number for the scope diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 0a0a28a..1b2e7fd 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -3796,6 +3796,27 @@ package body Exp_Ch9 is Attribute_Name => Name_Unchecked_Access, Prefix => New_Reference_To (Defining_Identifier (N_Node), Loc))); + + -- If it is a vm_by_copy_actual, copy it to a new variable + + elsif Is_VM_By_Copy_Actual (Actual) then + N_Node := + Make_Object_Declaration (Loc, + Defining_Identifier => Make_Temporary (Loc, 'J'), + Aliased_Present => True, + Object_Definition => + New_Reference_To (Etype (Formal), Loc), + Expression => New_Copy_Tree (Actual)); + Set_Assignment_OK (N_Node); + + Append (N_Node, Decls); + + Append_To (Plist, + Make_Attribute_Reference (Loc, + Attribute_Name => Name_Unchecked_Access, + Prefix => + New_Reference_To (Defining_Identifier (N_Node), Loc))); + else -- Interface class-wide formal @@ -3947,7 +3968,8 @@ package body Exp_Ch9 is Set_Assignment_OK (Actual); while Present (Actual) loop - if Is_By_Copy_Type (Etype (Actual)) + if (Is_By_Copy_Type (Etype (Actual)) + or else Is_VM_By_Copy_Actual (Actual)) and then Ekind (Formal) /= E_In_Parameter then N_Node := diff --git a/gcc/ada/get_alfa.adb b/gcc/ada/get_alfa.adb index 94d5d9f..d9565b1 100644 --- a/gcc/ada/get_alfa.adb +++ b/gcc/ada/get_alfa.adb @@ -254,10 +254,12 @@ begin when 'S' => declare - Scope : Nat; - Line : Nat; - Col : Nat; - Typ : Character; + Spec_File : Nat; + Spec_Scope : Nat; + Scope : Nat; + Line : Nat; + Col : Nat; + Typ : Character; begin -- Scan out location @@ -279,21 +281,36 @@ begin Skip_Spaces; Get_Name; + Skip_Spaces; + + if Nextc = '-' then + Skipc; + Check ('>'); + Skip_Spaces; + Spec_File := Get_Nat; + Check ('.'); + Spec_Scope := Get_Nat; + else + Spec_File := 0; + Spec_Scope := 0; + end if; -- Make new scope table entry (will fill in From_Xref and -- To_Xref later). Initial range (From_Xref .. To_Xref) is -- empty for scopes without entities. ALFA_Scope_Table.Append ( - (Scope_Entity => Empty, - Scope_Name => new String'(Name_Str (1 .. Name_Len)), - File_Num => Cur_File, - Scope_Num => Cur_Scope, - Line => Line, - Stype => Typ, - Col => Col, - From_Xref => 1, - To_Xref => 0)); + (Scope_Entity => Empty, + Scope_Name => new String'(Name_Str (1 .. Name_Len)), + File_Num => Cur_File, + Scope_Num => Cur_Scope, + Spec_File_Num => Spec_File, + Spec_Scope_Num => Spec_Scope, + Line => Line, + Stype => Typ, + Col => Col, + From_Xref => 1, + To_Xref => 0)); end; -- Update counter for scopes diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index d85e086..5f5a4a0 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -428,13 +428,17 @@ package body Inline is -- Start of processing for Add_Inlined_Subprogram begin - -- Insert the current subprogram in the list of inlined subprograms, if - -- it can actually be inlined by the back-end, and if its unit is known - -- to be inlined, or is an instance whose body will be analyzed anyway. - - if (Is_Inlined (Pack) or else Is_Generic_Instance (Pack)) + -- If the subprogram is to be inlined, and if its unit is known to be + -- inlined or is an instance whose body will be analyzed anyway or the + -- subprogram has been generated by the compiler, and if it is declared + -- at the library level not in the main unit, and if it can be inlined + -- by the back-end, then insert it in the list of inlined subprograms. + + if Is_Inlined (E) + and then (Is_Inlined (Pack) + or else Is_Generic_Instance (Pack) + or else Is_Internal (E)) and then not Scope_In_Main_Unit (E) - and then Is_Inlined (E) and then not Is_Nested (E) and then not Has_Initialized_Type (E) then diff --git a/gcc/ada/lib-xref-alfa.adb b/gcc/ada/lib-xref-alfa.adb index 5e0edbc..860e80e 100644 --- a/gcc/ada/lib-xref-alfa.adb +++ b/gcc/ada/lib-xref-alfa.adb @@ -140,6 +140,9 @@ package body ALFA is 's' => True, others => False); + type Entity_Hashed_Range is range 0 .. 255; + -- Size of hash table headers + ----------------------- -- Local Subprograms -- ----------------------- @@ -155,6 +158,9 @@ package body ALFA is -- Filter table Xrefs to add all references used in ALFA to the table -- ALFA_Xref_Table. + function Entity_Hash (E : Entity_Id) return Entity_Hashed_Range; + -- Hash function for hash table + procedure Traverse_Declarations_Or_Statements (L : List_Id); procedure Traverse_Handled_Statement_Sequence (N : Node_Id); procedure Traverse_Package_Body (N : Node_Id); @@ -339,15 +345,17 @@ package body ALFA is -- filled even later, but are initialized to represent an empty range. ALFA_Scope_Table.Append ( - (Scope_Name => new String'(Exact_Source_Name (Sloc (E))), - File_Num => 0, - Scope_Num => 0, - Line => Nat (Get_Logical_Line_Number (Loc)), - Stype => Typ, - Col => Nat (Get_Column_Number (Loc)), - From_Xref => 1, - To_Xref => 0, - Scope_Entity => E)); + (Scope_Name => new String'(Exact_Source_Name (Sloc (E))), + File_Num => 0, + Scope_Num => 0, + Spec_File_Num => 0, + Spec_Scope_Num => 0, + Line => Nat (Get_Logical_Line_Number (Loc)), + Stype => Typ, + Col => Nat (Get_Column_Number (Loc)), + From_Xref => 1, + To_Xref => 0, + Scope_Entity => E)); end Add_ALFA_Scope; -------------------- @@ -367,36 +375,37 @@ package body ALFA is procedure Set_Scope_Num (N : Entity_Id; Num : Nat); end Scopes; + ------------ + -- Scopes -- + ------------ + package body Scopes is type Scope is record Num : Nat; Entity : Entity_Id; end record; - type Scope_Hashed is range 0 .. 255; - - function Scope_Hash (E : Entity_Id) return Scope_Hashed; - - function Scope_Hash (E : Entity_Id) return Scope_Hashed is - Value : constant Int := Int (E); - Modulo : constant Int := Int (Scope_Hashed'Last) + 1; - begin - return Scope_Hashed (Value - (Value / Modulo) * Modulo); - end Scope_Hash; - package Scopes is new GNAT.HTable.Simple_HTable - (Header_Num => Scope_Hashed, + (Header_Num => Entity_Hashed_Range, Element => Scope, No_Element => (Num => No_Scope, Entity => Empty), Key => Entity_Id, - Hash => Scope_Hash, + Hash => Entity_Hash, Equal => "="); + ------------------- + -- Get_Scope_Num -- + ------------------- + function Get_Scope_Num (N : Entity_Id) return Nat is begin return Scopes.Get (N).Num; end Get_Scope_Num; + ------------------- + -- Set_Scope_Num -- + ------------------- + procedure Set_Scope_Num (N : Entity_Id; Num : Nat) is begin Scopes.Set (K => N, E => Scope'(Num => Num, Entity => N)); @@ -782,11 +791,83 @@ package body ALFA is end if; end loop; + -- Fill in the spec information when relevant + + declare + package Entity_Hash_Table is new + GNAT.HTable.Simple_HTable + (Header_Num => Entity_Hashed_Range, + Element => Scope_Index, + No_Element => 0, + Key => Entity_Id, + Hash => Entity_Hash, + Equal => "="); + + begin + -- Fill in the hash-table + + for S in ALFA_Scope_Table.First .. ALFA_Scope_Table.Last loop + declare + Srec : ALFA_Scope_Record renames ALFA_Scope_Table.Table (S); + begin + Entity_Hash_Table.Set (Srec.Scope_Entity, S); + end; + end loop; + + -- Use the hash-table to locate spec entities + + for S in ALFA_Scope_Table.First .. ALFA_Scope_Table.Last loop + declare + Srec : ALFA_Scope_Record renames ALFA_Scope_Table.Table (S); + Body_Entity : Entity_Id; + Spec_Entity : Entity_Id; + Spec_Scope : Scope_Index; + begin + if Ekind (Srec.Scope_Entity) = E_Subprogram_Body then + Body_Entity := Parent (Parent (Srec.Scope_Entity)); + elsif Ekind (Srec.Scope_Entity) = E_Package_Body then + Body_Entity := Parent (Srec.Scope_Entity); + else + Body_Entity := Empty; + end if; + + if Present (Body_Entity) then + if Nkind (Body_Entity) = N_Defining_Program_Unit_Name then + Body_Entity := Parent (Body_Entity); + end if; + + Spec_Entity := Corresponding_Spec (Body_Entity); + Spec_Scope := Entity_Hash_Table.Get (Spec_Entity); + + -- Spec of generic may be missing + + if Spec_Scope /= 0 then + Srec.Spec_File_Num := + ALFA_Scope_Table.Table (Spec_Scope).File_Num; + Srec.Spec_Scope_Num := + ALFA_Scope_Table.Table (Spec_Scope).Scope_Num; + end if; + end if; + end; + end loop; + + end; + -- Generate cross reference ALFA information Add_ALFA_Xrefs; end Collect_ALFA; + ----------------- + -- Entity_Hash -- + ----------------- + + function Entity_Hash (E : Entity_Id) return Entity_Hashed_Range is + begin + return Entity_Hashed_Range + (E mod (Entity_Id (Entity_Hashed_Range'Last) + 1)); + end Entity_Hash; + ----------------------------------------- -- Traverse_Declarations_Or_Statements -- ----------------------------------------- diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 73f022e..534795a 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -625,8 +625,6 @@ package body Make is function Switches_Of (Source_File : File_Name_Type; - Source_File_Name : String; - Source_Index : Int; Project : Project_Id; In_Package : Package_Id; Allow_ALI : Boolean) return Variable_Value; @@ -780,7 +778,6 @@ package body Make is procedure Collect_Arguments (Source_File : File_Name_Type; - Source_Index : Int; Is_Main_Source : Boolean; Args : Argument_List); -- Collect all arguments for a source to be compiled, including those @@ -1282,8 +1279,6 @@ package body Make is Switches := Switches_Of (Source_File => Name_Find, - Source_File_Name => File_Name, - Source_Index => Index, Project => Main_Project, In_Package => The_Package, Allow_ALI => Program = Binder or else Program = Linker); @@ -1707,8 +1702,7 @@ package body Make is -- First, collect all the switches - Collect_Arguments - (Source_File, Source_Index, Is_Main_Source, The_Args); + Collect_Arguments (Source_File, Is_Main_Source, The_Args); Prev_Switch := Dummy_Switch; @@ -2246,7 +2240,6 @@ package body Make is procedure Collect_Arguments (Source_File : File_Name_Type; - Source_Index : Int; Is_Main_Source : Boolean; Args : Argument_List) is @@ -2319,8 +2312,6 @@ package body Make is Switches := Switches_Of (Source_File => Source_File, - Source_File_Name => Source_File_Name, - Source_Index => Source_Index, Project => Arguments_Project, In_Package => Compiler_Package, Allow_ALI => False); @@ -3429,8 +3420,8 @@ package body Make is -- The source file that we are checking can be located else - Collect_Arguments (Source_File, Source_Index, - Source_File = Main_Source, Args); + Collect_Arguments + (Source_File, Source_File = Main_Source, Args); -- Do nothing if project of source is externally built @@ -8454,153 +8445,24 @@ package body Make is function Switches_Of (Source_File : File_Name_Type; - Source_File_Name : String; - Source_Index : Int; Project : Project_Id; In_Package : Package_Id; Allow_ALI : Boolean) return Variable_Value is - Lang : constant Language_Ptr := Get_Language_From_Name (Project, "ada"); - Switches : Variable_Value; - - Defaults : constant Array_Element_Id := - Prj.Util.Value_Of - (Name => Name_Default_Switches, - In_Arrays => - Project_Tree.Packages.Table - (In_Package).Decl.Arrays, - In_Tree => Project_Tree); - - Switches_Array : constant Array_Element_Id := - Prj.Util.Value_Of - (Name => Name_Switches, - In_Arrays => - Project_Tree.Packages.Table - (In_Package).Decl.Arrays, - In_Tree => Project_Tree); + Is_Default : Boolean; begin - -- First, try Switches (<file name>) - - Switches := - Prj.Util.Value_Of - (Index => Name_Id (Source_File), - Src_Index => Source_Index, - In_Array => Switches_Array, - In_Tree => Project_Tree, - Allow_Wildcards => True); - - -- Check also without the suffix - - if Switches = Nil_Variable_Value - and then Lang /= null - then - declare - Naming : Lang_Naming_Data renames Lang.Config.Naming_Data; - Name : String (1 .. Source_File_Name'Length + 3); - Last : Positive := Source_File_Name'Length; - Spec_Suffix : String := Get_Name_String (Naming.Spec_Suffix); - Body_Suffix : String := Get_Name_String (Naming.Body_Suffix); - Truncated : Boolean := False; - - begin - Canonical_Case_File_Name (Spec_Suffix); - Canonical_Case_File_Name (Body_Suffix); - Name (1 .. Last) := Source_File_Name; - - if Last > Body_Suffix'Length - and then Name (Last - Body_Suffix'Length + 1 .. Last) = - Body_Suffix - then - Truncated := True; - Last := Last - Body_Suffix'Length; - end if; - - if not Truncated - and then Last > Spec_Suffix'Length - and then Name (Last - Spec_Suffix'Length + 1 .. Last) = - Spec_Suffix - then - Truncated := True; - Last := Last - Spec_Suffix'Length; - end if; - - if Truncated then - Name_Len := 0; - Add_Str_To_Name_Buffer (Name (1 .. Last)); - Switches := - Prj.Util.Value_Of - (Index => Name_Find, - Src_Index => 0, - In_Array => Switches_Array, - In_Tree => Project_Tree, - Allow_Wildcards => True); - - if Switches = Nil_Variable_Value and then Allow_ALI then - Last := Source_File_Name'Length; - - while Name (Last) /= '.' loop - Last := Last - 1; - end loop; - - Name_Len := 0; - Add_Str_To_Name_Buffer (Name (1 .. Last)); - Add_Str_To_Name_Buffer ("ali"); - - Switches := - Prj.Util.Value_Of - (Index => Name_Find, - Src_Index => 0, - In_Array => Switches_Array, - In_Tree => Project_Tree); - end if; - end if; - end; - end if; - - -- Next, try Switches ("Ada") - - if Switches = Nil_Variable_Value then - Switches := - Prj.Util.Value_Of - (Index => Name_Ada, - Src_Index => 0, - In_Array => Switches_Array, - In_Tree => Project_Tree, - Force_Lower_Case_Index => True); - - if Switches /= Nil_Variable_Value then - Switch_May_Be_Passed_To_The_Compiler := False; - end if; - end if; - - -- Next, try Switches (others) - - if Switches = Nil_Variable_Value then - Switches := - Prj.Util.Value_Of - (Index => All_Other_Names, - Src_Index => 0, - In_Array => Switches_Array, - In_Tree => Project_Tree); - - if Switches /= Nil_Variable_Value then - Switch_May_Be_Passed_To_The_Compiler := False; - end if; - end if; - - -- And finally, Default_Switches ("Ada") - - if Switches = Nil_Variable_Value then - Switches := - Prj.Util.Value_Of - (Index => Name_Ada, - Src_Index => 0, - In_Array => Defaults, - In_Tree => Project_Tree); - end if; - + Makeutl.Get_Switches + (Source_File => Source_File, + Source_Lang => Name_Ada, + Source_Prj => Project, + Pkg_Name => Project_Tree.Packages.Table (In_Package).Name, + Project_Tree => Project_Tree, + Value => Switches, + Is_Default => Is_Default, + Test_Without_Suffix => True, + Check_ALI_Suffix => Allow_ALI); return Switches; end Switches_Of; diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index a8c54e6..5afb629 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -685,7 +685,9 @@ package body Makeutl is Pkg_Name : Name_Id; Project_Tree : Project_Tree_Ref; Value : out Variable_Value; - Is_Default : out Boolean) + Is_Default : out Boolean; + Test_Without_Suffix : Boolean := False; + Check_ALI_Suffix : Boolean := False) is Project : constant Project_Id := Ultimate_Extending_Project_Of (Source_Prj); @@ -694,6 +696,7 @@ package body Makeutl is (Name => Pkg_Name, In_Packages => Project.Decl.Packages, In_Tree => Project_Tree); + Lang : Language_Ptr; begin Is_Default := False; @@ -706,9 +709,80 @@ package body Makeutl is Allow_Wildcards => True); end if; + if Value = Nil_Variable_Value + and then Test_Without_Suffix + then + Lang := + Get_Language_From_Name (Project, Get_Name_String (Source_Lang)); + + if Lang /= null then + declare + Naming : Lang_Naming_Data renames Lang.Config.Naming_Data; + SF_Name : constant String := Get_Name_String (Source_File); + Last : Positive := SF_Name'Length; + Name : String (1 .. Last + 3); + Spec_Suffix : String := Get_Name_String (Naming.Spec_Suffix); + Body_Suffix : String := Get_Name_String (Naming.Body_Suffix); + Truncated : Boolean := False; + begin + Canonical_Case_File_Name (Spec_Suffix); + Canonical_Case_File_Name (Body_Suffix); + Name (1 .. Last) := SF_Name; + + if Last > Body_Suffix'Length + and then Name (Last - Body_Suffix'Length + 1 .. Last) = + Body_Suffix + then + Truncated := True; + Last := Last - Body_Suffix'Length; + end if; + + if not Truncated + and then Last > Spec_Suffix'Length + and then Name (Last - Spec_Suffix'Length + 1 .. Last) = + Spec_Suffix + then + Truncated := True; + Last := Last - Spec_Suffix'Length; + end if; + + if Truncated then + Name_Len := 0; + Add_Str_To_Name_Buffer (Name (1 .. Last)); + + Value := Prj.Util.Value_Of + (Name => Name_Find, + Attribute_Or_Array_Name => Name_Switches, + In_Package => Pkg, + In_Tree => Project_Tree, + Allow_Wildcards => True); + end if; + + if Value = Nil_Variable_Value + and then Check_ALI_Suffix + then + Last := SF_Name'Length; + while Name (Last) /= '.' loop + Last := Last - 1; + end loop; + + Name_Len := 0; + Add_Str_To_Name_Buffer (Name (1 .. Last)); + Add_Str_To_Name_Buffer ("ali"); + + Value := Prj.Util.Value_Of + (Name => Name_Find, + Attribute_Or_Array_Name => Name_Switches, + In_Package => Pkg, + In_Tree => Project_Tree, + Allow_Wildcards => True); + end if; + end; + end if; + end if; + if Value = Nil_Variable_Value then Is_Default := True; - Is_Default := True; Value := Prj.Util.Value_Of (Name => Source_Lang, diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index 28b59c5..31a4562 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -161,13 +161,20 @@ package Makeutl is Pkg_Name : Name_Id; Project_Tree : Project_Tree_Ref; Value : out Variable_Value; - Is_Default : out Boolean); + Is_Default : out Boolean; + Test_Without_Suffix : Boolean := False; + Check_ALI_Suffix : Boolean := False); -- Compute the switches (Compilation switches for instance) for the given -- file. This checks various attributes to see if there are file specific -- switches, or else defaults on the switches for the corresponding -- language. Is_Default is set to False if there were file-specific -- switches Source_File can be set to No_File to force retrieval of -- the default switches. + -- If Test_Without_Suffix is True, and there is no + -- " for Switches(Source_File) use", then this procedure also tests without + -- the extension of the filename. + -- If Test_Without_Suffix is True and Check_ALI_Suffix is True, then we + -- also replace the file extension with ".ali" when testing. function Linker_Options_Switches (Project : Project_Id; diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb index 3dda471..3ac6a88 100644 --- a/gcc/ada/prj-tree.adb +++ b/gcc/ada/prj-tree.adb @@ -1011,12 +1011,10 @@ package body Prj.Tree is -- project, since we want to preserve the current environment. But we -- still need to ensure that the external references are properly -- initialized. + -- Prj.Ext.Reset (Tree.External); Prj.Ext.Initialize (Self.External); - -- Why is this line commented out ??? - -- Prj.Ext.Reset (Tree.External); - Self.Flags := Flags; end Initialize; diff --git a/gcc/ada/put_alfa.adb b/gcc/ada/put_alfa.adb index d881920..bf35cbb 100644 --- a/gcc/ada/put_alfa.adb +++ b/gcc/ada/put_alfa.adb @@ -78,6 +78,16 @@ begin Write_Info_Char (S.Scope_Name (N)); end loop; + if S.Spec_File_Num /= 0 then + Write_Info_Char (' '); + Write_Info_Char ('-'); + Write_Info_Char ('>'); + Write_Info_Char (' '); + Write_Info_Nat (S.Spec_File_Num); + Write_Info_Char ('.'); + Write_Info_Nat (S.Spec_Scope_Num); + end if; + Write_Info_Terminate; end; diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 0e5c3db..5b7de45 100755 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -33,6 +33,7 @@ with Atree; use Atree; with Einfo; use Einfo; with Namet; use Namet; +with Opt; use Opt; with Sinfo; use Sinfo; with Snames; use Snames; with Stand; use Stand; @@ -784,6 +785,18 @@ package body Sem_Aux is end if; end Is_Limited_Type; + -------------------------- + -- Is_VM_By_Copy_Actual -- + -------------------------- + + function Is_VM_By_Copy_Actual (N : Node_Id) return Boolean is + begin + return not Tagged_Type_Expansion + and then Nkind (N) = N_Identifier + and then Present (Renamed_Object (Entity (N))) + and then Nkind (Renamed_Object (Entity (N))) = N_Slice; + end Is_VM_By_Copy_Actual; + ---------------------- -- Nearest_Ancestor -- ---------------------- diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads index 3903f58..acf37e6 100755 --- a/gcc/ada/sem_aux.ads +++ b/gcc/ada/sem_aux.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -186,6 +186,10 @@ package Sem_Aux is -- composite containing a limited component, or a subtype of any of -- these types). + function Is_VM_By_Copy_Actual (N : Node_Id) return Boolean; + -- Returns True if we are compiling on VM targets and N is a node that + -- requires to be passed by copy in these targets. + function Nearest_Ancestor (Typ : Entity_Id) return Entity_Id; -- Given a subtype Typ, this function finds out the nearest ancestor from -- which constraints and predicates are inherited. There is no simple link |