when N_String_Literal =>
return True;
- when N_Op_Concat =>
+ when N_Op_Concat =>
+
-- Concatenation is static when both operands are static
-- and the concatenation operator is a predefined one.
begin
return Ekind (Ent) = E_Constant
and then Present (Constant_Value (Ent))
- and then Is_Static_Expression
- (Constant_Value (Ent));
+ and then
+ Is_Static_Expression (Constant_Value (Ent));
end;
else
if No (A) and then Needs_No_Actuals (Nam) then
null;
- -- If we have an error in any actual or formal, indicated by
- -- a type of Any_Type, then abandon resolution attempt, and
- -- set result type to Any_Type.
+ -- If we have an error in any actual or formal, indicated by a type
+ -- of Any_Type, then abandon resolution attempt, and set result type
+ -- to Any_Type.
elsif (Present (A) and then Etype (A) = Any_Type)
or else Etype (F) = Any_Type
-- aliased, or neither (4.6 (8)).
-- The additional rule 4.6 (24.9.2) seems unduly
- -- restrictive: the privacy requirement should not
- -- apply to generic types, and should be checked in
- -- an instance. ARG query is in order.
+ -- restrictive: the privacy requirement should not apply
+ -- to generic types, and should be checked in an
+ -- instance. ARG query is in order ???
Error_Msg_N
("both component types in a view conversion must be"
end if;
-- Check that subprograms don't have improper controlling
- -- arguments (RM 3.9.2 (9))
+ -- arguments (RM 3.9.2 (9)).
-- A primitive operation may have an access parameter of an
-- incomplete tagged type, but a dispatching call is illegal
else
pragma Assert (Is_Overloaded (Subp));
- Nam := Empty; -- We know that it will be assigned in loop below
+
+ -- Initialize Nam to prevent warning (we know it will be assigned
+ -- in the loop below, but the compiler does not know that).
+
+ Nam := Empty;
Get_First_Interp (Subp, I, It);
while Present (It.Typ) loop
if Present (First_Formal (Nam)) then
Resolve_Actuals (N, Nam);
- -- Overloaded literals are rewritten as function calls, for
- -- purpose of resolution. After resolution, we can replace
- -- the call with the literal itself.
+ -- Overloaded literals are rewritten as function calls, for purpose of
+ -- resolution. After resolution, we can replace the call with the
+ -- literal itself.
elsif Ekind (Nam) = E_Enumeration_Literal then
Copy_Node (Subp, N);
A := First_Actual (N);
while Present (F) and then Present (A) loop
if (Ekind (F) = E_Out_Parameter
- or else Ekind (F) = E_In_Out_Parameter)
+ or else
+ Ekind (F) = E_In_Out_Parameter)
and then Warn_On_Modified_As_Out_Parameter (F)
and then Is_Entity_Name (A)
and then Present (Entity (A))
elsif Root_Type (B_Typ) = Standard_Wide_Wide_Character then
return;
- -- If the entity is already set, this has already been resolved in
- -- a generic context, or comes from expansion. Nothing else to do.
+ -- If the entity is already set, this has already been resolved in a
+ -- generic context, or comes from expansion. Nothing else to do.
elsif Present (Entity (N)) then
return;
- -- Otherwise we have a user defined character type, and we can use
- -- the standard visibility mechanisms to locate the referenced entity
+ -- Otherwise we have a user defined character type, and we can use the
+ -- standard visibility mechanisms to locate the referenced entity.
else
C := Current_Entity (N);
T : Entity_Id;
begin
- -- If this is an intrinsic operation which is not predefined, use
- -- the types of its declared arguments to resolve the possibly
- -- overloaded operands. Otherwise the operands are unambiguous and
- -- specify the expected type.
+ -- If this is an intrinsic operation which is not predefined, use the
+ -- types of its declared arguments to resolve the possibly overloaded
+ -- operands. Otherwise the operands are unambiguous and specify the
+ -- expected type.
if Scope (Entity (N)) /= Standard_Standard then
T := Etype (First_Entity (Entity (N)));
Generate_Reference (T, N, ' ');
if T /= Any_Type then
- if T = Any_String
- or else T = Any_Composite
- or else T = Any_Character
+ if T = Any_String or else
+ T = Any_Composite or else
+ T = Any_Character
then
if T = Any_Character then
Ambiguous_Character (L);
Condition : constant Node_Id := First (Expressions (N));
Then_Expr : constant Node_Id := Next (Condition);
Else_Expr : constant Node_Id := Next (Then_Expr);
-
begin
Resolve (Condition, Standard_Boolean);
Resolve (Then_Expr, Typ);
Resolve (Else_Expr, Typ);
-
Set_Etype (N, Typ);
Eval_Conditional_Expression (N);
end Resolve_Conditional_Expression;
Eval_Named_Real (N);
-- Allow use of subtype only if it is a concurrent type where we are
- -- currently inside the body. This will eventually be expanded
- -- into a call to Self (for tasks) or _object (for protected
- -- objects). Any other use of a subtype is invalid.
+ -- currently inside the body. This will eventually be expanded into a
+ -- call to Self (for tasks) or _object (for protected objects). Any
+ -- other use of a subtype is invalid.
elsif Is_Type (E) then
if Is_Concurrent_Type (E)
-- In all other cases, just do the possible static evaluation
else
- -- A deferred constant that appears in an expression must have
- -- a completion, unless it has been removed by in-place expansion
- -- of an aggregate.
+ -- A deferred constant that appears in an expression must have a
+ -- completion, unless it has been removed by in-place expansion of
+ -- an aggregate.
if Ekind (E) = E_Constant
and then Comes_From_Source (E)
function Actual_Discriminant_Ref (Bound : Node_Id) return Node_Id;
-- If the bound is given by a discriminant, replace with a reference
- -- to the discriminant of the same name in the target task.
- -- If the entry name is the target of a requeue statement and the
- -- entry is in the current protected object, the bound to be used
- -- is the discriminal of the object (see apply_range_checks for
- -- details of the transformation).
+ -- to the discriminant of the same name in the target task. If the
+ -- entry name is the target of a requeue statement and the entry is
+ -- in the current protected object, the bound to be used is the
+ -- discriminal of the object (see apply_range_checks for details of
+ -- the transformation).
-----------------------------
-- Actual_Discriminant_Ref --
begin
if not Has_Discriminants (Tsk)
or else (not Is_Entity_Name (Lo)
- and then not Is_Entity_Name (Hi))
+ and then
+ not Is_Entity_Name (Hi))
then
return Entry_Index_Type (E);
end if;
if Is_Entity_Name (E_Name) then
- -- Entry call to an entry (or entry family) in the current task.
- -- This is legal even though the task will deadlock. Rewrite as
- -- call to current task.
- -- This can also be a call to an entry in an enclosing task.
- -- If this is a single task, we have to retrieve its name,
- -- because the scope of the entry is the task type, not the
- -- object. If the enclosing task is a task type, the identity
- -- of the task is given by its own self variable.
+ -- Entry call to an entry (or entry family) in the current task. This
+ -- is legal even though the task will deadlock. Rewrite as call to
+ -- current task.
- -- Finally this can be a requeue on an entry of the same task
- -- or protected object.
+ -- This can also be a call to an entry in an enclosing task. If this
+ -- is a single task, we have to retrieve its name, because the scope
+ -- of the entry is the task type, not the object. If the enclosing
+ -- task is a task type, the identity of the task is given by its own
+ -- self variable.
+
+ -- Finally this can be a requeue on an entry of the same task or
+ -- protected object.
S := Scope (Entity (E_Name));
for J in reverse 0 .. Scope_Stack.Last loop
-
if Is_Task_Type (Scope_Stack.Table (J).Entity)
and then not Comes_From_Source (S)
then
elsif Nkind (Entry_Name) = N_Selected_Component
and then Is_Overloaded (Prefix (Entry_Name))
then
- -- Use the entry name (which must be unique at this point) to
- -- find the prefix that returns the corresponding task type or
- -- protected type.
+ -- Use the entry name (which must be unique at this point) to find
+ -- the prefix that returns the corresponding task type or protected
+ -- type.
declare
Pref : constant Node_Id := Prefix (Entry_Name);
Index := First (Expressions (Entry_Name));
Resolve (Index, Entry_Index_Type (Nam));
- -- Up to this point the expression could have been the actual
- -- in a simple entry call, and be given by a named association.
+ -- Up to this point the expression could have been the actual in a
+ -- simple entry call, and be given by a named association.
if Nkind (Index) = N_Parameter_Association then
Error_Msg_N ("expect expression for entry index", Index);
Was_Over : Boolean;
begin
- -- We kill all checks here, because it does not seem worth the
- -- effort to do anything better, an entry call is a big operation.
+ -- We kill all checks here, because it does not seem worth the effort to
+ -- do anything better, an entry call is a big operation.
Kill_All_Checks;
end if;
end if;
- -- After resolution, entry calls and protected procedure calls
- -- are changed into entry calls, for expansion. The structure
- -- of the node does not change, so it can safely be done in place.
- -- Protected function calls must keep their structure because they
- -- are subexpressions.
+ -- After resolution, entry calls and protected procedure calls are
+ -- changed into entry calls, for expansion. The structure of the node
+ -- does not change, so it can safely be done in place. Protected
+ -- function calls must keep their structure because they are
+ -- subexpressions.
if Ekind (Nam) /= E_Function then
-- A protected operation that is not a function may modify the
- -- corresponding object, and cannot apply to a constant.
- -- If this is an internal call, the prefix is the type itself.
+ -- corresponding object, and cannot apply to a constant. If this
+ -- is an internal call, the prefix is the type itself.
if Is_Protected_Type (Scope (Nam))
and then not Is_Variable (Obj)
-- Resolve_Equality_Op --
-------------------------
- -- Both arguments must have the same type, and the boolean context
- -- does not participate in the resolution. The first pass verifies
- -- that the interpretation is not ambiguous, and the type of the left
- -- argument is correctly set, or is Any_Type in case of ambiguity.
- -- If both arguments are strings or aggregates, allocators, or Null,
- -- they are ambiguous even though they carry a single (universal) type.
- -- Diagnose this case here.
+ -- Both arguments must have the same type, and the boolean context does
+ -- not participate in the resolution. The first pass verifies that the
+ -- interpretation is not ambiguous, and the type of the left argument is
+ -- correctly set, or is Any_Type in case of ambiguity. If both arguments
+ -- are strings or aggregates, allocators, or Null, they are ambiguous even
+ -- though they carry a single (universal) type. Diagnose this case here.
procedure Resolve_Equality_Op (N : Node_Id; Typ : Entity_Id) is
L : constant Node_Id := Left_Opnd (N);
Error_Msg_NE ("cannot call abstract subprogram &!", N, Entity (N));
end if;
- -- Ada 2005: If one operand is an anonymous access type, convert
- -- the other operand to it, to ensure that the underlying types
- -- match in the back-end. Same for access_to_subprogram, and the
- -- conversion verifies that the types are subtype conformant.
+ -- Ada 2005: If one operand is an anonymous access type, convert the
+ -- other operand to it, to ensure that the underlying types match in
+ -- the back-end. Same for access_to_subprogram, and the conversion
+ -- verifies that the types are subtype conformant.
- -- We apply the same conversion in the case one of the operands is
- -- a private subtype of the type of the other.
+ -- We apply the same conversion in the case one of the operands is a
+ -- private subtype of the type of the other.
-- Why the Expander_Active test here ???
elsif Typ /= Etype (Left_Opnd (N))
or else Typ /= Etype (Right_Opnd (N))
then
- -- Add explicit conversion where needed, and save interpretations
- -- in case operands are overloaded.
+ -- Add explicit conversion where needed, and save interpretations in
+ -- case operands are overloaded.
Arg1 := Convert_To (Typ, Left_Opnd (N));
Arg2 := Convert_To (Typ, Right_Opnd (N));
then
T := Etype (R);
- -- Ada 2005 (AI-251): Give support to the following case:
+ -- Ada 2005 (AI-251): Support the following case:
-- type I is interface;
-- type T is tagged ...
-- return O in T'Class.
-- end Test;
- -- In this case we have nothing else to do; the membership test will be
+ -- In this case we have nothing else to do. The membership test will be
-- done at run-time.
elsif Ada_Version >= Ada_05
and then Ekind (Typ) = E_Anonymous_Access_Type
and then Comes_From_Source (N)
then
- -- In the common case of a call which uses an explicitly null
- -- value for an access parameter, give specialized error message.
+ -- In the common case of a call which uses an explicitly null value
+ -- for an access parameter, give specialized error message.
if Nkind_In (Parent (N), N_Procedure_Call_Statement,
N_Function_Call)
end if;
end if;
- -- In a distributed context, null for a remote access to subprogram
- -- may need to be replaced with a special record aggregate. In this
- -- case, return after having done the transformation.
+ -- In a distributed context, null for a remote access to subprogram may
+ -- need to be replaced with a special record aggregate. In this case,
+ -- return after having done the transformation.
if (Ekind (Typ) = E_Record_Type
or else Is_Remote_Access_To_Subprogram_Type (Typ))
-- up the tree following Parent pointers, calling Resolve_Op_Concat_Rest
-- to do the rest of the work at each level. The Parent pointers allow
-- us to avoid recursion, and thus avoid running out of memory. See also
- -- Sem_Ch4.Analyze_Concatenation, where a similar hack is used.
+ -- Sem_Ch4.Analyze_Concatenation, where a similar approach is used.
NN : Node_Id := N;
Op1 : Node_Id;
Eval_Concatenation (N);
end if;
- -- If this is not a static concatenation, but the result is a
- -- string type (and not an array of strings) ensure that static
- -- string operands have their subtypes properly constructed.
+ -- If this is not a static concatenation, but the result is a string
+ -- type (and not an array of strings) ensure that static string operands
+ -- have their subtypes properly constructed.
if Nkind (N) /= N_String_Literal
and then Is_Character_Type (Component_Type (Typ))
begin
if Is_Overloaded (Name) then
- -- Use the context type to select the prefix that yields the
- -- correct array type.
+ -- Use the context type to select the prefix that yields the correct
+ -- array type.
declare
I : Interp_Index;
or else Typ = Standard_Wide_Wide_String)
and then Nkind (Original_Node (N)) /= N_String_Literal);
- -- If the resolving type is itself a string literal subtype, we
- -- can just reuse it, since there is no point in creating another.
+ -- If the resolving type is itself a string literal subtype, we can just
+ -- reuse it, since there is no point in creating another.
if Ekind (Typ) = E_String_Literal_Subtype then
Subtype_Id := Typ;
return;
end if;
- -- The validity of a null string has been checked in the
- -- call to Eval_String_Literal.
+ -- The validity of a null string has been checked in the call to
+ -- Eval_String_Literal.
if Strlen = 0 then
return;
-- If we are out of range, post error. This is one of the
-- very few places that we place the flag in the middle of
- -- a token, right under the offending wide character.
+ -- a token, right under the offending wide character. Not
+ -- quite clear if this is right wrt wide character encoding
+ -- sequences, but it's only an error message!
Error_Msg
("literal out of range of type Standard.Character",
Resolve (Operand);
-- Note: we do the Eval_Type_Conversion call before applying the
- -- required checks for a subtype conversion. This is important,
- -- since both are prepared under certain circumstances to change
- -- the type conversion to a constraint error node, but in the case
- -- of Eval_Type_Conversion this may reflect an illegality in the
- -- static case, and we would miss the illegality (getting only a
- -- warning message), if we applied the type conversion checks first.
+ -- required checks for a subtype conversion. This is important, since
+ -- both are prepared under certain circumstances to change the type
+ -- conversion to a constraint error node, but in the case of
+ -- Eval_Type_Conversion this may reflect an illegality in the static
+ -- case, and we would miss the illegality (getting only a warning
+ -- message), if we applied the type conversion checks first.
Eval_Type_Conversion (N);
- -- Even when evaluation is not possible, we may be able to simplify
- -- the conversion or its expression. This needs to be done before
- -- applying checks, since otherwise the checks may use the original
- -- expression and defeat the simplifications. This is specifically
- -- the case for elimination of the floating-point Truncation
- -- attribute in float-to-int conversions.
+ -- Even when evaluation is not possible, we may be able to simplify the
+ -- conversion or its expression. This needs to be done before applying
+ -- checks, since otherwise the checks may use the original expression
+ -- and defeat the simplifications. This is specifically the case for
+ -- elimination of the floating-point Truncation attribute in
+ -- float-to-int conversions.
Simplify_Type_Conversion (N);
- -- If after evaluation we still have a type conversion, then we
- -- may need to apply checks required for a subtype conversion.
+ -- If after evaluation we still have a type conversion, then we may need
+ -- to apply checks required for a subtype conversion.
-- Skip these type conversion checks if universal fixed operands
-- operands involved, since range checks are handled separately for
Apply_Type_Conversion_Checks (N);
end if;
- -- Issue warning for conversion of simple object to its own type
- -- We have to test the original nodes, since they may have been
- -- rewritten by various optimizations.
+ -- Issue warning for conversion of simple object to its own type. We
+ -- have to test the original nodes, since they may have been rewritten
+ -- by various optimizations.
Orig_N := Original_Node (N);
end if;
end if;
- -- Generate warning for expressions like -5 mod 3 for integers. No
- -- need to worry in the floating-point case, since parens do not affect
- -- the result so there is no point in giving in a warning.
+ -- Generate warning for expressions like -5 mod 3 for integers. No need
+ -- to worry in the floating-point case, since parens do not affect the
+ -- result so there is no point in giving in a warning.
declare
Norig : constant Node_Id := Original_Node (N);
then
-- For mod, we always give the warning, since the value is
-- affected by the parenthesization (e.g. (-5) mod 315 /=
- -- (5 mod 315)). But for the other cases, the only concern is
+ -- -(5 mod 315)). But for the other cases, the only concern is
-- overflow, e.g. for the case of 8 big signed (-(2 * 64)
-- overflows, but (-2) * 64 does not). So we try to give the
-- message only when overflow is possible.
LB := Expr_Value (Type_Low_Bound (Base_Type (Typ)));
end if;
- -- Note that the test below is deliberately excluding
- -- the largest negative number, since that is a potentially
+ -- Note that the test below is deliberately excluding the
+ -- largest negative number, since that is a potentially
-- troublesome case (e.g. -2 * x, where the result is the
-- largest negative integer has an overflow with 2 * x).
Op_Node : Node_Id;
begin
- -- Rewrite the operator node using the real operator, not its
- -- renaming. Exclude user-defined intrinsic operations of the same
- -- name, which are treated separately and rewritten as calls.
+ -- Rewrite the operator node using the real operator, not its renaming.
+ -- Exclude user-defined intrinsic operations of the same name, which are
+ -- treated separately and rewritten as calls.
if Ekind (Op) /= E_Function
or else Chars (N) /= Nam
N_Op_Expon | N_Op_Mod | N_Op_Rem =>
Resolve_Intrinsic_Operator (N, Typ);
- when N_Op_Plus | N_Op_Minus | N_Op_Abs =>
+ when N_Op_Plus | N_Op_Minus | N_Op_Abs =>
Resolve_Intrinsic_Unary_Operator (N, Typ);
when others =>
procedure Set_String_Literal_Subtype (N : Node_Id; Typ : Entity_Id) is
Loc : constant Source_Ptr := Sloc (N);
Low_Bound : constant Node_Id :=
- Type_Low_Bound (Etype (First_Index (Typ)));
+ Type_Low_Bound (Etype (First_Index (Typ)));
Subtype_Id : Entity_Id;
begin
Scop : Entity_Id;
procedure Fixed_Point_Error;
- -- If true ambiguity, give details
+ -- Give error messages for true ambiguity. Messages are posted on node
+ -- N, and entities T1, T2 are the possible interpretations.
-----------------------
-- Fixed_Point_Error --
N1 : Entity_Id;
begin
- -- Remove procedure calls, which syntactically cannot appear
- -- in this context, but which cannot be removed by type checking,
+ -- Remove procedure calls, which syntactically cannot appear in
+ -- this context, but which cannot be removed by type checking,
-- because the context does not impose a type.
-- When compiling for VMS, spurious ambiguities can be produced
and then Is_Interface (Directly_Designated_Type (Target_Type))
then
-- Check the static accessibility rule of 4.6(17). Note that the
- -- check is not enforced when within an instance body, since the RM
- -- requires such cases to be caught at run time.
+ -- check is not enforced when within an instance body, since the
+ -- RM requires such cases to be caught at run time.
if Ekind (Target_Type) /= E_Anonymous_Access_Type then
if Type_Access_Level (Opnd_Type) >
then
-- When the operand is a selected access discriminant the check
-- needs to be made against the level of the object denoted by
- -- the prefix of the selected name. (Object_Access_Level
- -- handles checking the prefix of the operand for this case.)
+ -- the prefix of the selected name (Object_Access_Level handles
+ -- checking the prefix of the operand for this case).
if Nkind (Operand) = N_Selected_Component
and then Object_Access_Level (Operand) >
Type_Access_Level (Target_Type)
then
- -- In an instance, this is a run-time check, but one we
- -- know will fail, so generate an appropriate warning.
- -- The raise will be generated by Expand_N_Type_Conversion.
+ -- In an instance, this is a run-time check, but one we know
+ -- will fail, so generate an appropriate warning. The raise
+ -- will be generated by Expand_N_Type_Conversion.
if In_Instance_Body then
Error_Msg_N
if Type_Access_Level (Opnd_Type)
> Type_Access_Level (Target_Type)
then
- -- In an instance, this is a run-time check, but one we
- -- know will fail, so generate an appropriate warning.
- -- The raise will be generated by Expand_N_Type_Conversion.
+ -- In an instance, this is a run-time check, but one we know
+ -- will fail, so generate an appropriate warning. The raise
+ -- will be generated by Expand_N_Type_Conversion.
if In_Instance_Body then
Error_Msg_N
-- When the operand is a selected access discriminant the check
-- needs to be made against the level of the object denoted by
- -- the prefix of the selected name. (Object_Access_Level
- -- handles checking the prefix of the operand for this case.)
+ -- the prefix of the selected name (Object_Access_Level handles
+ -- checking the prefix of the operand for this case).
if Nkind (Operand) = N_Selected_Component
and then Object_Access_Level (Operand) >
Type_Access_Level (Target_Type)
then
- -- In an instance, this is a run-time check, but one we
- -- know will fail, so generate an appropriate warning.
- -- The raise will be generated by Expand_N_Type_Conversion.
+ -- In an instance, this is a run-time check, but one we know
+ -- will fail, so generate an appropriate warning. The raise
+ -- will be generated by Expand_N_Type_Conversion.
if In_Instance_Body then
Error_Msg_N
end if;
end if;
+ -- Need some comments here, and a name for this block ???
+
declare
function Full_Designated_Type (T : Entity_Id) return Entity_Id;
-- Helper function to handle limited views
end if;
end Full_Designated_Type;
+ -- Local Declarations
+
Target : constant Entity_Id := Full_Designated_Type (Target_Type);
Opnd : constant Entity_Id := Full_Designated_Type (Opnd_Type);
Same_Base : constant Boolean :=
Base_Type (Target) = Base_Type (Opnd);
+ -- Start of processing for ???
+
begin
if Is_Tagged_Type (Target) then
return Valid_Tagged_Conversion (Target, Opnd);
elsif (In_Instance or In_Inlined_Body)
and then
- Root_Type (Underlying_Type (Target_Type)) =
- Root_Type (Underlying_Type (Opnd_Type))
+ Root_Type (Underlying_Type (Target_Type)) =
+ Root_Type (Underlying_Type (Opnd_Type))
then
return True;
then
Error_Msg_N ("target type must be general access type!", N);
Error_Msg_NE ("add ALL to }!", N, Target_Type);
-
return False;
else
Error_Msg_NE ("invalid conversion, not compatible with }",
N, Opnd_Type);
-
return False;
end if;
end Valid_Conversion;
OSDN Git Service
