[multiple changes]

2014-06-13  Hristian Kirtchev  <kirtchev@adacore.com>

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

	* aspects.ads, aspects.adb: Add aspect Thread_Local_Storage.
	* gnat_rm.texi: Document aspect Thread_Local_Storage.

2014-06-13  Ed Schonberg  <schonberg@adacore.com>

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

	* einfo.ads: Minor reformatting an comment expansion.

From-SVN: r211613
This commit is contained in:
Arnaud Charlet 2014-06-13 11:44:48 +02:00
parent 5af638c875
commit aa6113321a
7 changed files with 70 additions and 36 deletions

View File

@ -1,3 +1,25 @@
2014-06-13 Hristian Kirtchev <kirtchev@adacore.com>
* 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 <dewar@adacore.com>
* aspects.ads, aspects.adb: Add aspect Thread_Local_Storage.
* gnat_rm.texi: Document aspect Thread_Local_Storage.
2014-06-13 Ed Schonberg <schonberg@adacore.com>
* 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 <schonberg@adacore.com>
* einfo.ads: Minor reformatting an comment expansion.
2014-06-13 Robert Dewar <dewar@adacore.com>
* back_end.ads, back_end.adb: Make_Id, Make_SC, Set_RND are moved to

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -2049,6 +2049,7 @@ package body Sem_Cat is
procedure Validate_Static_Object_Name (N : Node_Id) is
E : Entity_Id;
Val : Node_Id;
function Is_Primary (N : Node_Id) return Boolean;
-- Determine whether node is syntactically a primary in an expression
@ -2152,6 +2153,7 @@ package body Sem_Cat is
and then not Is_Static_Expression (N)
then
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