aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2011-08-03 11:59:55 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2011-08-03 11:59:55 +0200
commit9466892f26037f47b9406de56f8ec0f0ed8588a5 (patch)
tree31d4ca3913ebc45ae492b86546843f75431efc60 /gcc
parentb5ea9143e7536eb2e599ee581b06c5f21129b86b (diff)
downloadgcc-9466892f26037f47b9406de56f8ec0f0ed8588a5.zip
gcc-9466892f26037f47b9406de56f8ec0f0ed8588a5.tar.gz
gcc-9466892f26037f47b9406de56f8ec0f0ed8588a5.tar.bz2
[multiple changes]
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. From-SVN: r177256
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog30
-rw-r--r--gcc/ada/alfa.ads13
-rw-r--r--gcc/ada/exp_ch9.adb24
-rw-r--r--gcc/ada/get_alfa.adb43
-rw-r--r--gcc/ada/inline.adb16
-rw-r--r--gcc/ada/lib-xref-alfa.adb125
-rw-r--r--gcc/ada/make.adb166
-rw-r--r--gcc/ada/makeutl.adb78
-rw-r--r--gcc/ada/makeutl.ads9
-rw-r--r--gcc/ada/prj-tree.adb4
-rw-r--r--gcc/ada/put_alfa.adb10
-rwxr-xr-xgcc/ada/sem_aux.adb13
-rwxr-xr-xgcc/ada/sem_aux.ads6
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