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

	* exp_cg.adb: Minor reformatting.

2010-10-04  Javier Miranda  <miranda@adacore.com>

	* exp_cg.adb (Expand_N_Assignment_Statement): Restore tag check when
	the target object is an interface.
	* sem_disp.adb (Propagate_Tag): If the controlling argument is an
	interface type then we generate an implicit conversion to force
	displacement of the pointer to the object to reference the secondary
	dispatch table associated with the interface.

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

	* sem_ch13.adb (Analyze_Enumeration_Representation_Clause): Set
	Enumeration_Rep_Expr to point to the literal, not the identifier.
	(Analyze_Enumeration_Representation_Clause): Improve error message for
	size too small for enum rep value
	(Analyze_Enumeration_Representation_Clause): Fix size test to use proper
	size (RM_Size, not Esize).



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@164939 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 83 insertions, 22 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index cf8515144c3..1d33f866a1d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+2010-10-04  Javier Miranda  <miranda@adacore.com>
+
+	* exp_cg.adb (Expand_N_Assignment_Statement): Restore tag check when
+	the target object is an interface.
+	* sem_disp.adb (Propagate_Tag): If the controlling argument is an
+	interface type then we generate an implicit conversion to force
+	displacement of the pointer to the object to reference the secondary
+	dispatch table associated with the interface.
+
+2010-10-04  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch13.adb (Analyze_Enumeration_Representation_Clause): Set
+	Enumeration_Rep_Expr to point to the literal, not the identifier.
+	(Analyze_Enumeration_Representation_Clause): Improve error message for
+	size too small for enum rep value
+	(Analyze_Enumeration_Representation_Clause): Fix size test to use proper
+	size (RM_Size, not Esize).
+
 2010-10-04  Robert Dewar  <dewar@adacore.com>
 
 	* s-taprop-vxworks.adb, sem_res.adb: Minor reformatting.
diff --git a/gcc/ada/exp_cg.adb b/gcc/ada/exp_cg.adb
index 1addb9407ee..4aa7b0b6397 100644
--- a/gcc/ada/exp_cg.adb
+++ b/gcc/ada/exp_cg.adb
@@ -409,6 +409,7 @@ package body Exp_CG is
       Nul   : constant Character := Character'First;
       Line  : String (Str'First .. Str'Last + 1);
       Errno : Integer;
+
    begin
       --  Add the null character to the string as required by fputs
 
@@ -583,9 +584,9 @@ package body Exp_CG is
 
          if Present (Interface_Alias (Prim))
            or else
-            (Present (Alias (Prim))
-               and then Find_Dispatching_Type (Prim)
-                          /= Find_Dispatching_Type (Alias (Prim)))
+             (Present (Alias (Prim))
+               and then Find_Dispatching_Type (Prim) /=
+                        Find_Dispatching_Type (Alias (Prim)))
          then
             goto Continue;
          end if;
@@ -641,8 +642,8 @@ package body Exp_CG is
                   Int_Alias := Interface_Alias (Prim_Op);
 
                   if Present (Int_Alias)
-                    and then not Is_Ancestor
-                                   (Find_Dispatching_Type (Int_Alias), Typ)
+                    and then
+                      not Is_Ancestor (Find_Dispatching_Type (Int_Alias), Typ)
                     and then (Alias (Prim_Op)) = Prim
                   then
                      Write_Char (',');
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 18bda5d5b3f..fb1888da457 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -1956,12 +1956,6 @@ package body Exp_Ch5 is
                   if Is_Class_Wide_Type (Typ)
                     and then Is_Tagged_Type (Typ)
                     and then Is_Tagged_Type (Underlying_Type (Etype (Rhs)))
