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:
parent
f7a8593d14
commit
981234802e
@ -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.
|
||||
|
||||
|
@ -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);
|
||||
|
Loading…
Reference in New Issue
Block a user