From aa6113321ae9e0391e42fc6400d932bf35068432 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 13 Jun 2014 11:44:48 +0200 Subject: [PATCH] [multiple changes] 2014-06-13 Hristian Kirtchev * freeze.adb (Freeze_Record_Type): Remove checks related to SPARK volatile types. (Freeze_Type): Volatile types are now illegal in SPARK. 2014-06-13 Robert Dewar * aspects.ads, aspects.adb: Add aspect Thread_Local_Storage. * gnat_rm.texi: Document aspect Thread_Local_Storage. 2014-06-13 Ed Schonberg * sem_cat.adb (Validate_Static_Object_Name): A constant whose value is a temporary that renames an aggregate is legal in a preelaborated unit. Illegalities, if any will be detected in the aggregate components. 2014-06-13 Ed Schonberg * einfo.ads: Minor reformatting an comment expansion. From-SVN: r211613 --- gcc/ada/ChangeLog | 22 ++++++++++++++++++++++ gcc/ada/aspects.adb | 3 ++- gcc/ada/aspects.ads | 6 +++++- gcc/ada/einfo.ads | 5 +++++ gcc/ada/freeze.adb | 40 ++++++++-------------------------------- gcc/ada/gnat_rm.texi | 9 +++++++++ gcc/ada/sem_cat.adb | 21 +++++++++++++++++++-- 7 files changed, 70 insertions(+), 36 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 10ada4fcb7a..65feacf365c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2014-06-13 Hristian Kirtchev + + * freeze.adb (Freeze_Record_Type): Remove checks related to SPARK + volatile types. + (Freeze_Type): Volatile types are now illegal in SPARK. + +2014-06-13 Robert Dewar + + * aspects.ads, aspects.adb: Add aspect Thread_Local_Storage. + * gnat_rm.texi: Document aspect Thread_Local_Storage. + +2014-06-13 Ed Schonberg + + * sem_cat.adb (Validate_Static_Object_Name): A constant whose + value is a temporary that renames an aggregate is legal in a + preelaborated unit. Illegalities, if any will be detected in + the aggregate components. + +2014-06-13 Ed Schonberg + + * einfo.ads: Minor reformatting an comment expansion. + 2014-06-13 Robert Dewar * back_end.ads, back_end.adb: Make_Id, Make_SC, Set_RND are moved to diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index cc8d2f93d82..d79566d1396 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2010-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2010-2014, 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- -- @@ -583,6 +583,7 @@ package body Aspects is Aspect_Suppress_Debug_Info => Aspect_Suppress_Debug_Info, Aspect_Synchronization => Aspect_Synchronization, Aspect_Test_Case => Aspect_Test_Case, + Aspect_Thread_Local_Storage => Aspect_Thread_Local_Storage, Aspect_Type_Invariant => Aspect_Invariant, Aspect_Unchecked_Union => Aspect_Unchecked_Union, Aspect_Universal_Aliasing => Aspect_Universal_Aliasing, diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index ad79cbdbbd7..8199df9f39a 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2010-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2010-2014, 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- -- @@ -183,6 +183,7 @@ package Aspects is Aspect_Shared, -- GNAT (equivalent to Atomic) Aspect_Simple_Storage_Pool_Type, -- GNAT Aspect_Suppress_Debug_Info, -- GNAT + Aspect_Thread_Local_Storage, -- GNAT Aspect_Unchecked_Union, Aspect_Universal_Aliasing, -- GNAT Aspect_Unmodified, -- GNAT @@ -237,6 +238,7 @@ package Aspects is Aspect_Simple_Storage_Pool => True, Aspect_Simple_Storage_Pool_Type => True, Aspect_Suppress_Debug_Info => True, + Aspect_Thread_Local_Storage => True, Aspect_Test_Case => True, Aspect_Universal_Aliasing => True, Aspect_Universal_Data => True, @@ -454,6 +456,7 @@ package Aspects is Aspect_Stream_Size => Name_Stream_Size, Aspect_Suppress => Name_Suppress, Aspect_Suppress_Debug_Info => Name_Suppress_Debug_Info, + Aspect_Thread_Local_Storage => Name_Thread_Local_Storage, Aspect_Synchronization => Name_Synchronization, Aspect_Test_Case => Name_Test_Case, Aspect_Type_Invariant => Name_Type_Invariant, @@ -647,6 +650,7 @@ package Aspects is Aspect_Stream_Size => Always_Delay, Aspect_Suppress => Always_Delay, Aspect_Suppress_Debug_Info => Always_Delay, + Aspect_Thread_Local_Storage => Always_Delay, Aspect_Type_Invariant => Always_Delay, Aspect_Unchecked_Union => Always_Delay, Aspect_Universal_Aliasing => Always_Delay, diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 6a62e2e7810..51b537bb93c 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -4057,6 +4057,11 @@ package Einfo is -- types, is to legitimize code where Underlying_Type is applied to an -- entity which may or may not be a type, with the intent that if it is a -- type, its underlying type is taken. +-- +-- Note also that the value of this attribute is interesting only after +-- the full view of the parent type has been processed. If the parent +-- type is declared in an enclosing package, the attribute will be non- +-- trivial only after the full view of the type has been analyzed. -- Universal_Aliasing (Flag216) [implementation base type only] -- Defined in all type entities. Set to direct the back-end to avoid diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index bfd15f3bd18..e1bfc9a3bbe 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -3355,38 +3355,6 @@ package body Freeze is end if; end if; - -- The following checks are only relevant when SPARK_Mode is on as - -- they are not standard Ada legality rules. - - if SPARK_Mode = On then - - -- Volatile types are not allowed in SPARK (SPARK RM C.6(1)) - - if Is_SPARK_Volatile (Rec) then - Error_Msg_N ("volatile type not allowed", Rec); - - -- A non-volatile record type cannot contain volatile components - -- (SPARK RM C.6(2)). The check is performed at freeze point - -- because the volatility status of the record type and its - -- components is clearly known. - - else - Comp := First_Component (Rec); - while Present (Comp) loop - if Comes_From_Source (Comp) - and then Is_SPARK_Volatile (Comp) - then - Error_Msg_Name_1 := Chars (Rec); - Error_Msg_N - ("component & of non-volatile record type % cannot be " - & "volatile", Comp); - end if; - - Next_Component (Comp); - end loop; - end if; - end if; - -- All done if not a full record definition if Ekind (Rec) /= E_Record_Type then @@ -3718,6 +3686,14 @@ package body Freeze is Analyze_Aspects_At_Freeze_Point (E); end if; + -- The following check is only relevant when SPARK_Mode is on as this + -- is not a standard Ada legality rule. Volatile types are not allowed + -- (SPARK RM C.6(1)). + + if SPARK_Mode = On and then Is_SPARK_Volatile (E) then + Error_Msg_N ("volatile type not allowed", E); + end if; + -- Here to freeze the entity Set_Is_Frozen (E); diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 0d86a40ccc2..f7b1afa3bc7 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -304,6 +304,7 @@ Implementation Defined Aspects * Aspect SPARK_Mode:: * Aspect Suppress_Debug_Info:: * Aspect Test_Case:: +* Aspect Thread_Local_Storage:: * Aspect Universal_Aliasing:: * Aspect Universal_Data:: * Aspect Unmodified:: @@ -7867,6 +7868,7 @@ clause. * Aspect SPARK_Mode:: * Aspect Suppress_Debug_Info:: * Aspect Test_Case:: +* Aspect Thread_Local_Storage:: * Aspect Universal_Aliasing:: * Aspect Universal_Data:: * Aspect Unmodified:: @@ -8125,6 +8127,12 @@ This aspect is equivalent to pragma @code{Suppress_Debug_Info}. @noindent This aspect is equivalent to pragma @code{Test_Case}. +@node Aspect Thread_Local_Storage +@unnumberedsec Aspect Thread_Local_Storage +@findex Thread_Local_Storage +@noindent +This aspect is equivalent to pragma @code{Thread_Local_Storage}. + @node Aspect Universal_Aliasing @unnumberedsec Aspect Universal_Aliasing @findex Universal_Aliasing @@ -20834,6 +20842,7 @@ A complete description of the AIs may be found in @item @code{Suppress} @tab @item @code{Suppress_Debug_Info} @tab -- GNAT @item @code{Test_Case} @tab -- GNAT +@item @code{Thread_Local_Storage} @tab -- GNAT @item @code{Type_Invariant} @tab @item @code{Unchecked_Union} @tab @item @code{Universal_Aliasing} @tab -- GNAT diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb index f17a9812b53..a939cea7110 100644 --- a/gcc/ada/sem_cat.adb +++ b/gcc/ada/sem_cat.adb @@ -2048,7 +2048,8 @@ package body Sem_Cat is --------------------------------- procedure Validate_Static_Object_Name (N : Node_Id) is - E : Entity_Id; + E : Entity_Id; + Val : Node_Id; function Is_Primary (N : Node_Id) return Boolean; -- Determine whether node is syntactically a primary in an expression @@ -2151,7 +2152,8 @@ package body Sem_Cat is elsif Ekind (Entity (N)) = E_Constant and then not Is_Static_Expression (N) then - E := Entity (N); + E := Entity (N); + Val := Constant_Value (E); if Is_Internal_File_Name (Unit_File_Name (Get_Source_Unit (N))) and then @@ -2169,6 +2171,21 @@ package body Sem_Cat is then null; + -- If the value of the constant is a local variable that renames + -- an aggregate, this is in itself legal. The aggregate may be + -- expanded into a loop, but this does not affect preelaborability + -- in itself. If some aggregate components are non-static, that is + -- to say if they involve non static primaries, they will be + -- flagged when analyzed. + + elsif Present (Val) + and then Is_Entity_Name (Val) + and then Is_Array_Type (Etype (Val)) + and then not Comes_From_Source (Val) + and then Nkind (Original_Node (Val)) = N_Aggregate + then + null; + -- This is the error case else