Commit a7fb206d by Robert Dewar Committed by Geert Bosch

exp_imgv.adb (Expand_Image_Attribute): Defend against bad use in HIE mode,…

exp_imgv.adb (Expand_Image_Attribute): Defend against bad use in HIE mode, avoids compilation abandoned message

	* exp_imgv.adb (Expand_Image_Attribute): Defend against bad use
        in HIE mode, avoids compilation abandoned message

	* exp_imgv.adb: Correct typo in previous change

	* exp_imgv.adb: Correct typo in previous change (not my day!)

From-SVN: r46501
parent 1403221a
2001-10-25 Robert Dewar <dewar@gnat.com> 2001-10-25 Robert Dewar <dewar@gnat.com>
* exp_imgv.adb (Expand_Image_Attribute): Defend against bad use
in HIE mode, avoids compilation abandoned message
* exp_imgv.adb: Correct typo in previous change
* exp_imgv.adb: Correct typo in previous change (not my day!)
2001-10-25 Robert Dewar <dewar@gnat.com>
* s-tpinop.ads: Add 2001 to copyright notice. Fix header format. * s-tpinop.ads: Add 2001 to copyright notice. Fix header format.
2001-10-25 Pascal Obry <obry@gnat.com> 2001-10-25 Pascal Obry <obry@gnat.com>
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- $Revision: 1.4 $ -- $Revision$
-- -- -- --
-- Copyright (C) 2001 Free Software Foundation, Inc. -- -- Copyright (C) 2001 Free Software Foundation, Inc. --
-- -- -- --
...@@ -227,17 +227,18 @@ package body Exp_Imgv is ...@@ -227,17 +227,18 @@ package body Exp_Imgv is
-- is 32/16/8 depending on the element type of Lit_Indexes. -- is 32/16/8 depending on the element type of Lit_Indexes.
procedure Expand_Image_Attribute (N : Node_Id) is procedure Expand_Image_Attribute (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
Exprs : constant List_Id := Expressions (N); Exprs : constant List_Id := Expressions (N);
Pref : constant Node_Id := Prefix (N); Pref : constant Node_Id := Prefix (N);
Ptyp : constant Entity_Id := Entity (Pref); Ptyp : constant Entity_Id := Entity (Pref);
Rtyp : constant Entity_Id := Root_Type (Ptyp); Rtyp : constant Entity_Id := Root_Type (Ptyp);
Expr : constant Node_Id := Relocate_Node (First (Exprs)); Expr : constant Node_Id := Relocate_Node (First (Exprs));
Imid : RE_Id; Imid : RE_Id;
Tent : Entity_Id; Tent : Entity_Id;
Arglist : List_Id; Arglist : List_Id;
Func : RE_Id; Func : RE_Id;
Ttyp : Entity_Id; Ttyp : Entity_Id;
Func_Ent : Entity_Id;
begin begin
if Rtyp = Standard_Boolean then if Rtyp = Standard_Boolean then
...@@ -347,7 +348,20 @@ package body Exp_Imgv is ...@@ -347,7 +348,20 @@ package body Exp_Imgv is
end if; end if;
-- If we fall through, we have one of the cases that is handled by -- If we fall through, we have one of the cases that is handled by
-- calling one of the System.Img_xx routines. -- calling one of the System.Img_xx routines and Imid is set to the
-- RE_Id for the function to be called.
Func_Ent := RTE (Imid);
-- If the function entity is empty, that means we have a case in
-- no run time mode where the operation is not allowed, and an
-- appropriate diagnostic has already been issued.
if No (Func_Ent) then
return;
end if;
-- Otherwise prepare arguments for run-time call
Arglist := New_List (Convert_To (Tent, Relocate_Node (Expr))); Arglist := New_List (Convert_To (Tent, Relocate_Node (Expr)));
...@@ -388,7 +402,7 @@ package body Exp_Imgv is ...@@ -388,7 +402,7 @@ package body Exp_Imgv is
Rewrite (N, Rewrite (N,
Make_Function_Call (Loc, Make_Function_Call (Loc,
Name => New_Reference_To (RTE (Imid), Loc), Name => New_Reference_To (Func_Ent, Loc),
Parameter_Associations => Arglist)); Parameter_Associations => Arglist));
Analyze_And_Resolve (N, Standard_String); Analyze_And_Resolve (N, Standard_String);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment