[Ada] Reflect ACT changes of 2001-10-25

[Geert Bosch <bosch at darwin dot gnat dot com>]

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.

*** checks.adb	2001/10/21 10:12:21	1.207
--- checks.adb	2001/10/25 01:16:17	1.208
***************
*** 2691,2696 ****
--- 2691,2697 ----
  
     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,2724 ****
        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;
        end if;
     end Insert_Valid_Check;
  
     --------------------------
--- 2699,2733 ----
        if Range_Checks_Suppressed (Etype (Expr))
          or else (not Validity_Checks_On)
        then
!          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;
  
     --------------------------

*** sem_ch3.adb	2001/10/23 20:01:24	1.1361
--- sem_ch3.adb	2001/10/25 02:50:54	1.1362
***************
*** 5034,5039 ****
--- 5034,5040 ----
        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