mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-11 18:01:34 +08:00
Code Issues Packages Projects Releases Wiki Activity

2010-10-22 Thomas Quinot <quinot@adacore.com>

Browse Source 
* sem_prag.adb, sem_ch12.adb, sem_util.adb, sem_util.ads
	(Is_Generic_Formal): Move from body of Sem_Ch12 to Sem_Util.
	(Check_Arg_Is_Local_Name): Fix check in the case of a pragma appearing
	immediately after a library unit.
	(Analyze_Pragma, case Preelaborable_Initialization): Pragma may apply to
	a formal derived type.

From-SVN: r165810
This commit is contained in:
Thomas Quinot 2010-10-22 09:32:30 +00:00 committed by Arnaud Charlet
parent d32e3ceeb2
commit c3ad80f000
5 changed files with 101 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/ada/ChangeLog
View File

@ -1,3 +1,12 @@
2010-10-22 Thomas Quinot <quinot@adacore.com>
* sem_prag.adb, sem_ch12.adb, sem_util.adb, sem_util.ads
(Is_Generic_Formal): Move from body of Sem_Ch12 to Sem_Util.
(Check_Arg_Is_Local_Name): Fix check in the case of a pragma appearing
immediately after a library unit.
(Analyze_Pragma, case Preelaborable_Initialization): Pragma may apply to
a formal derived type.
2010-10-22 Geert Bosch <bosch@adacore.com>
* gcc-interface/Make-lang.in: Remove ttypef.ads

29
gcc/ada/sem_ch12.adb
View File

@ -470,12 +470,6 @@ package body Sem_Ch12 is
-- Used to determine whether its body should be elaborated to allow
-- front-end inlining.
function Is_Generic_Formal (E : Entity_Id) return Boolean;
-- Utility to determine whether a given entity is declared by means of
-- of a formal parameter declaration. Used to set properly the visibility
-- of generic formals of a generic package declared with a box or with
-- partial parametrization.
procedure Set_Instance_Env
(Gen_Unit : Entity_Id;
Act_Unit : Entity_Id);
@ -10480,29 +10474,6 @@ package body Sem_Ch12 is
return Decl_Nodes;
end Instantiate_Type;
-----------------------
-- Is_Generic_Formal --
-----------------------
function Is_Generic_Formal (E : Entity_Id) return Boolean is
Kind : Node_Kind;
begin
if No (E) then
return False;
else
Kind := Nkind (Parent (E));
return
Nkind_In (Kind, N_Formal_Object_Declaration,
N_Formal_Package_Declaration,
N_Formal_Type_Declaration)
or else
(Is_Formal_Subprogram (E)
and then
Nkind (Parent (Parent (E))) in
N_Formal_Subprogram_Declaration);
end if;
end Is_Generic_Formal;
---------------------
-- Is_In_Main_Unit --
---------------------

76
gcc/ada/sem_prag.adb
View File

@ -901,11 +901,67 @@ package body Sem_Prag is
Error_Pragma_Arg ("argument for pragma% must be local name", Argx);
end if;
if Is_Entity_Name (Argx)
and then Scope (Entity (Argx)) /= Current_Scope
then
Error_Pragma_Arg
("pragma% argument must be in same declarative part", Arg);
-- No further check required if not an entity name
if not Is_Entity_Name (Argx) then
null;
else
declare
OK : Boolean;
Ent : constant Entity_Id := Entity (Argx);
Scop : constant Entity_Id := Scope (Ent);
begin
-- Case of a pragma applied to a compilation unit: pragma must
-- occur immediately after the program unit in the compilation.
if Is_Compilation_Unit (Ent) then
declare
Decl : constant Node_Id := Unit_Declaration_Node (Ent);
begin
-- Case of pragma placed immediately after spec
if Parent (N) = Aux_Decls_Node (Parent (Decl)) then
OK := True;
-- Case of pragma placed immediately after body
elsif Nkind (Decl) = N_Subprogram_Declaration
and then Present (Corresponding_Body (Decl))
then
OK := Parent (N) =
Aux_Decls_Node
(Parent (Unit_Declaration_Node
(Corresponding_Body (Decl))));
-- All other cases are illegal
else
OK := False;
end if;
end;
-- Special restricted placement rule from 10.2.1(11.8/2)
elsif Is_Generic_Formal (Ent)
and then Prag_Id = Pragma_Preelaborable_Initialization
then
OK := List_Containing (N) =
Generic_Formal_Declarations
(Unit_Declaration_Node (Scop));
-- Default case, just check that the pragma occurs in the scope
-- of the entity denoted by the name.
else
OK := Current_Scope = Scop;
end if;
if not OK then
Error_Pragma_Arg
("pragma% argument must be in same declarative part", Arg);
end if;
end;
end if;
end Check_Arg_Is_Local_Name;
@ -10985,11 +11041,15 @@ package body Sem_Prag is
Check_First_Subtype (Arg1);
Ent := Entity (Get_Pragma_Arg (Arg1));
if not Is_Private_Type (Ent)
and then not Is_Protected_Type (Ent)
if not (Is_Private_Type (Ent)
or else
Is_Protected_Type (Ent)
or else
(Is_Generic_Type (Ent) and then Is_Derived_Type (Ent)))
then
Error_Pragma_Arg
("pragma % can only be applied to private or protected type",
("pragma % can only be applied to private, formal derived or "
& "protected type",
Arg1);
end if;

19
gcc/ada/sem_util.adb
View File

@ -6559,6 +6559,25 @@ package body Sem_Util is
end if;
end Is_Fully_Initialized_Variant;
-----------------------
-- Is_Generic_Formal --
-----------------------
function Is_Generic_Formal (E : Entity_Id) return Boolean is
Kind : Node_Kind;
begin
if No (E) then
return False;
else
Kind := Nkind (Parent (E));
return
Nkind_In (Kind, N_Formal_Object_Declaration,
N_Formal_Package_Declaration,
N_Formal_Type_Declaration)
or else Is_Formal_Subprogram (E);
end if;
end Is_Generic_Formal;
------------
-- Is_LHS --
------------

5
gcc/ada/sem_util.ads
View File

@ -733,6 +733,11 @@ package Sem_Util is
-- means that the result returned is not crucial, but should err on the
-- side of thinking things are fully initialized if it does not know.
function Is_Generic_Formal (E : Entity_Id) return Boolean;
-- Determine whether E is a generic formal parameter. In particular this is
-- used to set the visibility of generic formals of a generic package
-- declared with a box or with partial parametrization.
function Is_Inherited_Operation (E : Entity_Id) return Boolean;
-- E is a subprogram. Return True is E is an implicit operation inherited
-- by a derived type declarations.