sem_ch4.adb (Analyze_Selected_Component): Do not generate an actual subtype if code is being pre-analyzed...

2005-03-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Analyze_Selected_Component): Do not generate an actual
	subtype if code is being pre-analyzed, to prevent un-expanded
	references to protected formals, among others.
	(Analyze_Explicit_Dereference): If the overloaded prefix includes some
	interpretation that can be a call, include the result of the call as a
	possible interpretation of the dereference.

	* sem_ch5.adb (Process_Bounds): Determine type of range by
	pre-analyzing a copy of the original range, and then analyze the range
	with the expected type.

	* sem_res.adb (Check_Parameterless_Call): For an explicit dereference
	with an overloaded prefix where not all interpretations yield an
	access to subprogram, do not rewrite node as a call.
	(Resolve_Explicit_Dereference): Recognize the previous case and rewrite
	the node as a call once the context identifies the interpretation of
	the prefix whose call yields the context type.
	(Valid_Conversion): For the case of a conversion between
	local access-to-subprogram types, check subtype conformance using
	Check_Subtype_Conformant instead of Subtype_Conformant, to have a more
	detailed error message.

From-SVN: r97184
This commit is contained in:
Ed Schonberg 2005-03-29 18:20:30 +02:00 committed by Arnaud Charlet
parent f7a8593d14
commit 981234802e
2 changed files with 89 additions and 41 deletions

View File

