Rop : constant Node_Id := Right_Opnd (N);
Static : constant Boolean := Is_OK_Static_Expression (N);
- Ltyp : Entity_Id;
- Rtyp : Entity_Id;
-
procedure Substitute_Valid_Check;
-- Replaces node N by Lop'Valid. This is done when we have an explicit
-- test for the left operand being in range of its subtype.
----------------------------
procedure Substitute_Valid_Check is
+ function Is_OK_Object_Reference (Nod : Node_Id) return Boolean;
+ -- Determine whether arbitrary node Nod denotes a source object that
+ -- may safely act as prefix of attribute 'Valid.
+
+ ----------------------------
+ -- Is_OK_Object_Reference --
+ ----------------------------
+
+ function Is_OK_Object_Reference (Nod : Node_Id) return Boolean is
+ Obj_Ref : Node_Id;
+
+ begin
+ -- Inspect the original operand
+
+ Obj_Ref := Original_Node (Nod);
+
+ -- The object reference must be a source construct, otherwise the
+ -- codefix suggestion may refer to nonexistent code from a user
+ -- perspective.
+
+ if Comes_From_Source (Obj_Ref) then
+
+ -- Recover the actual object reference. There may be more cases
+ -- to consider???
+
+ loop
+ if Nkind_In (Obj_Ref, N_Type_Conversion,
+ N_Unchecked_Type_Conversion)
+ then
+ Obj_Ref := Expression (Obj_Ref);
+ else
+ exit;
+ end if;
+ end loop;
+
+ return Is_Object_Reference (Obj_Ref);
+ end if;
+
+ return False;
+ end Is_OK_Object_Reference;
+
+ -- Start of processing for Substitute_Valid_Check
+
begin
Rewrite (N,
Make_Attribute_Reference (Loc,
Analyze_And_Resolve (N, Restyp);
- -- Give warning unless overflow checking is MINIMIZED or ELIMINATED,
- -- in which case, this usage makes sense, and in any case, we have
- -- actually eliminated the danger of optimization above.
+ -- Emit a warning when the left-hand operand of the membership test
+ -- is a source object, otherwise the use of attribute 'Valid would be
+ -- illegal. The warning is not given when overflow checking is either
+ -- MINIMIZED or ELIMINATED, as the danger of optimization has been
+ -- eliminated above.
- if Overflow_Check_Mode not in Minimized_Or_Eliminated then
+ if Is_OK_Object_Reference (Lop)
+ and then Overflow_Check_Mode not in Minimized_Or_Eliminated
+ then
Error_Msg_N
("??explicit membership test may be optimized away", N);
Error_Msg_N -- CODEFIX
("\??use ''Valid attribute instead", N);
end if;
-
- return;
end Substitute_Valid_Check;
+ -- Local variables
+
+ Ltyp : Entity_Id;
+ Rtyp : Entity_Id;
+
-- Start of processing for Expand_N_In
begin
if not Is_Discrete_Type (Etype (N)) then
null;
- -- Don't do this on the left hand of an assignment statement.
+ -- Don't do this on the left-hand side of an assignment statement.
-- Normally one would think that references like this would not
-- occur, but they do in generated code, and mean that we really
-- do want to assign the discriminant.
Cons := No_List;
-- If type is unconstrained we have to add a constraint, copied
- -- from the actual value of the left hand side.
+ -- from the actual value of the left-hand side.
if not Is_Constrained (Target_Type) then
if Has_Discriminants (Operand_Type) then
Callee : Entity_Id;
procedure Check_Static_Type (T : Entity_Id; DT : in out Boolean);
- -- Given a type T, checks if it is a static type defined as a
- -- type with no dynamic bounds in sight. If so, the only action
- -- is to set Is_Static_Type True for T. If T is not a static
- -- type, then all types with dynamic bounds associated with
- -- T are detected, and their bounds are marked as uplevel
- -- referenced if not at the library level, and DT is set True.
+ -- Given a type T, checks if it is a static type defined as a type
+ -- with no dynamic bounds in sight. If so, the only action is to
+ -- set Is_Static_Type True for T. If T is not a static type, then
+ -- all types with dynamic bounds associated with T are detected,
+ -- and their bounds are marked as uplevel referenced if not at the
+ -- library level, and DT is set True.
procedure Note_Uplevel_Ref
(E : Entity_Id;
end if;
end;
- -- For record type, check all components
+ -- For record type, check all components
elsif Is_Record_Type (T) then
declare
end loop;
end;
- -- For array type, check index types and component type
+ -- For array type, check index types and component type
elsif Is_Array_Type (T) then
declare
if Caller = Callee then
return;
- -- Callee may be a function that returns an array, and
- -- that has been rewritten as a procedure. If caller is
- -- that procedure, nothing to do either.
+ -- Callee may be a function that returns an array, and that has
+ -- been rewritten as a procedure. If caller is that procedure,
+ -- nothing to do either.
elsif Ekind (Callee) = E_Function
and then Rewritten_For_C (Callee)
-- Now we can insert the AREC declarations into the body
- -- type ARECnT is record .. end record;
- -- pragma Suppress_Initialization (ARECnT);
+ -- type ARECnT is record .. end record;
+ -- pragma Suppress_Initialization (ARECnT);
+
-- Note that we need to set the Suppress_Initialization
-- flag after Decl_ARECnT has been analyzed.
-- probably happens as a result of not properly treating
-- instance bodies. To be examined ???
- -- If this test is omitted, then the compilation of
- -- freeze.adb and inline.adb fail in unnesting mode.
+ -- If this test is omitted, then the compilation of freeze.adb
+ -- and inline.adb fail in unnesting mode.
if No (STJR.ARECnF) then
goto Continue;
Push_Scope (STJR.Ent);
- -- Now we need to rewrite the reference. We have a
- -- reference is from level STJR.Lev to level STJE.Lev.
- -- The general form of the rewritten reference for
- -- entity X is:
+ -- Now we need to rewrite the reference. We have a reference
+ -- from level STJR.Lev to level STJE.Lev. The general form of
+ -- the rewritten reference for entity X is:
- -- Typ'Deref (ARECaF.ARECbU.ARECcU.ARECdU....ARECm.X)
+ -- Typ'Deref (ARECaF.ARECbU.ARECcU.ARECdU....ARECm.X)
-- where a,b,c,d .. m =
-- STJR.Lev - 1, STJR.Lev - 2, .. STJE.Lev
begin
if Present (STT.ARECnF) then
- -- CTJ.N is a call to a subprogram which may require
- -- a pointer to an activation record. The subprogram
- -- containing the call is CTJ.From and the subprogram being
- -- called is CTJ.To, so we have a call from level STF.Lev to
- -- level STT.Lev.
+ -- CTJ.N is a call to a subprogram which may require a pointer
+ -- to an activation record. The subprogram containing the call
+ -- is CTJ.From and the subprogram being called is CTJ.To, so we
+ -- have a call from level STF.Lev to level STT.Lev.
-- There are three possibilities:
if STF.Lev = STT.Lev then
Extra := New_Occurrence_Of (STF.ARECnF, Loc);
- -- For a call that goes down a level, we pass a pointer
- -- to the activation record constructed within the caller
- -- (which may be the outer level subprogram, but also may
- -- be a more deeply nested caller).
+ -- For a call that goes down a level, we pass a pointer to the
+ -- activation record constructed within the caller (which may
+ -- be the outer-level subprogram, but also may be a more deeply
+ -- nested caller).
elsif STT.Lev = STF.Lev + 1 then
Extra := New_Occurrence_Of (STF.ARECnP, Loc);
pragma Assert (STT.Lev < STF.Lev);
Extra := New_Occurrence_Of (STF.ARECnF, Loc);
- SubX := Subp_Index (CTJ.Caller);
+ SubX := Subp_Index (CTJ.Caller);
for K in reverse STT.Lev .. STF.Lev - 1 loop
- SubX := Enclosing_Subp (SubX);
+ SubX := Enclosing_Subp (SubX);
Extra :=
Make_Selected_Component (Loc,
Prefix => Extra,
Append (ExtraP, Parameter_Associations (CTJ.N));
- -- We need to deal with the actual parameter chain as well.
- -- The newly added parameter is always the last actual.
+ -- We need to deal with the actual parameter chain as well. The
+ -- newly added parameter is always the last actual.
Act := First_Named_Actual (CTJ.N);
projects / gcc.git / commitdiff