checks.adb (Insert_Valid_Check): Apply validity check to expression of conversion, not to result of conversion.
* checks.adb (Insert_Valid_Check): Apply validity check to expression of conversion, not to result of conversion. * sem_ch3.adb (Build_Derived_Record_Type): set Controlled flag before freezing parent. If the declarations are mutually recursive, an access to the current record type may be frozen before the derivation is complete. From-SVN: r47894
This commit is contained in:
parent
d5d7ae5c75
commit
84157f5101
@ -1,3 +1,15 @@
|
||||
2001-12-11 Robert Dewar <dewar@gnat.com>
|
||||
|
||||
* checks.adb (Insert_Valid_Check): Apply validity check to expression
|
||||
of conversion, not to result of conversion.
|
||||
|
||||
2001-12-11 Ed Schonberg <schonber@gnat.com>
|
||||
|
||||
* sem_ch3.adb (Build_Derived_Record_Type): set Controlled flag
|
||||
before freezing parent. If the declarations are mutually recursive,
|
||||
an access to the current record type may be frozen before the
|
||||
derivation is complete.
|
||||
|
||||
2001-12-05 Vincent Celier <celier@gnat.com>
|
||||
|
||||
* gnatcmd.adb: (MAKE): Add new translations: -b /BIND_ONLY,
|
||||
|
@ -2691,6 +2691,7 @@ package body Checks is
|
||||
|
||||
procedure Insert_Valid_Check (Expr : Node_Id) is
|
||||
Loc : constant Source_Ptr := Sloc (Expr);
|
||||
Exp : Node_Id;
|
||||
|
||||
begin
|
||||
-- Do not insert if checks off, or if not checking validity
|
||||
@ -2698,27 +2699,35 @@ package body Checks is
|
||||
if Range_Checks_Suppressed (Etype (Expr))
|
||||
or else (not Validity_Checks_On)
|
||||
then
|
||||
null;
|
||||
|
||||
-- Otherwise insert the validity check. Note that we do this with
|
||||
-- validity checks turned off, to avoid recursion, we do not want
|
||||
-- validity checks on the validity checking code itself!
|
||||
|
||||
else
|
||||
Validity_Checks_On := False;
|
||||
Insert_Action
|
||||
(Expr,
|
||||
Make_Raise_Constraint_Error (Loc,
|
||||
Condition =>
|
||||
Make_Op_Not (Loc,
|
||||
Right_Opnd =>
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix =>
|
||||
Duplicate_Subexpr (Expr, Name_Req => True),
|
||||
Attribute_Name => Name_Valid))),
|
||||
Suppress => All_Checks);
|
||||
Validity_Checks_On := True;
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- If we have a checked conversion, then validity check applies to
|
||||
-- the expression inside the conversion, not the result, since if
|
||||
-- the expression inside is valid, then so is the conversion result.
|
||||
|
||||
Exp := Expr;
|
||||
while Nkind (Exp) = N_Type_Conversion loop
|
||||
Exp := Expression (Exp);
|
||||
end loop;
|
||||
|
||||
-- insert the validity check. Note that we do this with validity
|
||||
-- checks turned off, to avoid recursion, we do not want validity
|
||||
-- checks on the validity checking code itself!
|
||||
|
||||
Validity_Checks_On := False;
|
||||
Insert_Action
|
||||
(Expr,
|
||||
Make_Raise_Constraint_Error (Loc,
|
||||
Condition =>
|
||||
Make_Op_Not (Loc,
|
||||
Right_Opnd =>
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix =>
|
||||
Duplicate_Subexpr (Exp, Name_Req => True),
|
||||
Attribute_Name => Name_Valid))),
|
||||
Suppress => All_Checks);
|
||||
Validity_Checks_On := True;
|
||||
end Insert_Valid_Check;
|
||||
|
||||
--------------------------
|
||||
|
@ -5032,6 +5032,7 @@ package body Sem_Ch3 is
|
||||
Set_Size_Info (Derived_Type, Parent_Type);
|
||||
Set_RM_Size (Derived_Type, RM_Size (Parent_Type));
|
||||
Set_Convention (Derived_Type, Convention (Parent_Type));
|
||||
Set_Is_Controlled (Derived_Type, Is_Controlled (Parent_Type));
|
||||
Set_First_Rep_Item (Derived_Type, First_Rep_Item (Parent_Type));
|
||||
|
||||
case Ekind (Parent_Type) is
|
||||
|
Loading…
Reference in New Issue
Block a user