-
-                    --   Do not generate a tag check when the target object is
-                    --   an interface since the expression of the right hand
-                    --   side must only cover the interface.
-
-                    and then not Is_Interface (Typ)
                   then
                      Append_To (L,
                        Make_Raise_Constraint_Error (Loc,
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index b3dd42cd548..ef46ad7eb83 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -2098,10 +2098,16 @@ package body Sem_Ch13 is
       Val      : Uint;
       Err      : Boolean := False;
 
-      Lo  : constant Uint := Expr_Value (Type_Low_Bound (Universal_Integer));
-      Hi  : constant Uint := Expr_Value (Type_High_Bound (Universal_Integer));
+      Lo : constant Uint := Expr_Value (Type_Low_Bound (Universal_Integer));
+      Hi : constant Uint := Expr_Value (Type_High_Bound (Universal_Integer));
+      --  Allowed range of universal integer (= allowed range of enum lit vals)
+
       Min : Uint;
       Max : Uint;
+      --  Minimum and maximum values of entries
+
+      Max_Node : Node_Id;
+      --  Pointer to node for literal providing max value
 
    begin
       if Ignore_Rep_Clauses then
@@ -2260,7 +2266,7 @@ package body Sem_Ch13 is
                         Err := True;
                      end if;
 
-                     Set_Enumeration_Rep_Expr (Elit, Choice);
+                     Set_Enumeration_Rep_Expr (Elit, Expression (Assoc));
 
                      Expr := Expression (Assoc);
                      Val := Static_Integer (Expr);
@@ -2306,15 +2312,16 @@ package body Sem_Ch13 is
                   if Max /= No_Uint and then Val <= Max then
                      Error_Msg_NE
                        ("enumeration value for& not ordered!",
-                                       Enumeration_Rep_Expr (Elit), Elit);
+                        Enumeration_Rep_Expr (Elit), Elit);
                   end if;
 
+                  Max_Node := Enumeration_Rep_Expr (Elit);
                   Max := Val;
                end if;
 
-               --  If there is at least one literal whose representation
-               --  is not equal to the Pos value, then note that this
-               --  enumeration type has a non-standard representation.
+               --  If there is at least one literal whose representation is not
+               --  equal to the Pos value, then note that this enumeration type
+               --  has a non-standard representation.
 
                if Val /= Enumeration_Pos (Elit) then
                   Set_Has_Non_Standard_Rep (Base_Type (Enumtype));
@@ -2331,15 +2338,28 @@ package body Sem_Ch13 is
 
          begin
             if Has_Size_Clause (Enumtype) then
-               if Esize (Enumtype) >= Minsize then
+
+               --  All OK, if size is OK now
+
+               if RM_Size (Enumtype) >= Minsize then
                   null;
 
                else
+                  --  Try if we can get by with biasing
+
                   Minsize :=
                     UI_From_Int (Minimum_Size (Enumtype, Biased => True));
 
-                  if Esize (Enumtype) < Minsize then
-                     Error_Msg_N ("previously given size is too small", N);
+                  --  Error message if even biasing does not work
+
+                  if RM_Size (Enumtype) < Minsize then
+                     Error_Msg_Uint_1 := RM_Size (Enumtype);
+                     Error_Msg_Uint_2 := Max;
+                     Error_Msg_N
+                       ("previously given size (^) is too small "
+                        & "for this value (^)", Max_Node);
+
+                  --  If biasing worked, indicate that we now have biased rep
 
                   else
                      Set_Has_Biased_Representation (Enumtype);
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 69846939621..f40df26b59a 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -1959,7 +1959,35 @@ package body Sem_Disp is
       --  and would have to undo any expansion to an indirect call.
 
       if Tagged_Type_Expansion then
-         Expand_Dispatching_Call (Call_Node);
+         declare
+            Call_Typ : constant Entity_Id := Etype (Call_Node);
+
+         begin
+            Expand_Dispatching_Call (Call_Node);
+
+            --  If the controlling argument is an interface type and the type
+            --  of Call_Node differs then we must add an implicit conversion to
+            --  force displacement of the pointer to the object to reference
+            --  the secondary dispatch table of the interface.
+
+            if Is_Interface (Etype (Control))
+              and then Etype (Control) /= Call_Typ
+            then
+               --  Cannot use Convert_To because the previous call to
+               --  Expand_Dispatching_Call leaves decorated the Call_Node
+               --  with the type of Control.
+
+               Rewrite (Call_Node,
+                 Make_Type_Conversion (Sloc (Call_Node),
+                   Subtype_Mark =>
+                     New_Occurrence_Of (Etype (Control), Sloc (Call_Node)),
+                   Expression => Relocate_Node (Call_Node)));
+               Set_Etype (Call_Node, Etype (Control));
+               Set_Analyzed (Call_Node);
+
+               Expand_Interface_Conversion (Call_Node, Is_Static => False);
+            end if;
+         end;
 
       --  Expansion of a dispatching call results in an indirect call, which in
       --  turn causes current values to be killed (see Resolve_Call), so on VM