Work around bug in Put_Image of types in Remote_Types packages. Use the
switch -gnatd_z to control enabling of Put_Image. Put_Image is still
disabled by default for all types.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-11 Bob Duff <d...@adacore.com>
gcc/ada/
* exp_put_image.adb (Build_Record_Put_Image_Procedure): Remove
special processing of protected types, because those are handled
by Build_Protected_Put_Image_Call.
(Enable_Put_Image): Use the switch -gnatd_z to control enabling
of Put_Image. Disable Put_Image for types in Remote_Types
packages.
* debug.adb: Document -gnatd_z switch.
* exp_imgv.adb, libgnat/a-stteou.ads, opt.ads: Minor cleanups.--- gcc/ada/debug.adb
+++ gcc/ada/debug.adb
@@ -170,7 +170,7 @@ package body Debug is
-- d_w
-- d_x
-- d_y
- -- d_z
+ -- d_z Enable Put_Image
-- d_A Stop generation of ALI file
-- d_B
@@ -993,6 +993,9 @@ package body Debug is
-- a call to routine Ada.Synchronous_Task_Control.Suspend_Until_True
-- or Ada.Synchronous_Barriers.Wait_For_Release.
+ -- d_z The Put_Image attribute is a work in progress, and is disabled by
+ -- default. This enables it.
+
-- d_A Do not generate ALI files by setting Opt.Disable_ALI_File.
-- d_F The compiler encodes the full path from an invocation construct to
--- gcc/ada/exp_imgv.adb
+++ gcc/ada/exp_imgv.adb
@@ -747,7 +747,7 @@ package body Exp_Imgv is
-- btyp (Value_xx (X))
- -- where btyp is he base type of the prefix
+ -- where btyp is the base type of the prefix
-- For types whose root type is Character
-- xx = Character
--- gcc/ada/exp_put_image.adb
+++ gcc/ada/exp_put_image.adb
@@ -24,6 +24,7 @@
------------------------------------------------------------------------------
with Atree; use Atree;
+with Debug; use Debug;
with Einfo; use Einfo;
with Exp_Tss; use Exp_Tss;
with Lib; use Lib;
@@ -323,9 +324,14 @@ package body Exp_Put_Image is
--
-- Put_Wide_Wide_String (Sink, U_Type'Wide_Wide_Image (Item));
--
- -- This is a bit of a cheat; we should probably do it the other way
- -- around (define '[[Wide_]Wide_]Image in terms of 'Put_Image). But
- -- this is expedient for now. We can't do this:
+ -- It would be more elegant to do it the other way around (define
+ -- '[[Wide_]Wide_]Image in terms of 'Put_Image). But this is easier
+ -- to implement, because we already have support for
+ -- 'Wide_Wide_Image. Furthermore, we don't want to remove the
+ -- existing support for '[[Wide_]Wide_]Image, because we don't
+ -- currently plan to support 'Put_Image on restricted runtimes.
+
+ -- We can't do this:
--
-- Put_UTF_8 (Sink, U_Type'Image (Item));
--
@@ -689,22 +695,12 @@ package body Exp_Put_Image is
Stms : constant List_Id := New_List;
Rdef : Node_Id;
- Typt : Entity_Id;
- Type_Decl : Node_Id;
+ Type_Decl : constant Node_Id :=
+ Declaration_Node (Base_Type (Underlying_Type (Typ)));
-- Start of processing for Build_Record_Put_Image_Procedure
begin
- -- For the protected type case, use corresponding record
-
- if Is_Protected_Type (Typ) then
- Typt := Corresponding_Record_Type (Typ);
- else
- Typt := Typ;
- end if;
-
- Type_Decl := Declaration_Node (Base_Type (Underlying_Type (Typt)));
-
Append_To (Stms,
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (RTE (RE_Record_Before), Loc),
@@ -813,7 +809,7 @@ package body Exp_Put_Image is
function Enable_Put_Image (T : Entity_Id) return Boolean is
begin
- if True then -- ????True to disable for all types.
+ if not Debug_Flag_Underscore_Z then -- ????True to disable for all types
return False;
end if;
@@ -832,6 +828,15 @@ package body Exp_Put_Image is
-- scalar types are expanded inline. We certainly want to be able to use
-- Integer'Put_Image, for example.
+ -- ???Work around a bug: Put_Image does not work for Remote_Types.
+ -- We check the containing package, rather than the type itself, because
+ -- we want to include types in the private part of a Remote_Types
+ -- package.
+
+ if Is_Remote_Types (Scope (T)) then
+ return False;
+ end if;
+
-- ???Disable Put_Image on type Sink declared in
-- Ada.Strings.Text_Output. Note that we can't call Is_RTU on
-- Ada_Strings_Text_Output, because it's not known yet (we might be
--- gcc/ada/libgnat/a-stteou.ads
+++ gcc/ada/libgnat/a-stteou.ads
@@ -133,7 +133,7 @@ package Ada.Strings.Text_Output is
(UTF_Encoding.Wide_Wide_Strings.Decode (UTF_8_Lines)) = UTF_8_Lines;
subtype UTF_8 is UTF_8_Lines with
- Predicate => (for all C of UTF_8 => C /= NL);
+ Predicate => (for all UTF_8_Char of UTF_8 => UTF_8_Char /= NL);
Default_Indent_Amount : constant Natural := 4;
--- gcc/ada/opt.ads
+++ gcc/ada/opt.ads
@@ -373,9 +373,9 @@ package Opt is
Configurable_Run_Time_Mode : Boolean := False;
-- GNAT, GNATBIND
-- Set True if the compiler is operating in configurable run-time mode.
- -- This happens if the flag Targparm.Configurable_Run_TimeMode_On_Target
- -- is set True, or if pragma No_Run_Time is used. See the spec of Rtsfind
- -- for details on the handling of the latter pragma.
+ -- This happens if the flag Targparm.Configurable_Run_Time_On_Target is
+ -- True, or if pragma No_Run_Time is used. See the spec of Rtsfind for
+ -- details on the handling of the latter pragma.
Constant_Condition_Warnings : Boolean := False;
-- GNAT
