* 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
+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.
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
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;
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 (',');
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,
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
Err := True;
end if;
- Set_Enumeration_Rep_Expr (Elit, Choice);
+ Set_Enumeration_Rep_Expr (Elit, Expression (Assoc));
Expr := Expression (Assoc);
Val := Static_Integer (Expr);
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));
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);
-- 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
projects / platform / upstream / linaro-gcc.git / commitdiff