aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorBob Duff <duff@adacore.com>2020-03-30 15:34:28 -0400
committerPierre-Marie de Rodat <derodat@adacore.com>2020-06-15 04:04:25 -0400
commit6a920eb51077cd465472eabb24a49b3e4ca30e93 (patch)
tree1b216d0340468657aafd593d64c028844b310336 /gcc/ada
parent6349cf36d8bb7fb83f67a7bc27fc67dca73b19dd (diff)
downloadgcc-6a920eb51077cd465472eabb24a49b3e4ca30e93.zip
gcc-6a920eb51077cd465472eabb24a49b3e4ca30e93.tar.gz
gcc-6a920eb51077cd465472eabb24a49b3e4ca30e93.tar.bz2
[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.
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/exp_put_image.adb7
-rw-r--r--gcc/ada/libgnat/s-putima.adb6
-rw-r--r--gcc/ada/libgnat/s-putima.ads3
-rw-r--r--gcc/ada/rtsfind.ads4
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..1b214bf8 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,