[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
This commit is contained in:
parent
b5ea9143e7
commit
9466892f26
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 :=
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 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 (Pack) or else Is_Generic_Instance (Pack))
|
||||
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
|
||||
|
|
|
@ -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 --
|
||||
-----------------------------------------
|
||||
|
|
166
gcc/ada/make.adb
166
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;
|
||||
|
||||
|
|
|
@ -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,8 +709,79 @@ 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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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 --
|
||||
----------------------
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue