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:
Geert Bosch 2001-12-11 22:24:20 +01:00
parent d5d7ae5c75
commit 84157f5101
3 changed files with 42 additions and 20 deletions

View File

@ -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,

View File

@ -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;
--------------------------

View File

@ -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