[Ada] Put_Image: preload type Sink, change what types have it enabled

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

gcc/ada/

	* exp_put_image.ads, exp_put_image.adb (Preload_Sink): Procedure
	for preloading type Sink.  This has the side effect of loading
	various dependents, including Ada.Strings.UTF_Encoding.
	(Enable_Put_Image): Disable Put_Image in pre-2020 versions of
	Ada.  This limitation can probably be lifted later.  Enable for
	tagged types except in predefined units.  Disable for CPP types;
	Put_Image is legal, just prints the type name.
	* sem_attr.adb (Check_Put_Image_Attribute): Don't complain about
	Put_Image of CPP types; instead call the "unknown" version of
	Put_Image.
	* sem_ch10.adb (Analyze_Compilation_Unit): Call Preload_Sink.

diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb
index c8119c73d422c97867b5424a109f330d0030c0ca..286640d2552c6aca1eb480d6de2fd502614d3831 100644 (file)
--- a/gcc/ada/exp_put_image.adb
+++ b/gcc/ada/exp_put_image.adb
@@ -31,6 +31,7 @@ with Lib;      use Lib;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
+with Opt;      use Opt;
 with Rtsfind;  use Rtsfind;
 with Sem_Aux;  use Sem_Aux;
 with Sem_Util; use Sem_Util;
@@ -815,6 +816,12 @@ package body Exp_Put_Image is
 
    function Enable_Put_Image (Typ : Entity_Id) return Boolean is
    begin
+      --  Disable in pre-2020 versions for now???
+
+      if Ada_Version < Ada_2020 then
+         return False;
+      end if;
+
       --  There's a bit of a chicken&egg problem. The compiler is likely to
       --  have trouble if we refer to the Put_Image of Sink itself, because
       --  Sink is part of the parameter profile:
@@ -841,7 +848,7 @@ package body Exp_Put_Image is
       --  Put_Image doesn't work for private types whose full type is real.
 
       if Is_Remote_Types (Scope (Typ))
-        or else Is_Tagged_Type (Typ)
+        or else (Is_Tagged_Type (Typ) and then In_Predefined_Unit (Typ))
         or else Is_Real_Type (Typ)
       then
          return False;
@@ -864,6 +871,16 @@ package body Exp_Put_Image is
          end if;
       end;
 
+      --  Disable for CPP types, because the components are unavailable on the
+      --  Ada side.
+
+      if Is_Tagged_Type (Typ)
+        and then Convention (Typ) = Convention_CPP
+        and then Is_CPP_Class (Root_Type (Typ))
+      then
+         return False;
+      end if;
+
       return Is_Scalar_Type (Typ) or else not In_Predefined_Unit (Typ);
    end Enable_Put_Image;
 
@@ -890,9 +907,24 @@ package body Exp_Put_Image is
       return Make_Defining_Identifier (Loc, Sname);
    end Make_Put_Image_Name;
 
-   ----------------------
+   ------------------
+   -- Preload_Sink --
+   ------------------
+
+   procedure Preload_Sink is
+   begin
+      if RTE_Available (RE_Sink) then
+         declare
+            Ignore : constant Entity_Id := RTE (RE_Sink);
+         begin
+            null;
+         end;
+      end if;
+   end Preload_Sink;
+
+   -------------------------
    -- Put_Image_Base_Type --
-   ----------------------
+   -------------------------
 
    function Put_Image_Base_Type (E : Entity_Id) return Entity_Id is
    begin

diff --git a/gcc/ada/exp_put_image.ads b/gcc/ada/exp_put_image.ads
index 82c1c59a78205a8d8f717a28c832c3ed3614af16..6b5f6b05dd18e0e467f9edb236bafd4c965e7032 100644 (file)
--- a/gcc/ada/exp_put_image.ads
+++ b/gcc/ada/exp_put_image.ads
@@ -85,4 +85,10 @@ package Exp_Put_Image is
    function Build_Unknown_Put_Image_Call (N : Node_Id) return Node_Id;
    --  Build a call to Put_Image_Unknown
 
+   procedure Preload_Sink;
+   --  Call RTE (RE_Sink), to load the packages involved in Put_Image. We
+   --  need to do this explicitly, fairly early during compilation, because
+   --  otherwise it happens during freezing, which triggers visibility bugs
+   --  in generic instantiations.
+
 end Exp_Put_Image;

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index e802620e1541440112a2306aa8a0bc5fbe9e5eac..ce57b308025380a35b172d00c7ce92f6207c7feb 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -2359,7 +2359,6 @@ package body Sem_Attr is
 
          Analyze (E2);
          Resolve (E2, P_Type);
-         Check_Not_CPP_Type;
       end Check_Put_Image_Attribute;
 
       ----------------------------

diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 33ffbf9e6352d0bc5e28686b70e021d0410206ce..a4de98bade558fb668832026393755486c87ffc6 100644 (file)
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -29,6 +29,7 @@ with Contracts; use Contracts;
 with Debug;     use Debug;
 with Einfo;     use Einfo;
 with Errout;    use Errout;
+with Exp_Put_Image;
 with Exp_Util;  use Exp_Util;
 with Elists;    use Elists;
 with Fname;     use Fname;
@@ -621,6 +622,17 @@ package body Sem_Ch10 is
    --  Start of processing for Analyze_Compilation_Unit
 
    begin
+      --  We can't call Preload_Sink for at least some predefined units,
+      --  because it would introduce cyclic dependences. The package where Sink
+      --  is declared, for example, and things it depends on. See Exp_Put_Image
+      --  for documentation. We don't call Preload_Sink in pre-2020 Ada
+      --  versions, because the default Put_Image is disabled in those
+      --  versions, at least for now.
+
+      if Ada_Version >= Ada_2020 and then not In_Predefined_Unit (N) then
+         Exp_Put_Image.Preload_Sink;
+      end if;
+
       Process_Compilation_Unit_Pragmas (N);
 
       --  If the unit is a subunit whose parent has not been analyzed (which