[multiple changes]

2014-07-29  Hristian Kirtchev  <kirtchev@adacore.com>

	* freeze.adb (Freeze_Record_Type): Perform various
	volatility-related checks.

2014-07-29  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb, sem_eval.adb: Minor reformatting.

2014-07-29  Ed Schonberg  <schonberg@adacore.com>

	* 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  <dewar@adacore.com>

	* gnat_ugn.texi: Clarify documentation of Initialize_Scalar
	initialization options.

From-SVN: r213191

6 files changed, 114 insertions, 24 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 84d8760..e7c08e5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,24 @@
+2014-07-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* freeze.adb (Freeze_Record_Type): Perform various
+	volatility-related checks.
+
+2014-07-29  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch3.adb, sem_eval.adb: Minor reformatting.
+
+2014-07-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* 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  <dewar@adacore.com>
+
+	* gnat_ugn.texi: Clarify documentation of Initialize_Scalar
+	initialization options.
+
 2014-07-29  Robert Dewar  <dewar@adacore.com>
 
 	* sinfo.ads: Minor comment addition.
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index ed3a90a..d6acef9 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 1692338..3c43f25 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 67955e9..6d0301c 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 506a4b0..6b5601f 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 074c2b4..addd331 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;