@ -1197,7 +1197,7 @@ package body Sem_Ch4 is
end if;
end Is_Function_Type;
-- Start of processing for Analyze_Explicit_Deference
-- Start of processing for Analyze_Explicit_Dereference
begin
Analyze (P);
@ -1251,8 +1251,6 @@ package body Sem_Ch4 is
Get_Next_Interp (I, It);
end loop;
End_Interp_List;
-- Error if no interpretation of the prefix has an access type
if Etype (N) = Any_Type then
@ -1281,10 +1279,11 @@ package body Sem_Ch4 is
then
-- Name is a function call with no actuals, in a context that
-- requires deproceduring (including as an actual in an enclosing
-- function or procedure call). We can conceive of pathological cases
-- function or procedure call). There are some pathological cases
-- where the prefix might include functions that return access to
-- subprograms and others that return a regular type. Disambiguation
-- of those will have to take place in Resolve. See e.g. 7117-014.
-- of those has to take place in Resolve.
-- See e.g. 7117-014 and E317-001.
New_N :=
Make_Function_Call (Loc,
@ -1311,6 +1310,25 @@ package body Sem_Ch4 is
Rewrite (N, New_N);
Analyze (N);
elsif not Is_Function_Type
and then Is_Overloaded (N)
then
-- The prefix may include access to subprograms and other access
-- types. If the context selects the interpretation that is a call,
-- we cannot rewrite the node yet, but we include the result of
-- the call interpretation.
Get_First_Interp (N, I, It);
while Present (It.Nam) loop
if Ekind (Base_Type (It.Typ)) = E_Subprogram_Type
and then Etype (Base_Type (It.Typ)) /= Standard_Void_Type
then
Add_One_Interp (N, Etype (It.Typ), Etype (It.Typ));
end if;
Get_Next_Interp (I, It);
end loop;
end if;
-- A value of remote access-to-class-wide must not be dereferenced
@ -2652,14 +2670,20 @@ package body Sem_Ch4 is
then
Set_Etype (N, Etype (Comp));
-- In all other cases, we currently build an actual subtype. It
-- seems likely that many of these cases can be avoided, but
-- right now, the front end makes direct references to the
-- If full analysis is not enabled, we do not generate an
-- actual subtype, because in the absence of expansion
-- reference to a formal of a protected type, for example,
-- will not be properly transformed, and will lead to
-- out-of-scope references in gigi.
-- In all other cases, we currently build an actual subtype.
-- It seems likely that many of these cases can be avoided,
-- but right now, the front end makes direct references to the
-- bounds (e.g. in generating a length check), and if we do
-- not make an actual subtype, we end up getting a direct
-- reference to a discriminant which will not do.
-- reference to a discriminant, which will not do.
else
elsif Full_Analysis then
Act_Decl :=
Build_Actual_Subtype_Of_Component (Etype (Comp), N);
Insert_Action (N, Act_Decl);
@ -2681,6 +2705,11 @@ package body Sem_Ch4 is
Set_Etype (N, Subt);
end;
end if;
-- If Full_Analysis not enabled, just set the Etype
else
Set_Etype (N, Etype (Comp));
end if;
return;
@ -2697,17 +2726,17 @@ package body Sem_Ch4 is
then
return;
-- If the transformation fails, it will be necessary
-- to redo the analysis with all errors enabled, to indicate
-- candidate interpretations and reasons for each failure ???
-- If the transformation fails, it will be necessary to redo the
-- analysis with all errors enabled, to indicate candidate
-- interpretations and reasons for each failure ???
end if;
elsif Is_Private_Type (Prefix_Type) then
-- Allow access only to discriminants of the type. If the
-- type has no full view, gigi uses the parent type for
-- the components, so we do the same here.
-- Allow access only to discriminants of the type. If the type has
-- no full view, gigi uses the parent type for the components, so we
-- do the same here.
if No (Full_View (Prefix_Type)) then
Entity_List := Root_Type (Base_Type (Prefix_Type));
@ -2747,11 +2776,11 @@ package body Sem_Ch4 is
elsif Is_Concurrent_Type (Prefix_Type) then
-- Prefix is concurrent type. Find visible operation with given name
-- For a task, this can only include entries or discriminants if
-- the task type is not an enclosing scope. If it is an enclosing
-- scope (e.g. in an inner task) then all entities are visible, but
-- the prefix must denote the enclosing scope, i.e. can only be
-- a direct name or an expanded name.
-- For a task, this can only include entries or discriminants if the
-- task type is not an enclosing scope. If it is an enclosing scope
-- (e.g. in an inner task) then all entities are visible, but the
-- prefix must denote the enclosing scope, i.e. can only be a direct
-- name or an expanded name.
Set_Etype (Sel, Any_Type);
In_Scope := In_Open_Scopes (Prefix_Type);
@ -2780,8 +2809,8 @@ package body Sem_Ch4 is
Set_Original_Discriminant (Sel, Comp);
end if;
-- For access type case, introduce explicit deference for
-- more uniform treatment of entry calls.
-- For access type case, introduce explicit deference for more
-- uniform treatment of entry calls.
if Is_Access_Type (Etype (Name)) then
Insert_Explicit_Dereference (Name);
@ -2809,8 +2838,8 @@ package body Sem_Ch4 is
if Etype (N) = Any_Type then
-- If the prefix is a single concurrent object, use its name in
-- the error message, rather than that of its anonymous type.
-- If the prefix is a single concurrent object, use its name in the
-- error message, rather than that of its anonymous type.
if Is_Concurrent_Type (Prefix_Type)
and then Is_Internal_Name (Chars (Prefix_Type))
@ -2828,7 +2857,7 @@ package body Sem_Ch4 is
and then Prefix_Type /= Etype (Prefix_Type)
and then Is_Record_Type (Etype (Prefix_Type))
then
-- If this is a derived formal type, the parent may have a
-- If this is a derived formal type, the parent may have
-- different visibility at this point. Try for an inherited
-- component before reporting an error.

View File

@ -1112,7 +1112,9 @@ package body Sem_Ch5 is
-- If the iteration is given by a range, create temporaries and
-- assignment statements block to capture the bounds and perform
-- required finalization actions in case a bound includes a function
-- call that uses the temporary stack.
-- call that uses the temporary stack. We first pre-analyze a copy of
-- the range in order to determine the expected type, and analyze
-- and resolve the original bounds.
procedure Check_Controlled_Array_Attribute (DS : Node_Id);
-- If the bounds are given by a 'Range reference on a function call
@ -1126,13 +1128,16 @@ package body Sem_Ch5 is
procedure Process_Bounds (R : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
R_Copy : constant Node_Id := New_Copy_Tree (R);
Lo : constant Node_Id := Low_Bound (R);
Hi : constant Node_Id := High_Bound (R);
New_Lo_Bound : Node_Id := Empty;
New_Hi_Bound : Node_Id := Empty;
Typ : constant Entity_Id := Etype (R);
Typ : Entity_Id;
function One_Bound (Bound : Node_Id) return Node_Id;
function One_Bound
(Original_Bound : Node_Id;
Analyzed_Bound : Node_Id) return Node_Id;
-- Create one declaration followed by one assignment statement
-- to capture the value of bound. We create a separate assignment
-- in order to force the creation of a block in case the bound
@ -1142,7 +1147,10 @@ package body Sem_Ch5 is
-- One_Bound --
---------------
function One_Bound (Bound : Node_Id) return Node_Id is
function One_Bound
(Original_Bound : Node_Id;
Analyzed_Bound : Node_Id) return Node_Id
is
Assign : Node_Id;
Id : Entity_Id;
Decl : Node_Id;
@ -1156,11 +1164,17 @@ package body Sem_Ch5 is
-- part of the call to Make_Index (literal bounds may need to
-- be resolved to type Integer).
if Nkind (Bound) = N_Integer_Literal
or else Is_Entity_Name (Bound)
or else Analyzed (Bound)
if Analyzed (Original_Bound) then
return Original_Bound;
elsif Nkind (Analyzed_Bound) = N_Integer_Literal
or else Is_Entity_Name (Analyzed_Bound)
then
return Bound;
Analyze_And_Resolve (Original_Bound, Typ);
return Original_Bound;
else
Analyze_And_Resolve (Original_Bound, Typ);
end if;
Id :=
@ -1188,26 +1202,32 @@ package body Sem_Ch5 is
Assign :=
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Id, Loc),
Expression => Relocate_Node (Bound));
Expression => Relocate_Node (Original_Bound));
Save_Interps (Bound, Expression (Assign));
Insert_Before (Parent (N), Assign);
Analyze (Assign);
Rewrite (Bound, New_Occurrence_Of (Id, Loc));
Rewrite (Original_Bound, New_Occurrence_Of (Id, Loc));
if Nkind (Assign) = N_Assignment_Statement then
return Expression (Assign);
else
return Bound;
return Original_Bound;
end if;
end One_Bound;
-- Start of processing for Process_Bounds
begin
New_Lo_Bound := One_Bound (Lo);
New_Hi_Bound := One_Bound (Hi);
-- Determine expected type of range by analyzing separate copy.
Set_Parent (R_Copy, Parent (R));
Pre_Analyze_And_Resolve (R_Copy);
Typ := Etype (R_Copy);
Set_Etype (R, Typ);
New_Lo_Bound := One_Bound (Lo, Low_Bound (R_Copy));
New_Hi_Bound := One_Bound (Hi, High_Bound (R_Copy));
-- Propagate staticness to loop range itself, in case the
-- corresponding subtype is static.
@ -1332,7 +1352,6 @@ package body Sem_Ch5 is
if Nkind (DS) = N_Range
and then Expander_Active
then
Pre_Analyze_And_Resolve (DS);
Process_Bounds (DS);
else
Analyze (DS);