From 84157f5101464652f4bdf73291f1f824935c7ef8 Mon Sep 17 00:00:00 2001 From: Geert Bosch Date: Tue, 11 Dec 2001 22:24:20 +0100 Subject: [PATCH] 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 --- gcc/ada/ChangeLog | 12 +++++++++++ gcc/ada/checks.adb | 49 +++++++++++++++++++++++++++------------------ gcc/ada/sem_ch3.adb | 1 + 3 files changed, 42 insertions(+), 20 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c32f52c38db..9a1631ba9ad 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2001-12-11 Robert Dewar + + * checks.adb (Insert_Valid_Check): Apply validity check to expression + of conversion, not to result of conversion. + +2001-12-11 Ed Schonberg + + * 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 * gnatcmd.adb: (MAKE): Add new translations: -b /BIND_ONLY, diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 67723b5b986..bf806417558 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -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; -------------------------- diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 154c2347c6d..dff460cfca2 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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