OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[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.
This commit is contained in:
Bob Duff 2020-03-30 15:34:28 -04:00 committed by Pierre-Marie de Rodat
parent 6349cf36d8
commit 6a920eb510
4 changed files with 9 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/ada/exp_put_image.adb
View File

@ -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;

6
gcc/ada/libgnat/s-putima.adb
View File

@ -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

3
gcc/ada/libgnat/s-putima.ads
View File

@ -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);

4
gcc/ada/rtsfind.ads
View File

@ -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,