+2011-08-02 Thomas Quinot <quinot@adacore.com>
+
+ * scos.ads: Update comments.
+
+2011-08-02 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch3.adb (Build_Derived_Type): Inherit the convention from the
+ base type, because the parent may be a subtype of a private type whose
+ convention is established in a private part.
+
+2011-08-02 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch6.adb (Expand_N_Extended_Return_Statement): Wrap the return
+ statement in a block when the expansion of the return expression has
+ created a finalization chain.
+ * freeze.adb (Freeze_Expression): Alphabetize all choices associated
+ with the parent node.
+ Add N_Extended_Return_Statement to handle the case where a transient
+ object declaration appears in the Return_Object_Declarations list of
+ an extended return statement.
+
+2011-08-02 Matthew Gingell <gingell@adacore.com>
+
+ * adaint.c (__gnat_is_symbolic_link_attr): Supress warning on possibly
+ unused parameter 'name'.
+
+2011-08-02 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_elim.adb (Set_Eliminated): If the overridden operation is an
+ inherited operation, check whether its alias, which is the source
+ operastion that it renames, has been marked eliminated.
+
2011-08-02 Javier Miranda <miranda@adacore.com>
* exp_util.adb (Safe_Prefixed_Reference): Do not consider safe an
}
int
-__gnat_is_symbolic_link_attr (char* name, struct file_attributes* attr)
+__gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED,
+ struct file_attributes* attr)
{
if (attr->symbolic_link == ATTR_UNSET) {
#if defined (__vxworks) || defined (__nucleus__)
-- Case where we do not build a block
else
- -- We're about to drop Return_Object_Declarations on the floor, so
- -- we need to insert it, in case it got expanded into useful code.
-- Remove side effects from expression, which may be duplicated in
-- subsequent checks (see Expand_Simple_Function_Return).
- Insert_List_Before (N, Return_Object_Declarations (N));
Remove_Side_Effects (Exp);
-- Build simple_return_statement that returns the expression directly
Return_Stm := Make_Simple_Return_Statement (Loc, Expression => Exp);
- Result := Return_Stm;
+ -- The expansion of the return expression may create a finalization
+ -- chain to service transient temporaries. The entity of the chain
+ -- appears as a semantic attribute of the return statement scope.
+ -- For the chain to be handled properly by Expand_Cleanup_Actions,
+ -- the return statement is wrapped in a block and reanalyzed.
+
+ if Present
+ (Finalization_Chain_Entity (Return_Statement_Entity (N)))
+ then
+ Result :=
+ Make_Block_Statement (Loc,
+ Declarations => Return_Object_Declarations (N),
+ Handled_Statement_Sequence =>
+ Make_Handled_Sequence_Of_Statements (Loc,
+ Statements => New_List (Return_Stm)));
+
+ -- Propagate the return statement scope to the block in order to
+ -- preserve the various semantic fields.
+
+ Set_Identifier
+ (Result, New_Occurrence_Of (Return_Statement_Entity (N), Loc));
+ else
+ -- We're about to drop Return_Object_Declarations on the floor, so
+ -- we need to insert it, in case it got expanded into useful code.
+
+ Insert_List_Before (N, Return_Object_Declarations (N));
+
+ Result := Return_Stm;
+ end if;
end if;
-- Set the flag to prevent infinite recursion
-- is a statement or declaration and we can insert the freeze node
-- before it.
- when N_Package_Specification |
+ when N_Block_Statement |
+ N_Entry_Body |
N_Package_Body |
- N_Subprogram_Body |
- N_Task_Body |
+ N_Package_Specification |
N_Protected_Body |
- N_Entry_Body |
- N_Block_Statement => exit;
+ N_Subprogram_Body |
+ N_Task_Body => exit;
-- The expander is allowed to define types in any statements list,
-- so any of the following parent nodes also mark a freezing point
-- if the actual node is in a list of statements or declarations.
- when N_Exception_Handler |
- N_If_Statement |
- N_Elsif_Part |
+ when N_Abortable_Part |
+ N_Accept_Alternative |
+ N_And_Then |
N_Case_Statement_Alternative |
N_Compilation_Unit_Aux |
- N_Selective_Accept |
- N_Accept_Alternative |
- N_Delay_Alternative |
N_Conditional_Entry_Call |
+ N_Delay_Alternative |
+ N_Elsif_Part |
N_Entry_Call_Alternative |
- N_Triggering_Alternative |
- N_Abortable_Part |
- N_And_Then |
+ N_Exception_Handler |
+ N_Extended_Return_Statement |
+ N_Freeze_Entity |
+ N_If_Statement |
N_Or_Else |
- N_Freeze_Entity =>
+ N_Selective_Accept |
+ N_Triggering_Alternative =>
exit when Is_List_Member (P);
-- entries appear in one logical statement sequence, continuation lines
-- are marked by Cs and appear immediately after the CS line.
+ -- Implementation permission: a SCO generator is permitted to emit a
+ -- narrower SLOC range for a statement if the corresponding code
+ -- generation circuitry ensures that all debug information for the code
+ -- implementing the statement will be labeled with SLOCs that fall within
+ -- that narrower range.
+
-- Decisions
-- Note: in the following description, logical operator includes only the
-- term ::= element
-- term ::= expression
- -- element ::= outcome sloc-range
+ -- element ::= *sloc-range
- -- outcome is one of the following letters:
+ -- where * is one of the following letters:
-- c condition
-- t true condition
-- f false condition
- -- where t/f are used to mark a condition that has been recognized by
- -- the compiler as always being true or false.
+ -- t/f are used to mark a condition that has been recognized by the
+ -- compiler as always being true or false. c is the normal case of
+ -- conditions whose value is not known at compile time.
-- & indicates AND THEN connecting two conditions
-- form is used, e.g. A in (2,7,11.15).
-- The expression can be followed by chaining indicators of the form
- -- Tsloc-range or Fsloc-range.
+ -- Tsloc-range or Fsloc-range, where the sloc-range is that of some
+ -- entry on a CS line.
-- T* is present when the statement with the given sloc range is executed
-- if, and only if, the decision evaluates to TRUE.
-- In all other cases, chaining indicators are omitted
+ -- Implementation permission: a SCO generator is permitted to emit a
+ -- narrower SLOC range for a condition if the corresponding code
+ -- generation circuitry ensures that all debug information for the code
+ -- evaluating the condition will be labeled with SLOCs that fall within
+ -- that narrower range.
+
-- Case Expressions
-- For case statements, we rely on statement coverage to make sure that
Set_Size_Info (Derived_Type, Parent_Type);
Set_RM_Size (Derived_Type, RM_Size (Parent_Type));
- Set_Convention (Derived_Type, Convention (Parent_Type));
Set_Is_Controlled (Derived_Type, Is_Controlled (Parent_Type));
Set_Is_Tagged_Type (Derived_Type, Is_Tagged_Type (Parent_Type));
+ -- If the parent type is a private subtype, the convention on the base
+ -- type may be set in the private part, and not propagated to the
+ -- subtype until later, so we obtain the convention from the base type.
+
+ Set_Convention (Derived_Type, Convention (Parent_Base));
+
-- Propagate invariant information. The new type has invariants if
-- they are inherited from the parent type, and these invariants can
-- be further inherited, so both flags are set.
Set_Homonym (Full, Save_Homonym);
Set_Associated_Node_For_Itype (Full, Related_Nod);
- -- Set common attributes for all subtypes
+ -- Set common attributes for all subtypes: kind, convention, etc.
Set_Ekind (Full, Subtype_Kind (Ekind (Full_Base)));
+ Set_Convention (Full, Convention (Full_Base));
-- The Etype of the full view is inconsistent. Gigi needs to see the
-- structural full view, which is what the current scheme gives:
--------------------
procedure Set_Eliminated is
+ Overridden : Entity_Id;
+
begin
if Is_Dispatching_Operation (E) then
-- If an overriding dispatching primitive is eliminated then
- -- its parent must have been eliminated.
+ -- its parent must have been eliminated. If the parent is an
+ -- inherited operation, check the operation that it renames,
+ -- because flag Eliminated is only set on source operations.
+
+ Overridden := Overridden_Operation (E);
+
+ if Present (Overridden)
+ and then not Comes_From_Source (Overridden)
+ and then Present (Alias (Overridden))
+ then
+ Overridden := Alias (Overridden);
+ end if;
- if Present (Overridden_Operation (E))
- and then not Is_Eliminated (Overridden_Operation (E))
+ if Present (Overridden)
+ and then not Is_Eliminated (Overridden)
then
Error_Msg_Name_1 := Chars (E);
Error_Msg_N ("cannot eliminate subprogram %", E);