[multiple changes]

2015-10-16  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb, sem_util.ads, sem_ch6.adb, sem_ch7.adb, sem_ch8.adb:
	Minor reformatting.
	* sem_ch12.adb (Analyze_Formal_Package_Declaration): Set the
	SPARK_Mode from the context.

2015-10-16  Bob Duff  <duff@adacore.com>

	* sem_util.adb (Requires_Transient_Scope):
	If Typ is a generic formal incomplete type, look at the actual
	type. Otherwise, we don't notice that the actual type is tagged,
	has a variant part, etc, causing a mismatch of calling conventions
	between caller and callee.

2015-10-16  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.ads: Move the declaration of enumeration
	literal E_Abstract_State above E_Entry.  Update the upper bound
	of subtype Overloadable_Kind.

2015-10-16  Gary Dismukes  <dismukes@adacore.com>

	* exp_attr.adb: Minor editorial changes.

From-SVN: r228878
This commit is contained in:
Arnaud Charlet 2015-10-16 14:21:03 +02:00
parent 6b6254db8a
commit f145ece721
10 changed files with 85 additions and 20 deletions

View File

@ -1,3 +1,28 @@
2015-10-16 Hristian Kirtchev <kirtchev@adacore.com>
* exp_util.adb, sem_util.ads, sem_ch6.adb, sem_ch7.adb, sem_ch8.adb:
Minor reformatting.
* sem_ch12.adb (Analyze_Formal_Package_Declaration): Set the
SPARK_Mode from the context.
2015-10-16 Bob Duff <duff@adacore.com>
* sem_util.adb (Requires_Transient_Scope):
If Typ is a generic formal incomplete type, look at the actual
type. Otherwise, we don't notice that the actual type is tagged,
has a variant part, etc, causing a mismatch of calling conventions
between caller and callee.
2015-10-16 Hristian Kirtchev <kirtchev@adacore.com>
* einfo.ads: Move the declaration of enumeration
literal E_Abstract_State above E_Entry. Update the upper bound
of subtype Overloadable_Kind.
2015-10-16 Gary Dismukes <dismukes@adacore.com>
* exp_attr.adb: Minor editorial changes.
2015-10-16 Arnaud Charlet <charlet@adacore.com>
* exp_ch5.adb, sem_ch3.adb, frontend.adb, exp_ch7.adb, exp_ch7.ads,

View File

@ -4819,15 +4819,15 @@ package Einfo is
-- A procedure, created by a procedure declaration or a procedure
-- body that acts as its own declaration.
E_Entry,
-- An entry, created by an entry declaration in a task or protected
-- object.
E_Abstract_State,
-- A state abstraction. Used to designate entities introduced by aspect
-- or pragma Abstract_State. The entity carries the various properties
-- of the state.
E_Entry,
-- An entry, created by an entry declaration in a task or protected
-- object.
--------------------
-- Other Entities --
--------------------
@ -5147,8 +5147,8 @@ package Einfo is
-- E_Function
-- E_Operator
-- E_Procedure
-- E_Entry
E_Abstract_State;
-- E_Abstract_State
E_Entry;
subtype Private_Kind is Entity_Kind range
E_Record_Type_With_Private ..

View File

