2011-08-02 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb: Minor reformatting.
2011-08-02 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Analyze_Loop_Statement): If the iteration scheme is an
Ada2012 iterator, the loop will be rewritten during expansion into a
while loop with a cursor and an element declaration. Do not analyze the
body in this case, because if the container is for indefinite types the
actual subtype of the elements will only be determined when the cursor
declaration is analyzed.
2011-08-02 Arnaud Charlet <charlet@adacore.com>
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Ignore
size/alignment related attributes in CodePeer_Mode.
2011-08-02 Gary Dismukes <dismukes@adacore.com>
* sem_ch3.adb (Check_Ops_From_Incomplete_Type): Remove call to
Prepend_Element, since this can result in the operation getting the
wrong slot in the full type's dispatch table if the full type has
inherited operations. The incomplete type's operation will get added
to the proper position in the full type's primitives
list later in Sem_Disp.Check_Operation_From_Incomplete_Type.
(Process_Incomplete_Dependents): Add Is_Primitive test when checking for
dispatching operations, since there are cases where nonprimitive
subprograms can get added to the list of incomplete dependents (such
as subprograms in nested packages).
* sem_ch6.adb (Process_Formals): First, remove test for being in a
private part when determining whether to add a primitive with a
parameter of a tagged incomplete type to the Private_Dependents list.
Such primitives can also occur in the visible part, and should not have
been excluded from being private dependents.
* sem_ch7.adb (Uninstall_Declarations): When checking the rule of
RM05-3.10.1(9.3/2), test that a subprogram in the Private_Dependents
list of a Taft-amendment incomplete type is a primitive before issuing
an error that the full type must appear in the same unit. There are
cases where nonprimitives can be in the list (such as subprograms in
nested packages).
* sem_disp.adb (Derives_From): Use correct condition for checking that
a formal's type is derived from the type of the corresponding formal in
the parent subprogram (the condition was completely wrong). Add
checking that was missing for controlling result types being derived
from the result type of the parent operation.
From-SVN: r177156
+2011-08-02 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch4.adb: Minor reformatting.
+
+2011-08-02 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch5.adb (Analyze_Loop_Statement): If the iteration scheme is an
+ Ada2012 iterator, the loop will be rewritten during expansion into a
+ while loop with a cursor and an element declaration. Do not analyze the
+ body in this case, because if the container is for indefinite types the
+ actual subtype of the elements will only be determined when the cursor
+ declaration is analyzed.
+
+2011-08-02 Arnaud Charlet <charlet@adacore.com>
+
+ * sem_ch13.adb (Analyze_Attribute_Definition_Clause): Ignore
+ size/alignment related attributes in CodePeer_Mode.
+
+2011-08-02 Gary Dismukes <dismukes@adacore.com>
+
+ * sem_ch3.adb (Check_Ops_From_Incomplete_Type): Remove call to
+ Prepend_Element, since this can result in the operation getting the
+ wrong slot in the full type's dispatch table if the full type has
+ inherited operations. The incomplete type's operation will get added
+ to the proper position in the full type's primitives
+ list later in Sem_Disp.Check_Operation_From_Incomplete_Type.
+ (Process_Incomplete_Dependents): Add Is_Primitive test when checking for
+ dispatching operations, since there are cases where nonprimitive
+ subprograms can get added to the list of incomplete dependents (such
+ as subprograms in nested packages).
+ * sem_ch6.adb (Process_Formals): First, remove test for being in a
+ private part when determining whether to add a primitive with a
+ parameter of a tagged incomplete type to the Private_Dependents list.
+ Such primitives can also occur in the visible part, and should not have
+ been excluded from being private dependents.
+ * sem_ch7.adb (Uninstall_Declarations): When checking the rule of
+ RM05-3.10.1(9.3/2), test that a subprogram in the Private_Dependents
+ list of a Taft-amendment incomplete type is a primitive before issuing
+ an error that the full type must appear in the same unit. There are
+ cases where nonprimitives can be in the list (such as subprograms in
+ nested packages).
+ * sem_disp.adb (Derives_From): Use correct condition for checking that
+ a formal's type is derived from the type of the corresponding formal in
+ the parent subprogram (the condition was completely wrong). Add
+ checking that was missing for controlling result types being derived
+ from the result type of the parent operation.
+
2011-08-02 Yannick Moy <moy@adacore.com>
* errout.adb (First_Node): minor renaming
Set_Entity (Right_Opnd (Neg), Corresponding_Equality (Ne));
end if;
- -- For navigation purposes, the inequality is treated as an
+ -- For navigation purposes, we want to treat the inequality as an
-- implicit reference to the corresponding equality. Preserve the
- -- Comes_From_ source flag so that the proper Xref entry is
- -- generated.
+ -- Comes_From_ source flag to generate proper Xref entries.
Preserve_Comes_From_Source (Neg, N);
Preserve_Comes_From_Source (Right_Opnd (Neg), N);
Set_Analyzed (N, True);
end if;
- -- Process Ignore_Rep_Clauses option
+ -- Process Ignore_Rep_Clauses option (we also ignore rep clauses in
+ -- CodePeer mode, since they are not relevant in that context).
- if Ignore_Rep_Clauses then
+ if Ignore_Rep_Clauses or CodePeer_Mode then
case Id is
-- The following should be ignored. They do not affect legality
Attribute_Machine_Radix |
Attribute_Object_Size |
Attribute_Size |
- Attribute_Small |
Attribute_Stream_Size |
Attribute_Value_Size =>
-
Rewrite (N, Make_Null_Statement (Sloc (N)));
return;
+ -- We do not want too ignore 'Small in CodePeer_Mode, since it
+ -- has an impact on the exact computations performed.
+
+ -- Perhaps 'Small should also not be ignored by
+ -- Ignore_Rep_Clauses ???
+
+ when Attribute_Small =>
+ if Ignore_Rep_Clauses then
+ Rewrite (N, Make_Null_Statement (Sloc (N)));
+ return;
+ end if;
+
-- The following should not be ignored, because in the first place
-- they are reasonably portable, and should not cause problems in
-- compiling code from another target, and also they do affect
-- legality, e.g. failing to provide a stream attribute for a
-- type may make a program illegal.
- when Attribute_External_Tag |
- Attribute_Input |
- Attribute_Output |
- Attribute_Read |
- Attribute_Storage_Pool |
- Attribute_Storage_Size |
- Attribute_Write =>
+ when Attribute_External_Tag |
+ Attribute_Input |
+ Attribute_Output |
+ Attribute_Read |
+ Attribute_Storage_Pool |
+ Attribute_Storage_Size |
+ Attribute_Write =>
null;
-- Other cases are errors ("attribute& cannot be set with
or else In_Package_Body (Current_Scope));
procedure Check_Ops_From_Incomplete_Type;
- -- If there is a tagged incomplete partial view of the type, transfer
- -- its operations to the full view, and indicate that the type of the
- -- controlling parameter (s) is this full view.
+ -- If there is a tagged incomplete partial view of the type, traverse
+ -- the primitives of the incomplete view and change the type of any
+ -- controlling formals and result to indicate the full view. The
+ -- primitives will be added to the full type's primitive operations
+ -- list later in Sem_Disp.Check_Operation_From_Incomplete_Type (which
+ -- is called from Process_Incomplete_Dependents).
------------------------------------
-- Check_Ops_From_Incomplete_Type --
Elmt := First_Elmt (Primitive_Operations (Prev));
while Present (Elmt) loop
Op := Node (Elmt);
- Prepend_Elmt (Op, Primitive_Operations (T));
Formal := First_Formal (Op);
while Present (Formal) loop
elsif Is_Overloadable (Priv_Dep) then
- -- A protected operation is never dispatching: only its
- -- wrapper operation (which has convention Ada) is.
+ -- If a subprogram in the incomplete dependents list is primitive
+ -- for a tagged full type then mark it as a dispatching operation,
+ -- check whether it overrides an inherited subprogram, and check
+ -- restrictions on its controlling formals. Note that a protected
+ -- operation is never dispatching: only its wrapper operation
+ -- (which has convention Ada) is.
if Is_Tagged_Type (Full_T)
+ and then Is_Primitive (Priv_Dep)
and then Convention (Priv_Dep) /= Convention_Protected
then
-
- -- Subprogram has an access parameter whose designated type
- -- was incomplete. Reexamine declaration now, because it may
- -- be a primitive operation of the full type.
-
Check_Operation_From_Incomplete_Type (Priv_Dep, Inc_T);
Set_Is_Dispatching_Operation (Priv_Dep);
Check_Controlling_Formals (Full_T, Priv_Dep);
Kill_Current_Values;
Push_Scope (Ent);
Analyze_Iteration_Scheme (Iter);
- Analyze_Statements (Statements (Loop_Statement));
+
+ -- Analyze the statements of the body except in the case of an Ada 2012
+ -- iterator with the expander active. In this case the expander will do
+ -- a rewrite of the loop into a while loop. We will then analyze the
+ -- loop body when we analyze this while loop.
+
+ -- We need to do this delay because if the container is for indefinite
+ -- types the actual subtype of the components will only be determined
+ -- when the cursor declaration is analyzed.
+
+ -- If the expander is not active, then we want to analyze the loop body
+ -- now even in the Ada 2012 iterator case, since the rewriting will not
+ -- be done.
+
+ if No (Iter)
+ or else No (Iterator_Specification (Iter))
+ or else not Expander_Active
+ then
+ Analyze_Statements (Statements (Loop_Statement));
+ end if;
+
+ -- Finish up processing for the loop. We kill all current values, since
+ -- in general we don't know if the statements in the loop have been
+ -- executed. We could do a bit better than this with a loop that we
+ -- know will execute at least once, but it's not worth the trouble and
+ -- the front end is not in the business of flow tracing.
+
Process_End_Label (Loop_Statement, 'e', Ent);
End_Scope;
Kill_Current_Values;
if Is_Tagged_Type (Formal_Type) then
if Ekind (Scope (Current_Scope)) = E_Package
- and then In_Private_Part (Scope (Current_Scope))
and then not From_With_Type (Formal_Type)
and then not Is_Class_Wide_Type (Formal_Type)
then
Append_Elmt
(Current_Scope,
Private_Dependents (Base_Type (Formal_Type)));
+
+ -- Freezing is delayed to ensure that Register_Prim
+ -- will get called for this operation, which is needed
+ -- in cases where static dispatch tables aren't built.
+ -- (Note that the same is done for controlling access
+ -- parameter cases in function Access_Definition.)
+
+ Set_Has_Delayed_Freeze (Current_Scope);
end if;
end if;
while Present (Elmt) loop
Subp := Node (Elmt);
- if Is_Overloadable (Subp) then
+ -- Is_Primitive is tested because there can be cases where
+ -- nonprimitive subprograms (in nested packages) are added
+ -- to the Private_Dependents list.
+
+ if Is_Overloadable (Subp) and then Is_Primitive (Subp) then
Error_Msg_NE
("type& must be completed in the private part",
Parent (Subp), Id);
Op1, Op2 : Elmt_Id;
Prev : Elmt_Id := No_Elmt;
- function Derives_From (Proc : Entity_Id) return Boolean;
- -- Check that Subp has the signature of an operation derived from Proc.
- -- Subp has an access parameter that designates Typ.
+ function Derives_From (Parent_Subp : Entity_Id) return Boolean;
+ -- Check that Subp has profile of an operation derived from Parent_Subp.
+ -- Subp must have a parameter or result type that is Typ or an access
+ -- parameter or access result type that designates Typ.
------------------
-- Derives_From --
------------------
- function Derives_From (Proc : Entity_Id) return Boolean is
+ function Derives_From (Parent_Subp : Entity_Id) return Boolean is
F1, F2 : Entity_Id;
begin
- if Chars (Proc) /= Chars (Subp) then
+ if Chars (Parent_Subp) /= Chars (Subp) then
return False;
end if;
- F1 := First_Formal (Proc);
+ -- Check that the type of controlling formals is derived from the
+ -- parent subprogram's controlling formal type (or designated type
+ -- if the formal type is an anonymous access type).
+
+ F1 := First_Formal (Parent_Subp);
F2 := First_Formal (Subp);
while Present (F1) and then Present (F2) loop
if Ekind (Etype (F1)) = E_Anonymous_Access_Type then
elsif Ekind (Etype (F2)) = E_Anonymous_Access_Type then
return False;
- elsif Etype (F1) /= Etype (F2) then
+ elsif Etype (F1) = Parent_Typ and then Etype (F2) /= Full then
return False;
end if;
Next_Formal (F2);
end loop;
+ -- Check that a controlling result type is derived from the parent
+ -- subprogram's result type (or designated type if the result type
+ -- is an anonymous access type).
+
+ if Ekind (Parent_Subp) = E_Function then
+ if Ekind (Subp) /= E_Function then
+ return False;
+
+ elsif Ekind (Etype (Parent_Subp)) = E_Anonymous_Access_Type then
+ if Ekind (Etype (Subp)) /= E_Anonymous_Access_Type then
+ return False;
+
+ elsif Designated_Type (Etype (Parent_Subp)) = Parent_Typ
+ and then Designated_Type (Etype (Subp)) /= Full
+ then
+ return False;
+ end if;
+
+ elsif Ekind (Etype (Subp)) = E_Anonymous_Access_Type then
+ return False;
+
+ elsif Etype (Parent_Subp) = Parent_Typ
+ and then Etype (Subp) /= Full
+ then
+ return False;
+ end if;
+
+ elsif Ekind (Subp) = E_Function then
+ return False;
+ end if;
+
return No (F1) and then No (F2);
end Derives_From;
projects / gcc.git / commitdiff