OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[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:
Arnaud Charlet 2011-08-03 11:59:55 +02:00
parent b5ea9143e7
commit 9466892f26
13 changed files with 334 additions and 201 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
gcc/ada/ChangeLog
View File

@ -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

13
gcc/ada/alfa.ads
View File

@ -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

24
gcc/ada/exp_ch9.adb
View File

@ -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 :=

43
gcc/ada/get_alfa.adb
View File

@ -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

14
gcc/ada/inline.adb
View File

@ -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

125
gcc/ada/lib-xref-alfa.adb
View File

@ -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
View File

@ -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;

78
gcc/ada/makeutl.adb
View File

@ -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

9
gcc/ada/makeutl.ads
View File

@ -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;

4
gcc/ada/prj-tree.adb
View File

@ -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;

10
gcc/ada/put_alfa.adb
View File

@ -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;

13
gcc/ada/sem_aux.adb
View File

@ -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
gcc/ada/sem_aux.ads
View File

@ -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