[multiple changes]

2010-10-19  Geert Bosch  <bosch@adacore.com>

	* ttypef.ads: Change VAXDF_Last to be -VAXDF_First, as type is
	symmetric.

2010-10-19  Robert Dewar  <dewar@adacore.com>

	* atree.h (Field29): Fix incorrect definition.
	* einfo.adb (Invariant_Procedure): New attribute
	(Has_Invariants): New flag
	(Has_Inheritable_Invariants): New flag
	(OK_To_Reference): New flag
	Minor code reorganization (use Next_Rep_Item function)
	* einfo.ads (Invariant_Procedure): New attribute
	(Has_Invariants): New flag
	(Has_Inheritable_Invariants): New flag
	(OK_To_Reference): New flag
	* exp_ch3.adb (Expand_N_Object_Declaration): Add check for invariant
	* exp_ch4.adb (Expand_N_Type_Conversion): Check invariant on type
	conversion.  Minor reformatting.
	* exp_util.ads, exp_util.adb (Make_Invariant_Call): New procedure.
	* opt.ads (List_Inherited_Aspects): New name for List_Inherited_Pre_Post
	* par-prag.adb: Add dummy entry for pragma Invariant.
	* sem_ch13.adb (Build_Invariant_Procedure): New procedure
	(Analyze_Aspect_Specification): Add support for Invariant aspect
	* sem_ch13.ads (Build_Invariant_Procedure): New procedure
	* sem_ch3.adb (Build_Derived_Type): Propagate invariant information
	(Process_Full_View): Deal with invariants, building invariant procedure
	Minor reformatting
	* sem_ch6.adb (Process_PPCs): Add processing of invariants
	* sem_ch7.adb (Analyze_Package_Specification): Build invariant
	procedures.
	* sem_prag.adb: Implement pragma Invariant.
	* sem_res.adb (Resolve_Entity_Name): Allow type reference if
	OK_To_Reference set.
	* sem_warn.adb (List_Inherited_Aspects): New name for
	List_Inherited_Pre_Post.
	* snames.ads-tmpl: Add entries for pragma Invariant.
	* treepr.adb (Print_Entity_Information): Add handling of Field29.
	* usage.adb: Warning .l/.L applies to invariant as well as pre/post.

From-SVN: r165694

1 files changed, 49 insertions, 12 deletions

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index e742c49..682f075 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4349,12 +4349,17 @@ package body Exp_Ch4 is
 
          begin
             if (Is_Entity_Name (Alt) and then Is_Type (Entity (Alt)))
-               or else Nkind (Alt) = N_Range
+              or else Nkind (Alt) = N_Range
             then
-               Cond := Make_In (Sloc (Alt), Left_Opnd  => L, Right_Opnd => R);
+               Cond :=
+                 Make_In (Sloc (Alt),
+                   Left_Opnd  => L,
+                   Right_Opnd => R);
             else
                Cond :=
-                 Make_Op_Eq (Sloc (Alt), Left_Opnd  => L, Right_Opnd => R);
+                 Make_Op_Eq (Sloc (Alt),
+                   Left_Opnd  => L,
+                   Right_Opnd => R);
             end if;
 
             return Cond;
@@ -4472,17 +4477,17 @@ package body Exp_Ch4 is
          begin
             --  If test is explicit x'First .. x'Last, replace by valid check
 
+            --  Could use some individual comments for this complex test ???
+
             if Is_Scalar_Type (Ltyp)
               and then Nkind (Lo_Orig) = N_Attribute_Reference
               and then Attribute_Name (Lo_Orig) = Name_First
               and then Nkind (Prefix (Lo_Orig)) in N_Has_Entity
               and then Entity (Prefix (Lo_Orig)) = Ltyp
-
               and then Nkind (Hi_Orig) = N_Attribute_Reference
               and then Attribute_Name (Hi_Orig) = Name_Last
               and then Nkind (Prefix (Hi_Orig)) in N_Has_Entity
               and then Entity (Prefix (Hi_Orig)) = Ltyp
-
               and then Comes_From_Source (N)
               and then VM_Target = No_VM
             then
@@ -8143,7 +8148,7 @@ package body Exp_Ch4 is
          end if;
 
          Rewrite (N, Relocate_Node (Operand));
-         return;
+         goto Done;
       end if;
 
       --  Nothing to do if this is the second argument of read. This is a
@@ -8154,7 +8159,34 @@ package body Exp_Ch4 is
         and then Attribute_Name (Parent (N)) = Name_Read
         and then Next (First (Expressions (Parent (N)))) = N
       then
-         return;
+         goto Done;
+      end if;
+
+      --  Check for case of converting to a type that has an invariant
+      --  associated with it. This required an invariant check. We convert
+
+      --    typ (expr)
+
+      --  into
+
+      --    do invariant_check (typ (expr)) in typ (expr);
+
+      --  using Duplicate_Subexpr to avoid multiple side effects
+
+      --  Note: the Comes_From_Source check, and then the resetting of this
+      --  flag prevents what would otherwise be an infinite recursion.
+
+      if Present (Invariant_Procedure (Target_Type))
+        and then Comes_From_Source (N)
+      then
+         Set_Comes_From_Source (N, False);
+         Rewrite (N,
+           Make_Expression_With_Actions (Loc,
+             Actions    => New_List (
+               Make_Invariant_Call (Duplicate_Subexpr (N))),
+             Expression => Duplicate_Subexpr_No_Checks (N)));
+         Analyze_And_Resolve (N, Target_Type);
+         goto Done;
       end if;
 
       --  Here if we may need to expand conversion
@@ -8227,7 +8259,7 @@ package body Exp_Ch4 is
                 Expression   => Opnd));
 
             Analyze_And_Resolve (N, Target_Type);
-            return;
+            goto Done;
          end;
       end if;
 
@@ -8300,7 +8332,7 @@ package body Exp_Ch4 is
                       Type_Access_Level (Target_Type)
          then
             Raise_Accessibility_Error;
-            return;
+            goto Done;
          end if;
       end if;
 
@@ -8328,7 +8360,7 @@ package body Exp_Ch4 is
          --  Sem_Ch8, and the expansion can interfere with this error check.
 
          if Is_Access_Type (Target_Type) and then Is_Renamed_Object (N) then
-            return;
+            goto Done;
          end if;
 
          --  Otherwise, proceed with processing tagged conversion
@@ -8410,7 +8442,7 @@ package body Exp_Ch4 is
 
             if Is_Interface (Actual_Op_Typ) then
                Expand_Interface_Conversion (N, Is_Static => False);
-               return;
+               goto Done;
             end if;
 
             if not Tag_Checks_Suppressed (Actual_Targ_Typ) then
@@ -8764,8 +8796,13 @@ package body Exp_Ch4 is
         and then (Vax_Float (Operand_Type) or else Vax_Float (Target_Type))
       then
          Expand_Vax_Conversion (N);
-         return;
+         goto Done;
       end if;
+
+      --  Here at end of processing
+
+      <<Done>>
+         null;
    end Expand_N_Type_Conversion;
 
    -----------------------------------