[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
This commit is contained in:
Arnaud Charlet 2014-07-29 15:54:42 +02:00
parent 87e697202e
commit f9e333abc4
6 changed files with 114 additions and 24 deletions

View File

@ -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> 2014-07-29 Robert Dewar <dewar@adacore.com>
* sinfo.ads: Minor comment addition. * sinfo.ads: Minor comment addition.

View File

@ -3411,6 +3411,43 @@ package body Freeze is
end if; end if;
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 -- All done if not a full record definition
if Ekind (Rec) /= E_Record_Type then if Ekind (Rec) /= E_Record_Type then

View File

@ -8564,13 +8564,40 @@ Require all source files to be present.
@cindex @option{^-S^/INITIALIZE_SCALARS^} (@command{gnatbind}) @cindex @option{^-S^/INITIALIZE_SCALARS^} (@command{gnatbind})
Specifies the value to be used when detecting uninitialized scalar Specifies the value to be used when detecting uninitialized scalar
objects with pragma Initialize_Scalars. 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 @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{^in^INVALID^}'' for an invalid value
@item ``@option{^hi^HIGH^}'' for the highest possible value (all 1 bits) If zero is invalid for the discrete type in question,
@item ``@option{@var{xx}}'' for a value consisting of repeated bytes with the then the scalar value is set to all zero bits.
value @code{16#@var{xx}#} (i.e., @var{xx} is a string of two hexadecimal digits). 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 @end itemize
In addition, you can specify @option{-Sev} to indicate that the value is In addition, you can specify @option{-Sev} to indicate that the value is

View File

@ -10571,7 +10571,8 @@ package body Sem_Attr is
if Is_Entity_Name (P) then if Is_Entity_Name (P) then
declare declare
E : constant Entity_Id := Entity (P); E : constant Entity_Id := Entity (P);
Decl : Node_Id;
Flag : Entity_Id; Flag : Entity_Id;
-- If the access has been taken and the body of the subprogram -- If the access has been taken and the body of the subprogram
@ -10585,6 +10586,7 @@ package body Sem_Attr is
begin begin
if Is_Subprogram (E) if Is_Subprogram (E)
and then Expander_Active
and then Comes_From_Source (E) and then Comes_From_Source (E)
and then Comes_From_Source (N) and then Comes_From_Source (N)
and then In_Open_Scopes (Scope (E)) 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) Ekind_In (Scope (E), E_Block, E_Procedure, E_Function)
and then not Has_Completion (E) and then not Has_Completion (E)
and then No (Elaboration_Entity (E)) and then No (Elaboration_Entity (E))
and then Expander_Active and then Nkind (Unit_Declaration_Node (E)) =
N_Subprogram_Declaration
then then
-- Create elaboration variable for it -- Create elaboration variable for it
Flag := Make_Temporary (Loc, 'E'); Flag := Make_Temporary (Loc, 'E');
Decl :=
Set_Elaboration_Entity (E, Flag);
Insert_Action (N,
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => Flag, Defining_Identifier => Flag,
Object_Definition => Object_Definition =>
New_Occurrence_Of (Standard_Short_Integer, Loc), New_Occurrence_Of (Standard_Short_Integer, Loc),
Expression => Expression =>
Make_Integer_Literal (Loc, Uint_0))); Make_Integer_Literal (Loc, Uint_0));
Set_Elaboration_Entity (E, Flag);
Set_Is_Frozen (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 if;
end; end;
end if; end if;

View File

@ -361,16 +361,13 @@ package body Sem_Ch3 is
Related_Node : Node_Id; Related_Node : Node_Id;
Typ : Entity_Id; Typ : Entity_Id;
Constraints : Elist_Id) return Entity_Id; Constraints : Elist_Id) return Entity_Id;
-- Given a discriminated base type Typ, a list of discriminant constraint -- Given a discriminated base type Typ, a list of discriminant constraints,
-- Constraints for Typ and a component of Typ, with type Compon_Type, -- Constraints, for Typ and a component Comp of Typ, create and return the
-- create and return the type corresponding to Compon_type where all -- type corresponding to Etype (Comp) where all discriminant references
-- discriminant references are replaced with the corresponding constraint. -- are replaced with the corresponding constraint. If Etype (Comp) contains
-- If no discriminant references occur in Compon_Typ then return it as is. -- no discriminant references then it is returned as-is. Constrained_Typ
-- Constrained_Typ is the final constrained subtype to which the -- is the final constrained subtype to which the constrained component
-- constrained Compon_Type belongs. Related_Node is the node where we will -- belongs. Related_Node is the node where we attach all created itypes.
-- attach all the itypes created.
--
-- Above description is confused, what is Compon_Type???
procedure Constrain_Access procedure Constrain_Access
(Def_Id : in out Entity_Id; (Def_Id : in out Entity_Id;

View File

@ -363,7 +363,7 @@ package body Sem_Eval is
elsif Is_String_Type (Typ) then elsif Is_String_Type (Typ) then
if Real_Or_String_Static_Predicate_Matches if Real_Or_String_Static_Predicate_Matches
(Val => Expr_Value_S (Expr), Typ => Typ) (Val => Expr_Value_S (Expr), Typ => Typ)
then then
return; return;
end if; end if;