Commit 6191e212 by Arnaud Charlet

[multiple changes]

2010-10-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specifications): If subprogram is at the
	library level, the pre/postconditions must be treated as global
	declarations, i.e. placed on the Aux_Decl nodes of the compilation unit.
	* freeze.adb (Freeze_Expression): If the expression is at library level
	there is no enclosing record to check.

2010-10-18  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.ads (Find_Type_Name): Add documentation.
	* sem_ch3.adb (Analyze_Full_Type_Declaration): Code cleanup because the
	propagation of the class-wide entity is now done by routine
	Find_Type_Name to factorize this code.
	(Analyze_Private_Extension_Declaration): Handle private type that
	completes an incomplete type.
	(Tag_Mismatch): Add error message for tag mismatch in a private type
	declaration that completes an incomplete type.
	(Find_Type_Name): Handle completion of incomplete type by means of
	a private declaration. Generate an error if a tagged incomplete type
	is completed by an untagged private type.
	* sem_ch7.adb (New_Private_Type): Handle private type that completes an
	incomplete type.
	* einfo.ads (Full_View): Add documentation.

2010-10-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Analyze_Formal_Package_Declaration): If the package is
	a renaming, generate a reference for it before analyzing the renamed
	entity, to prevent spurious warnings.

From-SVN: r165636
parent 0ae44446
2010-10-18 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Analyze_Aspect_Specifications): If subprogram is at the
library level, the pre/postconditions must be treated as global
declarations, i.e. placed on the Aux_Decl nodes of the compilation unit.
* freeze.adb (Freeze_Expression): If the expression is at library level
there is no enclosing record to check.
2010-10-18 Javier Miranda <miranda@adacore.com>
* sem_ch3.ads (Find_Type_Name): Add documentation.
* sem_ch3.adb (Analyze_Full_Type_Declaration): Code cleanup because the
propagation of the class-wide entity is now done by routine
Find_Type_Name to factorize this code.
(Analyze_Private_Extension_Declaration): Handle private type that
completes an incomplete type.
(Tag_Mismatch): Add error message for tag mismatch in a private type
declaration that completes an incomplete type.
(Find_Type_Name): Handle completion of incomplete type by means of
a private declaration. Generate an error if a tagged incomplete type
is completed by an untagged private type.
* sem_ch7.adb (New_Private_Type): Handle private type that completes an
incomplete type.
* einfo.ads (Full_View): Add documentation.
2010-10-18 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Analyze_Formal_Package_Declaration): If the package is
a renaming, generate a reference for it before analyzing the renamed
entity, to prevent spurious warnings.
2010-10-18 Jose Ruiz <ruiz@adacore.com>
* adaint.c (__gnat_pthread_setaffinity_np,
......
......@@ -1283,7 +1283,10 @@ package Einfo is
-- Present in all type and subtype entities and in deferred constants.
-- References the entity for the corresponding full type declaration.
-- For all types other than private and incomplete types, this field
-- always contains Empty. See also Underlying_Type.
-- always contains Empty. If an incomplete type E1 is completed by a
-- private type E2 whose full type declaration entity is E3 then the
-- full view of E1 is E2, and the full view of E2 is E3. See also
-- Underlying_Type.
-- Generic_Homonym (Node11)
-- Present in generic packages. The generic homonym is the entity of
......
......@@ -4570,8 +4570,12 @@ package body Freeze is
-- The current scope may be that of a constrained component of
-- an enclosing record declaration, which is above the current
-- scope in the scope stack.
-- If the expression is within a top-level pragma, as for a pre-
-- condition on a library-level subprogram, nothing to do.
if Is_Record_Type (Scope (Current_Scope)) then
if not Is_Compilation_Unit (Current_Scope)
and then Is_Record_Type (Scope (Current_Scope))
then
Pos := Pos - 1;
end if;
......
......@@ -2112,6 +2112,15 @@ package body Sem_Ch12 is
-- Check for a formal package that is a package renaming
if Present (Renamed_Object (Gen_Unit)) then
-- Indicate that unit is used, before replacing it with renamed
-- entity for use below.
if In_Extended_Main_Source_Unit (N) then
Set_Is_Instantiated (Gen_Unit);
Generate_Reference (Gen_Unit, N);
end if;
Gen_Unit := Renamed_Object (Gen_Unit);
end if;
......
......@@ -995,11 +995,19 @@ package body Sem_Ch13 is
-- about delay issues, since the pragmas themselves deal
-- with delay of visibility for the expression analysis.
Insert_After (N, Aitem);
-- If the entity is a library-level subprogram, the pre/
-- postconditions must be treated as late pragmas.
if Nkind (Parent (N)) = N_Compilation_Unit then
Add_Global_Declaration (Aitem);
else
Insert_After (N, Aitem);
end if;
goto Continue;
end;
-- Aspects currently unimplemented
-- Aspects currently unimplemented
when Aspect_Invariant |
Aspect_Predicate =>
......
......@@ -2171,24 +2171,10 @@ package body Sem_Ch3 is
-- imported through a LIMITED WITH clause, it appears as incomplete
-- but has no full view.
-- If the incomplete view is tagged, a class_wide type has been
-- created already. Use it for the full view as well, to prevent
-- multiple incompatible class-wide types that may be created for
-- self-referential anonymous access components.
if Ekind (Prev) = E_Incomplete_Type
and then Present (Full_View (Prev))
then
T := Full_View (Prev);
if Is_Tagged_Type (Prev)
and then Present (Class_Wide_Type (Prev))
then
Set_Ekind (T, Ekind (Prev)); -- will be reset later
Set_Class_Wide_Type (T, Class_Wide_Type (Prev));
Set_Etype (Class_Wide_Type (T), T);
end if;
else
T := Prev;
end if;
......@@ -3605,7 +3591,26 @@ package body Sem_Ch3 is
end if;
Generate_Definition (T);
Enter_Name (T);
if Ada_Version < Ada_2012 then
Enter_Name (T);
-- Ada 2012 (AI05-0162): Enter the name in the current scope handling
-- case of private type that completes an incomplete type.
else
declare
Prev : Entity_Id;
begin
Prev := Find_Type_Name (N);
pragma Assert (Prev = T
or else (Ekind (Prev) = E_Incomplete_Type
and then Present (Full_View (Prev))
and then Full_View (Prev) = T));
end;
end if;
Parent_Type := Find_Type_Of_Subtype_Indic (Indic);
Parent_Base := Base_Type (Parent_Type);
......@@ -14085,11 +14090,25 @@ package body Sem_Ch3 is
procedure Tag_Mismatch is
begin
if Sloc (Prev) < Sloc (Id) then
Error_Msg_NE
("full declaration of } must be a tagged type ", Id, Prev);
if Ada_Version >= Ada_2012
and then Nkind (N) = N_Private_Type_Declaration
then
Error_Msg_NE
("declaration of private } must be a tagged type ", Id, Prev);
else
Error_Msg_NE
("full declaration of } must be a tagged type ", Id, Prev);
end if;
else
Error_Msg_NE
("full declaration of } must be a tagged type ", Prev, Id);
if Ada_Version >= Ada_2012
and then Nkind (N) = N_Private_Type_Declaration
then
Error_Msg_NE
("declaration of private } must be a tagged type ", Prev, Id);
else
Error_Msg_NE
("full declaration of } must be a tagged type ", Prev, Id);
end if;
end if;
end Tag_Mismatch;
......@@ -14100,21 +14119,35 @@ package body Sem_Ch3 is
Prev := Current_Entity_In_Scope (Id);
if Present (Prev) then
-- New type declaration
if No (Prev) then
Enter_Name (Id);
return Id;
-- Previous declaration exists. Error if not incomplete/private case
-- except if previous declaration is implicit, etc. Enter_Name will
-- emit error if appropriate.
-- Previous declaration exists
else
Prev_Par := Parent (Prev);
-- Error if not incomplete/private case except if previous
-- declaration is implicit, etc. Enter_Name will emit error if
-- appropriate.
if not Is_Incomplete_Or_Private_Type (Prev) then
Enter_Name (Id);
New_Id := Id;
-- Check invalid completion of private or incomplete type
elsif not Nkind_In (N, N_Full_Type_Declaration,
N_Task_Type_Declaration,
N_Protected_Type_Declaration)
and then
(Ada_Version < Ada_2012
or else not Is_Incomplete_Type (Prev)
or else not Nkind_In (N, N_Private_Type_Declaration,
N_Private_Extension_Declaration))
then
-- Completion must be a full type declarations (RM 7.3(4))
......@@ -14136,7 +14169,11 @@ package body Sem_Ch3 is
-- Case of full declaration of incomplete type
elsif Ekind (Prev) = E_Incomplete_Type then
elsif Ekind (Prev) = E_Incomplete_Type
and then (Ada_Version < Ada_2012
or else No (Full_View (Prev))
or else not Is_Private_Type (Full_View (Prev)))
then
-- Indicate that the incomplete declaration has a matching full
-- declaration. The defining occurrence of the incomplete
......@@ -14153,9 +14190,34 @@ package body Sem_Ch3 is
Set_Is_Internal (Id);
New_Id := Prev;
-- If the incomplete view is tagged, a class_wide type has been
-- created already. Use it for the private type as well, in order
-- to prevent multiple incompatible class-wide types that may be
-- created for self-referential anonymous access components.
if Is_Tagged_Type (Prev)
and then Present (Class_Wide_Type (Prev))
then
Set_Ekind (Id, Ekind (Prev)); -- will be reset later
Set_Class_Wide_Type (Id, Class_Wide_Type (Prev));
Set_Etype (Class_Wide_Type (Id), Id);
end if;
-- Case of full declaration of private type
else
-- If the private type was a completion of an incomplete type then
-- update Prev to reference the private type
if Ada_Version >= Ada_2012
and then Ekind (Prev) = E_Incomplete_Type
and then Present (Full_View (Prev))
and then Is_Private_Type (Full_View (Prev))
then
Prev := Full_View (Prev);
Prev_Par := Parent (Prev);
end if;
if Nkind (Parent (Prev)) /= N_Private_Extension_Declaration then
if Etype (Prev) /= Prev then
......@@ -14273,14 +14335,30 @@ package body Sem_Ch3 is
if Is_Type (Prev)
and then (Is_Tagged_Type (Prev)
or else Present (Class_Wide_Type (Prev)))
or else Present (Class_Wide_Type (Prev)))
then
-- Ada 2012 (AI05-0162): A private type may be the completion of
-- an incomplete type
if Ada_Version >= Ada_2012
and then Is_Incomplete_Type (Prev)
and then Nkind_In (N, N_Private_Type_Declaration,
N_Private_Extension_Declaration)
then
-- No need to check private extensions since they are tagged
if Nkind (N) = N_Private_Type_Declaration
and then not Tagged_Present (N)
then
Tag_Mismatch;
end if;
-- The full declaration is either a tagged type (including
-- a synchronized type that implements interfaces) or a
-- type extension, otherwise this is an error.
if Nkind_In (N, N_Task_Type_Declaration,
N_Protected_Type_Declaration)
elsif Nkind_In (N, N_Task_Type_Declaration,
N_Protected_Type_Declaration)
then
if No (Interface_List (N))
and then not Error_Posted (N)
......@@ -14315,12 +14393,6 @@ package body Sem_Ch3 is
end if;
return New_Id;
else
-- New type declaration
Enter_Name (Id);
return Id;
end if;
end Find_Type_Name;
......
......@@ -157,7 +157,10 @@ package Sem_Ch3 is
function Find_Type_Name (N : Node_Id) return Entity_Id;
-- Enter the identifier in a type definition, or find the entity already
-- declared, in the case of the full declaration of an incomplete or
-- private type.
-- private type. If the previous declaration is tagged then the class-wide
-- entity is propagated to the identifier to prevent multiple incompatible
-- class-wide types that may be created for self-referential anonymous
-- access components.
function Get_Discriminant_Value
(Discriminant : Entity_Id;
......
......@@ -1919,7 +1919,25 @@ package body Sem_Ch7 is
procedure New_Private_Type (N : Node_Id; Id : Entity_Id; Def : Node_Id) is
begin
Enter_Name (Id);
if Ada_Version < Ada_2012 then
Enter_Name (Id);
-- Ada 2012 (AI05-0162): Enter the name in the current scope handling
-- private type that completes an incomplete type.
else
declare
Prev : Entity_Id;
begin
Prev := Find_Type_Name (N);
pragma Assert (Prev = Id
or else (Ekind (Prev) = E_Incomplete_Type
and then Present (Full_View (Prev))
and then Full_View (Prev) = Id));
end;
end if;
if Limited_Present (Def) then
Set_Ekind (Id, E_Limited_Private_Type);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment