From 6a920eb51077cd465472eabb24a49b3e4ca30e93 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 30 Mar 2020 15:34:28 -0400 Subject: [PATCH] [Ada] Put_Image: Enable for access-to-subprogram types 2020-06-15 Bob Duff 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. --- gcc/ada/exp_put_image.adb | 7 +------ gcc/ada/libgnat/s-putima.adb | 6 ++++-- gcc/ada/libgnat/s-putima.ads | 3 ++- gcc/ada/rtsfind.ads | 4 ++-- 4 files changed, 9 insertions(+), 11 deletions(-) diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb index 657f618..0fa4304 100644 --- 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 d7d530b..1b214bf 100644 --- 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 3015a41..da62930 100644 --- 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 5ddb050..0200c1d 100644 --- 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, -- 2.7.4