[Ada] Put_Image: Enable for access-to-subprogram types

2020-06-15  Bob Duff  <duff@adacore.com>

gcc/ada/

	* exp_put_image.adb, libgnat/s-putima.adb, libgnat/s-putima.ads,
	rtsfind.ads: Enable Put_Image if Is_Access_Subprogram_Type (Typ).
	Remove comment saying it's disabled in that case.  Rename
	Put_Image_Access_Prot to be Put_Image_Access_Prot_Subp to
	clarify that we're talking about access-to-subprogram, not
	access-to-protected-object.

diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb
index 657f618c373600614e5d16223f70ad96c8643b49..0fa4304e19433ea180ed5328f34ac8c414018ae9 100644 (file)
--- a/gcc/ada/exp_put_image.adb
+++ b/gcc/ada/exp_put_image.adb
@@ -315,7 +315,7 @@ package body Exp_Put_Image is
 
       elsif Is_Access_Type (U_Type) then
          if Is_Access_Protected_Subprogram_Type (U_Type) then
-            Lib_RE := RE_Put_Image_Access_Prot;
+            Lib_RE := RE_Put_Image_Access_Prot_Subp;
          elsif Is_Access_Subprogram_Type (U_Type) then
             Lib_RE := RE_Put_Image_Access_Subp;
          elsif P_Size = System_Address_Size then
@@ -830,15 +830,10 @@ package body Exp_Put_Image is
       --  types in the private part of a Remote_Types package.
       --
       --  Put_Image on tagged types triggers some bugs.
-      --
-      --  Put_Image doesn't work for access-to-protected types, because of
-      --  confusion over their size. Disable for all access-to-subprogram
-      --  types, just in case.
 
       if Is_Remote_Types (Scope (Typ))
         or else (Is_Tagged_Type (Typ) and then In_Predefined_Unit (Typ))
         or else (Is_Tagged_Type (Typ) and then not Tagged_Put_Image_Enabled)
-        or else Is_Access_Subprogram_Type (Typ)
       then
          return False;
       end if;

diff --git a/gcc/ada/libgnat/s-putima.adb b/gcc/ada/libgnat/s-putima.adb
index d7d530bec0ce209f60e074bac2045bce38d18690..1b214bf872287e5dd75380522733259467c69556 100644 (file)
--- a/gcc/ada/libgnat/s-putima.adb
+++ b/gcc/ada/libgnat/s-putima.adb
@@ -158,10 +158,12 @@ package body System.Put_Images is
       Thin_Instance (S, X, "access subprogram");
    end Put_Image_Access_Subp;
 
-   procedure Put_Image_Access_Prot (S : in out Sink'Class; X : Thin_Pointer) is
+   procedure Put_Image_Access_Prot_Subp
+     (S : in out Sink'Class; X : Thin_Pointer)
+   is
    begin
       Thin_Instance (S, X, "access protected subprogram");
-   end Put_Image_Access_Prot;
+   end Put_Image_Access_Prot_Subp;
 
    procedure Put_Image_String (S : in out Sink'Class; X : String) is
    begin

diff --git a/gcc/ada/libgnat/s-putima.ads b/gcc/ada/libgnat/s-putima.ads
index 3015a417068a9337364fd6bb3aa4acada967a43b..da6293004f1845a9af7fe2fc1e61aee62003ef00 100644 (file)
--- a/gcc/ada/libgnat/s-putima.ads
+++ b/gcc/ada/libgnat/s-putima.ads
@@ -72,7 +72,8 @@ package System.Put_Images is
    procedure Put_Image_Access_Subp (S : in out Sink'Class; X : Thin_Pointer);
    --  For access-to-subprogram types
 
-   procedure Put_Image_Access_Prot (S : in out Sink'Class; X : Thin_Pointer);
+   procedure Put_Image_Access_Prot_Subp
+     (S : in out Sink'Class; X : Thin_Pointer);
    --  For access-to-protected-subprogram types
 
    procedure Put_Image_String (S : in out Sink'Class; X : String);

diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index 5ddb050a847a052ba9a43fff8d25c97c484ffe94..0200c1d0f51302bdf851072be7e3b131f2fcb243 100644 (file)
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -1180,7 +1180,7 @@ package Rtsfind is
      RE_Put_Image_Thin_Pointer,          -- System.Put_Images
      RE_Put_Image_Fat_Pointer,           -- System.Put_Images
      RE_Put_Image_Access_Subp,           -- System.Put_Images
-     RE_Put_Image_Access_Prot,           -- System.Put_Images
+     RE_Put_Image_Access_Prot_Subp,      -- System.Put_Images
      RE_Put_Image_String,                -- System.Put_Images
      RE_Put_Image_Wide_String,           -- System.Put_Images
      RE_Put_Image_Wide_Wide_String,      -- System.Put_Images
@@ -2583,7 +2583,7 @@ package Rtsfind is
      RE_Put_Image_Thin_Pointer           => System_Put_Images,
      RE_Put_Image_Fat_Pointer            => System_Put_Images,
      RE_Put_Image_Access_Subp            => System_Put_Images,
-     RE_Put_Image_Access_Prot            => System_Put_Images,
+     RE_Put_Image_Access_Prot_Subp       => System_Put_Images,
      RE_Put_Image_String                 => System_Put_Images,
      RE_Put_Image_Wide_String            => System_Put_Images,
      RE_Put_Image_Wide_Wide_String       => System_Put_Images,