+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,
-- 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 --
--------------------
-- 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 ..
-- 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
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,
-- 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;
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
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.
-- 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
-- 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
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
-- 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);
-- --
------------------------------------------------------------------------------
+with Treepr; -- ???For debugging code below
+
with Aspects; use Aspects;
with Atree; use Atree;
with Casing; use Casing;
-- 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);
null;
end if;
+ if New_Result /= Old_Result then
+ Results_Differ (Id);
+ end if;
+
return New_Result;
end;
end Requires_Transient_Scope;
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;
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
-- 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;
projects / gcc.git / commitdiff