OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
gcc/ada/ChangeLog
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>
* sinfo.ads: Minor comment addition.

37
gcc/ada/freeze.adb
View File

@ -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

39
gcc/ada/gnat_ugn.texi
View File

@ -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

22
gcc/ada/sem_attr.adb
View File

@ -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;

17
gcc/ada/sem_ch3.adb
View File

@ -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;

2
gcc/ada/sem_eval.adb
View File

@ -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;