From 6191e212520651b7e7d3102be7a735677989ad19 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 18 Oct 2010 15:58:25 +0200 Subject: [PATCH] [multiple changes] 2010-10-18 Ed Schonberg * 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 * 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 * 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 --- gcc/ada/ChangeLog | 31 ++++++++++++ gcc/ada/einfo.ads | 5 +- gcc/ada/freeze.adb | 6 ++- gcc/ada/sem_ch12.adb | 9 ++++ gcc/ada/sem_ch13.adb | 12 ++++- gcc/ada/sem_ch3.adb | 138 +++++++++++++++++++++++++++++++++++++++------------ gcc/ada/sem_ch3.ads | 5 +- gcc/ada/sem_ch7.adb | 20 +++++++- 8 files changed, 187 insertions(+), 39 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 847bef2..057e3d1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,34 @@ +2010-10-18 Ed Schonberg + + * 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 + + * 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 + + * 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 * adaint.c (__gnat_pthread_setaffinity_np, diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index f32ade5..7a39892 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -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 diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 91e9843..ca73e86 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -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; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index c139cf9..45b61bb 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -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; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 8966e15..2132e3c 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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 => diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index a17ab53..a54393a 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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; diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads index 2bff2e2..57da532 100644 --- a/gcc/ada/sem_ch3.ads +++ b/gcc/ada/sem_ch3.ads @@ -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; diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 08d68bf..108b158 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -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); -- 2.7.4