[multiple changes]
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
This commit is contained in:
parent
4c60de0c97
commit
4637729f3e
|
@ -1,3 +1,50 @@
|
||||||
|
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>
|
2011-08-02 Yannick Moy <moy@adacore.com>
|
||||||
|
|
||||||
* errout.adb (First_Node): minor renaming
|
* errout.adb (First_Node): minor renaming
|
||||||
|
|
|
@ -6923,10 +6923,9 @@ package body Exp_Ch4 is
|
||||||
Set_Entity (Right_Opnd (Neg), Corresponding_Equality (Ne));
|
Set_Entity (Right_Opnd (Neg), Corresponding_Equality (Ne));
|
||||||
end if;
|
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
|
-- implicit reference to the corresponding equality. Preserve the
|
||||||
-- Comes_From_ source flag so that the proper Xref entry is
|
-- Comes_From_ source flag to generate proper Xref entries.
|
||||||
-- generated.
|
|
||||||
|
|
||||||
Preserve_Comes_From_Source (Neg, N);
|
Preserve_Comes_From_Source (Neg, N);
|
||||||
Preserve_Comes_From_Source (Right_Opnd (Neg), N);
|
Preserve_Comes_From_Source (Right_Opnd (Neg), N);
|
||||||
|
|
|
@ -1567,9 +1567,10 @@ package body Sem_Ch13 is
|
||||||
Set_Analyzed (N, True);
|
Set_Analyzed (N, True);
|
||||||
end if;
|
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
|
case Id is
|
||||||
|
|
||||||
-- The following should be ignored. They do not affect legality
|
-- The following should be ignored. They do not affect legality
|
||||||
|
@ -1584,26 +1585,36 @@ package body Sem_Ch13 is
|
||||||
Attribute_Machine_Radix |
|
Attribute_Machine_Radix |
|
||||||
Attribute_Object_Size |
|
Attribute_Object_Size |
|
||||||
Attribute_Size |
|
Attribute_Size |
|
||||||
Attribute_Small |
|
|
||||||
Attribute_Stream_Size |
|
Attribute_Stream_Size |
|
||||||
Attribute_Value_Size =>
|
Attribute_Value_Size =>
|
||||||
|
|
||||||
Rewrite (N, Make_Null_Statement (Sloc (N)));
|
Rewrite (N, Make_Null_Statement (Sloc (N)));
|
||||||
return;
|
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
|
-- The following should not be ignored, because in the first place
|
||||||
-- they are reasonably portable, and should not cause problems in
|
-- they are reasonably portable, and should not cause problems in
|
||||||
-- compiling code from another target, and also they do affect
|
-- compiling code from another target, and also they do affect
|
||||||
-- legality, e.g. failing to provide a stream attribute for a
|
-- legality, e.g. failing to provide a stream attribute for a
|
||||||
-- type may make a program illegal.
|
-- type may make a program illegal.
|
||||||
|
|
||||||
when Attribute_External_Tag |
|
when Attribute_External_Tag |
|
||||||
Attribute_Input |
|
Attribute_Input |
|
||||||
Attribute_Output |
|
Attribute_Output |
|
||||||
Attribute_Read |
|
Attribute_Read |
|
||||||
Attribute_Storage_Pool |
|
Attribute_Storage_Pool |
|
||||||
Attribute_Storage_Size |
|
Attribute_Storage_Size |
|
||||||
Attribute_Write =>
|
Attribute_Write =>
|
||||||
null;
|
null;
|
||||||
|
|
||||||
-- Other cases are errors ("attribute& cannot be set with
|
-- Other cases are errors ("attribute& cannot be set with
|
||||||
|
|
|
@ -2190,9 +2190,12 @@ package body Sem_Ch3 is
|
||||||
or else In_Package_Body (Current_Scope));
|
or else In_Package_Body (Current_Scope));
|
||||||
|
|
||||||
procedure Check_Ops_From_Incomplete_Type;
|
procedure Check_Ops_From_Incomplete_Type;
|
||||||
-- If there is a tagged incomplete partial view of the type, transfer
|
-- If there is a tagged incomplete partial view of the type, traverse
|
||||||
-- its operations to the full view, and indicate that the type of the
|
-- the primitives of the incomplete view and change the type of any
|
||||||
-- controlling parameter (s) is this full view.
|
-- 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 --
|
-- Check_Ops_From_Incomplete_Type --
|
||||||
|
@ -2212,7 +2215,6 @@ package body Sem_Ch3 is
|
||||||
Elmt := First_Elmt (Primitive_Operations (Prev));
|
Elmt := First_Elmt (Primitive_Operations (Prev));
|
||||||
while Present (Elmt) loop
|
while Present (Elmt) loop
|
||||||
Op := Node (Elmt);
|
Op := Node (Elmt);
|
||||||
Prepend_Elmt (Op, Primitive_Operations (T));
|
|
||||||
|
|
||||||
Formal := First_Formal (Op);
|
Formal := First_Formal (Op);
|
||||||
while Present (Formal) loop
|
while Present (Formal) loop
|
||||||
|
@ -17844,17 +17846,17 @@ package body Sem_Ch3 is
|
||||||
|
|
||||||
elsif Is_Overloadable (Priv_Dep) then
|
elsif Is_Overloadable (Priv_Dep) then
|
||||||
|
|
||||||
-- A protected operation is never dispatching: only its
|
-- If a subprogram in the incomplete dependents list is primitive
|
||||||
-- wrapper operation (which has convention Ada) is.
|
-- 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)
|
if Is_Tagged_Type (Full_T)
|
||||||
|
and then Is_Primitive (Priv_Dep)
|
||||||
and then Convention (Priv_Dep) /= Convention_Protected
|
and then Convention (Priv_Dep) /= Convention_Protected
|
||||||
then
|
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);
|
Check_Operation_From_Incomplete_Type (Priv_Dep, Inc_T);
|
||||||
Set_Is_Dispatching_Operation (Priv_Dep);
|
Set_Is_Dispatching_Operation (Priv_Dep);
|
||||||
Check_Controlling_Formals (Full_T, Priv_Dep);
|
Check_Controlling_Formals (Full_T, Priv_Dep);
|
||||||
|
|
|
@ -2387,7 +2387,33 @@ package body Sem_Ch5 is
|
||||||
Kill_Current_Values;
|
Kill_Current_Values;
|
||||||
Push_Scope (Ent);
|
Push_Scope (Ent);
|
||||||
Analyze_Iteration_Scheme (Iter);
|
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);
|
Process_End_Label (Loop_Statement, 'e', Ent);
|
||||||
End_Scope;
|
End_Scope;
|
||||||
Kill_Current_Values;
|
Kill_Current_Values;
|
||||||
|
|
|
@ -8655,7 +8655,6 @@ package body Sem_Ch6 is
|
||||||
|
|
||||||
if Is_Tagged_Type (Formal_Type) then
|
if Is_Tagged_Type (Formal_Type) then
|
||||||
if Ekind (Scope (Current_Scope)) = E_Package
|
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 From_With_Type (Formal_Type)
|
||||||
and then not Is_Class_Wide_Type (Formal_Type)
|
and then not Is_Class_Wide_Type (Formal_Type)
|
||||||
then
|
then
|
||||||
|
@ -8666,6 +8665,14 @@ package body Sem_Ch6 is
|
||||||
Append_Elmt
|
Append_Elmt
|
||||||
(Current_Scope,
|
(Current_Scope,
|
||||||
Private_Dependents (Base_Type (Formal_Type)));
|
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;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
|
|
@ -2463,7 +2463,11 @@ package body Sem_Ch7 is
|
||||||
while Present (Elmt) loop
|
while Present (Elmt) loop
|
||||||
Subp := Node (Elmt);
|
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
|
Error_Msg_NE
|
||||||
("type& must be completed in the private part",
|
("type& must be completed in the private part",
|
||||||
Parent (Subp), Id);
|
Parent (Subp), Id);
|
||||||
|
|
|
@ -1362,23 +1362,28 @@ package body Sem_Disp is
|
||||||
Op1, Op2 : Elmt_Id;
|
Op1, Op2 : Elmt_Id;
|
||||||
Prev : Elmt_Id := No_Elmt;
|
Prev : Elmt_Id := No_Elmt;
|
||||||
|
|
||||||
function Derives_From (Proc : Entity_Id) return Boolean;
|
function Derives_From (Parent_Subp : Entity_Id) return Boolean;
|
||||||
-- Check that Subp has the signature of an operation derived from Proc.
|
-- Check that Subp has profile of an operation derived from Parent_Subp.
|
||||||
-- Subp has an access parameter that designates Typ.
|
-- Subp must have a parameter or result type that is Typ or an access
|
||||||
|
-- parameter or access result type that designates Typ.
|
||||||
|
|
||||||
------------------
|
------------------
|
||||||
-- Derives_From --
|
-- 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;
|
F1, F2 : Entity_Id;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Chars (Proc) /= Chars (Subp) then
|
if Chars (Parent_Subp) /= Chars (Subp) then
|
||||||
return False;
|
return False;
|
||||||
end if;
|
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);
|
F2 := First_Formal (Subp);
|
||||||
while Present (F1) and then Present (F2) loop
|
while Present (F1) and then Present (F2) loop
|
||||||
if Ekind (Etype (F1)) = E_Anonymous_Access_Type then
|
if Ekind (Etype (F1)) = E_Anonymous_Access_Type then
|
||||||
|
@ -1393,7 +1398,7 @@ package body Sem_Disp is
|
||||||
elsif Ekind (Etype (F2)) = E_Anonymous_Access_Type then
|
elsif Ekind (Etype (F2)) = E_Anonymous_Access_Type then
|
||||||
return False;
|
return False;
|
||||||
|
|
||||||
elsif Etype (F1) /= Etype (F2) then
|
elsif Etype (F1) = Parent_Typ and then Etype (F2) /= Full then
|
||||||
return False;
|
return False;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
@ -1401,6 +1406,37 @@ package body Sem_Disp is
|
||||||
Next_Formal (F2);
|
Next_Formal (F2);
|
||||||
end loop;
|
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);
|
return No (F1) and then No (F2);
|
||||||
end Derives_From;
|
end Derives_From;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue