[Ada] Put_Image attribute

2020-06-11  Bob Duff  <duff@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.

diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 1d614eb70c5bb3d0609cc377f75f72d8db5ac919..0c86d96dddd1fe0302831dcd09519c9638aec412 100644 (file)
--- a/gcc/ada/debug.adb
+++ b/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

diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb
index 4f2a67f583811d8d8e7354e4a783ae8eb6598f40..d7be8e44a401a7b3982b6fc5bbe758ea0c97f169 100644 (file)
--- a/gcc/ada/exp_imgv.adb
+++ b/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

diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb
index af6a78370db8940d9a46dbed8f70e1042b6380fa..3a6cbc1f6675f7297c8e08c8587ef7d0cb3ff34f 100644 (file)
--- a/gcc/ada/exp_put_image.adb
+++ b/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

diff --git a/gcc/ada/libgnat/a-stteou.ads b/gcc/ada/libgnat/a-stteou.ads
index 1240f4af33c4d977925352976b32e051535c49aa..8aaee461378d62c254251838559f5ca58470a15d 100644 (file)
--- a/gcc/ada/libgnat/a-stteou.ads
+++ b/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;
 

diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 8987f83957216cc55f3f851655561e9de5eab2eb..b08df8d51620aa46fbc4e63d6465c433164b2eeb 100644 (file)
--- a/gcc/ada/opt.ads
+++ b/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