[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:
Arnaud Charlet 2011-08-02 15:51:43 +02:00
parent 4c60de0c97
commit 4637729f3e
8 changed files with 167 additions and 35 deletions

View File

@ -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>
* errout.adb (First_Node): minor renaming

View File

@ -6923,10 +6923,9 @@ package body Exp_Ch4 is
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);

View File

@ -1567,9 +1567,10 @@ package body Sem_Ch13 is
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
@ -1584,26 +1585,36 @@ package body Sem_Ch13 is
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

View File

@ -2190,9 +2190,12 @@ package body Sem_Ch3 is
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 --
@ -2212,7 +2215,6 @@ package body Sem_Ch3 is
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
@ -17844,17 +17846,17 @@ package body Sem_Ch3 is
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);

View File

@ -2387,7 +2387,33 @@ package body Sem_Ch5 is
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;

View File

@ -8655,7 +8655,6 @@ package body Sem_Ch6 is
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
@ -8666,6 +8665,14 @@ package body Sem_Ch6 is
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;

View File

@ -2463,7 +2463,11 @@ package body Sem_Ch7 is
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);

View File

@ -1362,23 +1362,28 @@ package body Sem_Disp is
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
@ -1393,7 +1398,7 @@ package body Sem_Disp is
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;
@ -1401,6 +1406,37 @@ package body Sem_Disp is
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;