From f9e333abc4f13e38bec21c5a85c92edef40e84d3 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 29 Jul 2014 15:54:42 +0200 Subject: [PATCH] [multiple changes] 2014-07-29 Hristian Kirtchev * freeze.adb (Freeze_Record_Type): Perform various volatility-related checks. 2014-07-29 Robert Dewar * sem_ch3.adb, sem_eval.adb: Minor reformatting. 2014-07-29 Ed Schonberg * sem_attr.adb: sem_attr.adb (Access_Attribute): Handle properly the case where the attribute reference appears in a nested scope from that of the subprogram prefix. * sem_attr.adb: Minor reformatting. 2014-07-29 Robert Dewar * gnat_ugn.texi: Clarify documentation of Initialize_Scalar initialization options. From-SVN: r213191 --- gcc/ada/ChangeLog | 21 +++++++++++++++++++++ gcc/ada/freeze.adb | 37 +++++++++++++++++++++++++++++++++++++ gcc/ada/gnat_ugn.texi | 39 +++++++++++++++++++++++++++++++++------ gcc/ada/sem_attr.adb | 22 +++++++++++++++------- gcc/ada/sem_ch3.adb | 17 +++++++---------- gcc/ada/sem_eval.adb | 2 +- 6 files changed, 114 insertions(+), 24 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 84d8760c7bc9..e7c08e5e2f60 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2014-07-29 Hristian Kirtchev + + * freeze.adb (Freeze_Record_Type): Perform various + volatility-related checks. + +2014-07-29 Robert Dewar + + * sem_ch3.adb, sem_eval.adb: Minor reformatting. + +2014-07-29 Ed Schonberg + + * sem_attr.adb: sem_attr.adb (Access_Attribute): Handle properly + the case where the attribute reference appears in a nested scope + from that of the subprogram prefix. + * sem_attr.adb: Minor reformatting. + +2014-07-29 Robert Dewar + + * gnat_ugn.texi: Clarify documentation of Initialize_Scalar + initialization options. + 2014-07-29 Robert Dewar * sinfo.ads: Minor comment addition. diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index ed3a90ae5b38..d6acef9163a2 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -3411,6 +3411,43 @@ 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 + if Is_SPARK_Volatile (Rec) then + + -- A discriminated type cannot be volatile (SPARK RM C.6(4)) + + if Has_Discriminants (Rec) then + Error_Msg_N ("discriminated type & cannot be volatile", Rec); + + -- A tagged type cannot be volatile (SPARK RM C.6(5)) + + elsif Is_Tagged_Type (Rec) then + Error_Msg_N ("tagged type & cannot be volatile", Rec); + end if; + + -- A non-volatile record type cannot contain volatile components + -- (SPARK RM C.6(2)) + + else + Comp := First_Component (Rec); + while Present (Comp) loop + if Comes_From_Source (Comp) + and then Is_SPARK_Volatile (Etype (Comp)) + then + Error_Msg_Name_1 := Chars (Rec); + Error_Msg_N + ("component & of non-volatile 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 diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 169233834df1..3c43f25930fb 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -8564,13 +8564,40 @@ Require all source files to be present. @cindex @option{^-S^/INITIALIZE_SCALARS^} (@command{gnatbind}) Specifies the value to be used when detecting uninitialized scalar objects with pragma Initialize_Scalars. -The @var{xxx} ^string specified with the switch^option^ may be either +The @var{xxx} ^string specified with the switch^option^ is one of: @itemize @bullet -@item ``@option{^in^INVALID^}'' requesting an invalid value where possible -@item ``@option{^lo^LOW^}'' for the lowest possible value (all 0 bits) -@item ``@option{^hi^HIGH^}'' for the highest possible value (all 1 bits) -@item ``@option{@var{xx}}'' for a value consisting of repeated bytes with the -value @code{16#@var{xx}#} (i.e., @var{xx} is a string of two hexadecimal digits). + +@item ``@option{^in^INVALID^}'' for an invalid value +If zero is invalid for the discrete type in question, +then the scalar value is set to all zero bits. +For signed discrete types, the largest possible negative value of +the underlying scalar is set (i.e. a one bit followed by all zero bits). +For unsigned discrete types, the underlying scalar value is set to all +one bits. For floating-point types, a NaN value is set +(see body of package System.Scalar_Values for exact values). + +@item ``@option{^lo^LOW^}'' for low value +If zero is invalid for the discrete type in question, +then the scalar value is set to all zero bits. +For signed discrete types, the largest possible negative value of +the underlying scalar is set (i.e. a one bit followed by all zero bits). +For unsigned discrete types, the underlying scalar value is set to all +zero bits. For floating-point, a small value is set +(see body of package System.Scalar_Values for exact values). + +@item ``@option{^hi^HIGH^}'' for high value +If zero is invalid for the discrete type in question, +then the scalar value is set to all one bits. +For signed discrete types, the largest possible positive value of +the underlying scalar is set (i.e. a zero bit followed by all one bits). +For unsigned discrete types, the underlying scalar value is set to all +one bits. For floating-point, a large value is set +(see body of package System.Scalar_Values for exact values). + +@item ``@option{@var{xx}}'' for hex value (two hex digits) +The underlying scalar is set to a value consisting of repeated bytes, whose +value corresponds to the given value. For example if @option{BF} is given, +then a 32-bit scalar value will be set to the bit patterm 16#BFBFBFBF#. @end itemize In addition, you can specify @option{-Sev} to indicate that the value is diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 67955e9903b9..6d0301cfc3da 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -10571,7 +10571,8 @@ package body Sem_Attr is if Is_Entity_Name (P) then declare - E : constant Entity_Id := Entity (P); + E : constant Entity_Id := Entity (P); + Decl : Node_Id; Flag : Entity_Id; -- If the access has been taken and the body of the subprogram @@ -10585,6 +10586,7 @@ package body Sem_Attr is begin if Is_Subprogram (E) + and then Expander_Active and then Comes_From_Source (E) and then Comes_From_Source (N) and then In_Open_Scopes (Scope (E)) @@ -10592,22 +10594,28 @@ package body Sem_Attr is Ekind_In (Scope (E), E_Block, E_Procedure, E_Function) and then not Has_Completion (E) and then No (Elaboration_Entity (E)) - and then Expander_Active + and then Nkind (Unit_Declaration_Node (E)) = + N_Subprogram_Declaration then -- Create elaboration variable for it Flag := Make_Temporary (Loc, 'E'); - - Set_Elaboration_Entity (E, Flag); - - Insert_Action (N, + Decl := Make_Object_Declaration (Loc, Defining_Identifier => Flag, Object_Definition => New_Occurrence_Of (Standard_Short_Integer, Loc), Expression => - Make_Integer_Literal (Loc, Uint_0))); + Make_Integer_Literal (Loc, Uint_0)); + Set_Elaboration_Entity (E, Flag); Set_Is_Frozen (Flag); + + -- Insert declaration for flag after subprogram + -- declaration. Note that attribute reference may + -- appear within a nested scope. + + Insert_After (Unit_Declaration_Node (E), Decl); + Analyze (Decl); end if; end; end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 506a4b082e0e..6b5601f38611 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -361,16 +361,13 @@ package body Sem_Ch3 is Related_Node : Node_Id; Typ : Entity_Id; Constraints : Elist_Id) return Entity_Id; - -- Given a discriminated base type Typ, a list of discriminant constraint - -- Constraints for Typ and a component of Typ, with type Compon_Type, - -- create and return the type corresponding to Compon_type where all - -- discriminant references are replaced with the corresponding constraint. - -- If no discriminant references occur in Compon_Typ then return it as is. - -- Constrained_Typ is the final constrained subtype to which the - -- constrained Compon_Type belongs. Related_Node is the node where we will - -- attach all the itypes created. - -- - -- Above description is confused, what is Compon_Type??? + -- Given a discriminated base type Typ, a list of discriminant constraints, + -- Constraints, for Typ and a component Comp of Typ, create and return the + -- type corresponding to Etype (Comp) where all discriminant references + -- are replaced with the corresponding constraint. If Etype (Comp) contains + -- no discriminant references then it is returned as-is. Constrained_Typ + -- is the final constrained subtype to which the constrained component + -- belongs. Related_Node is the node where we attach all created itypes. procedure Constrain_Access (Def_Id : in out Entity_Id; diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 074c2b4000f1..addd3319261d 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -363,7 +363,7 @@ package body Sem_Eval is elsif Is_String_Type (Typ) then if Real_Or_String_Static_Predicate_Matches - (Val => Expr_Value_S (Expr), Typ => Typ) + (Val => Expr_Value_S (Expr), Typ => Typ) then return; end if;