@ -5783,7 +5783,7 @@ package body Exp_Attr is
-- c) If the prefix is a task type, the size is obtained from the
-- size variable created for each task type
-- d) If no storage_size was specified for the type, there is no
-- d) If no Storage_Size was specified for the type, there is no
-- size variable, and the value is a system-specific default.
else
@ -5824,7 +5824,7 @@ package body Exp_Attr is
elsif Present (Storage_Size_Variable (Ptyp)) then
-- Static storage size pragma given for type: retrieve value
-- Static Storage_Size pragma given for type: retrieve value
-- from its allocated storage variable.
Rewrite (N,

View File

@ -8898,9 +8898,9 @@ package body Exp_Util is
-- Remove_Side_Effects to avoid a never ending loop in the frontend.
elsif not Tagged_Type_Expansion
and then not Comes_From_Source (N)
and then Nkind (Parent (N)) = N_Object_Renaming_Declaration
and then Is_Class_Wide_Type (Typ)
and then not Comes_From_Source (N)
and then Nkind (Parent (N)) = N_Object_Renaming_Declaration
and then Is_Class_Wide_Type (Typ)
then
return True;
end if;

View File

@ -2645,6 +2645,14 @@ package body Sem_Ch12 is
Set_Inner_Instances (Formal, New_Elmt_List);
Push_Scope (Formal);
-- Manually set the SPARK_Mode from the context because the package
-- declaration is never analyzed.
Set_SPARK_Pragma (Formal, SPARK_Mode_Pragma);
Set_SPARK_Aux_Pragma (Formal, SPARK_Mode_Pragma);
Set_SPARK_Pragma_Inherited (Formal);
Set_SPARK_Aux_Pragma_Inherited (Formal);
if Is_Child_Unit (Gen_Unit) and then Parent_Installed then
-- Similarly, we have to make the name of the formal visible in the

View File

@ -1296,7 +1296,7 @@ package body Sem_Ch6 is
Set_Actual_Subtypes (N, Current_Scope);
Set_SPARK_Pragma (Body_Id, SPARK_Mode_Pragma);
Set_SPARK_Pragma_Inherited (Body_Id, True);
Set_SPARK_Pragma_Inherited (Body_Id);
-- Analyze any aspect specifications that appear on the generic
-- subprogram body.
@ -3453,7 +3453,7 @@ package body Sem_Ch6 is
-- Set SPARK_Mode from context
Set_SPARK_Pragma (Body_Id, SPARK_Mode_Pragma);
Set_SPARK_Pragma_Inherited (Body_Id, True);
Set_SPARK_Pragma_Inherited (Body_Id);
-- If the return type is an anonymous access type whose designated type
-- is the limited view of a class-wide type and the non-limited view is

View File

@ -734,12 +734,12 @@ package body Sem_Ch7 is
-- Set SPARK_Mode from context
Set_SPARK_Pragma (Body_Id, SPARK_Mode_Pragma);
Set_SPARK_Pragma_Inherited (Body_Id, True);
Set_SPARK_Pragma_Inherited (Body_Id);
-- Set elaboration code SPARK mode the same for now
Set_SPARK_Aux_Pragma (Body_Id, SPARK_Pragma (Body_Id));
Set_SPARK_Aux_Pragma_Inherited (Body_Id, True);
Set_SPARK_Aux_Pragma_Inherited (Body_Id);
end if;
-- Inherit the "ghostness" of the subprogram spec. Note that this
@ -1048,8 +1048,8 @@ package body Sem_Ch7 is
if Ekind (Id) = E_Package then
Set_SPARK_Pragma (Id, SPARK_Mode_Pragma);
Set_SPARK_Aux_Pragma (Id, SPARK_Mode_Pragma);
Set_SPARK_Pragma_Inherited (Id, True);
Set_SPARK_Aux_Pragma_Inherited (Id, True);
Set_SPARK_Pragma_Inherited (Id);
Set_SPARK_Aux_Pragma_Inherited (Id);
end if;
-- A package declared within a Ghost refion is automatically Ghost

View File

@ -2776,7 +2776,7 @@ package body Sem_Ch8 is
-- Set SPARK mode from current context
Set_SPARK_Pragma (New_S, SPARK_Mode_Pragma);
Set_SPARK_Pragma_Inherited (New_S, True);
Set_SPARK_Pragma_Inherited (New_S);
Rename_Spec := Find_Corresponding_Spec (N);

View File

@ -23,6 +23,8 @@
-- --
------------------------------------------------------------------------------
with Treepr; -- ???For debugging code below
with Aspects; use Aspects;
with Atree; use Atree;
with Casing; use Casing;
@ -16856,6 +16858,24 @@ package body Sem_Util is
-- efficiency. Note: when this temporary code is removed, the documentation
-- of dQ in debug.adb should be removed.
procedure Results_Differ (Id : Entity_Id);
-- ???Debugging code. Called when the Old_ and New_ results differ. Will be
-- removed when New_Requires_Transient_Scope becomes
-- Requires_Transient_Scope and Old_Requires_Transient_Scope is eliminated.
procedure Results_Differ (Id : Entity_Id) is
begin
if False then -- False to disable; True for debugging
Treepr.Print_Tree_Node (Id);
if Old_Requires_Transient_Scope (Id) =
New_Requires_Transient_Scope (Id)
then
raise Program_Error;
end if;
end if;
end Results_Differ;
function Requires_Transient_Scope (Id : Entity_Id) return Boolean is
Old_Result : constant Boolean := Old_Requires_Transient_Scope (Id);
@ -16877,6 +16897,10 @@ package body Sem_Util is
null;
end if;
if New_Result /= Old_Result then
Results_Differ (Id);
end if;
return New_Result;
end;
end Requires_Transient_Scope;
@ -17108,7 +17132,7 @@ package body Sem_Util is
begin
-- This is a private type which is not completed yet. This can only
-- happen in a default expression (of a formal parameter or of a
-- record component). Do not expand transient scope in this case
-- record component). Do not expand transient scope in this case.
if No (Typ) then
return False;
@ -17121,6 +17145,14 @@ package body Sem_Util is
then
return False;
-- If Typ is a generic formal incomplete type, then we want to look at
-- the actual type.
elsif Ekind (Typ) = E_Record_Subtype
and then Present (Cloned_Subtype (Typ))
then
return New_Requires_Transient_Scope (Cloned_Subtype (Typ));
-- Functions returning tagged types may dispatch on result so their
-- returned value is allocated on the secondary stack, even in the
-- definite case. Is_Tagged_Type includes controlled types and

View File

@ -818,7 +818,7 @@ package Sem_Util is
-- returned. Otherwise the Etype of the node is returned.
function Get_Body_From_Stub (N : Node_Id) return Node_Id;
-- Return the body node for a stub.
-- Return the body node for a stub
function Get_Cursor_Type
(Aspect : Node_Id;