[Ada] Ada2020: AI12-0304 Put_Image attrs of lang-def types

gcc/ada/

	* libgnat/s-rannum.ads, libgnat/s-rannum.adb: Add Put_Image.
	This will be inherited by the language-defined packages
	Ada.Numerics.Discrete_Random and Ada.Numerics.Float_Random.
	* libgnat/a-convec.ads, libgnat/a-convec.adb: Add Put_Image.
	* libgnat/s-putima.ads: Add pragma Preelaborate, so this can be
	imported into containers packages.
	* libgnat/s-putima.adb: Move Digit to private part; otherwise
	reference to Base is illegal in Preelaborate generic.
	* exp_put_image.adb (Build_Record_Put_Image_Procedure): Use the
	base type.

diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb
index d550a1d2ccedf2bdbfd94df2d04219acfba9c1cb..9bcf522e891815ad3e93b5bce7b20ca28ed57ee5 100644 (file)
--- a/gcc/ada/exp_put_image.adb
+++ b/gcc/ada/exp_put_image.adb
@@ -520,8 +520,8 @@ package body Exp_Put_Image is
       Decl : out Node_Id;
       Pnam : out Entity_Id)
    is
-      pragma Assert (Typ = Base_Type (Typ));
-      pragma Assert (not Is_Unchecked_Union (Typ));
+      Btyp : constant Entity_Id := Base_Type (Typ);
+      pragma Assert (not Is_Unchecked_Union (Btyp));
 
       First_Time : Boolean := True;
 
@@ -694,7 +694,7 @@ package body Exp_Put_Image is
       Stms : constant List_Id := New_List;
       Rdef : Node_Id;
       Type_Decl : constant Node_Id :=
-        Declaration_Node (Base_Type (Underlying_Type (Typ)));
+        Declaration_Node (Base_Type (Underlying_Type (Btyp)));
 
    --  Start of processing for Build_Record_Put_Image_Procedure
 
@@ -732,8 +732,8 @@ package body Exp_Put_Image is
           Parameter_Associations => New_List
             (Make_Identifier (Loc, Name_S))));
 
-      Pnam := Make_Put_Image_Name (Loc, Typ);
-      Build_Put_Image_Proc (Loc, Typ, Decl, Pnam, Stms);
+      Pnam := Make_Put_Image_Name (Loc, Btyp);
+      Build_Put_Image_Proc (Loc, Btyp, Decl, Pnam, Stms);
    end Build_Record_Put_Image_Procedure;
 
    -------------------------------

diff --git a/gcc/ada/libgnat/a-convec.adb b/gcc/ada/libgnat/a-convec.adb
index c4d1406383ea4707c65dd830b10071294825235e..c2a0a834c4e52aab9ccd37d8c7d5ce816837e50b 100644 (file)
--- a/gcc/ada/libgnat/a-convec.adb
+++ b/gcc/ada/libgnat/a-convec.adb
@@ -31,6 +31,7 @@ with Ada.Containers.Generic_Array_Sort;
 with Ada.Unchecked_Deallocation;
 
 with System; use type System.Address;
+with System.Put_Images;
 
 package body Ada.Containers.Vectors with
   SPARK_Mode => Off
@@ -2299,6 +2300,31 @@ is
       end return;
    end Pseudo_Reference;
 
+   ---------------
+   -- Put_Image --
+   ---------------
+
+   procedure Put_Image
+     (S : in out Ada.Strings.Text_Output.Sink'Class; V : Vector)
+   is
+      First_Time : Boolean := True;
+      use System.Put_Images;
+   begin
+      Array_Before (S);
+
+      for X of V loop
+         if First_Time then
+            First_Time := False;
+         else
+            Simple_Array_Between (S);
+         end if;
+
+         Element_Type'Put_Image (S, X);
+      end loop;
+
+      Array_After (S);
+   end Put_Image;
+
    -------------------
    -- Query_Element --
    -------------------

diff --git a/gcc/ada/libgnat/a-convec.ads b/gcc/ada/libgnat/a-convec.ads
index 7b2e1760834f0345b843c4a2efc4a36f8f005036..a12e4568b5655a96c95cf36346cc76cf3a928cbb 100644 (file)
--- a/gcc/ada/libgnat/a-convec.ads
+++ b/gcc/ada/libgnat/a-convec.ads
@@ -36,6 +36,7 @@ with Ada.Iterator_Interfaces;
 with Ada.Containers.Helpers;
 private with Ada.Finalization;
 private with Ada.Streams;
+private with Ada.Strings.Text_Output;
 
 --  The language-defined generic package Containers.Vectors provides private
 --  types Vector and Cursor, and a set of operations for each type. A vector
@@ -696,7 +697,10 @@ private
       Elements : Elements_Access := null;
       Last     : Extended_Index := No_Index;
       TC       : aliased Tamper_Counts;
-   end record;
+   end record with Put_Image => Put_Image;
+
+   procedure Put_Image
+     (S : in out Ada.Strings.Text_Output.Sink'Class; V : Vector);
 
    overriding procedure Adjust (Container : in out Vector);
    overriding procedure Finalize (Container : in out Vector);

diff --git a/gcc/ada/libgnat/s-putima.adb b/gcc/ada/libgnat/s-putima.adb
index 1b214bf872287e5dd75380522733259467c69556..20991c390e51a998a424ff2a37cf740a0af5f391 100644 (file)
--- a/gcc/ada/libgnat/s-putima.adb
+++ b/gcc/ada/libgnat/s-putima.adb
@@ -46,13 +46,14 @@ package body System.Put_Images is
       pragma Assert (Base in 2 .. 36);
       procedure Put_Image (S : in out Sink'Class; X : Integer_Type);
       procedure Put_Image (S : in out Sink'Class; X : Unsigned_Type);
+   private
+      subtype Digit is Unsigned_Type range 0 .. Base - 1;
    end Generic_Integer_Images;
 
    package body Generic_Integer_Images is
 
       A : constant := Character'Pos ('a');
       Z : constant := Character'Pos ('0');
-      subtype Digit is Unsigned_Type range 0 .. Base - 1;
       function Digit_To_Character (X : Digit) return Character is
         (Character'Val (if X < 10 then X + Z else X + A - 10));
 

diff --git a/gcc/ada/libgnat/s-putima.ads b/gcc/ada/libgnat/s-putima.ads
index da6293004f1845a9af7fe2fc1e61aee62003ef00..d4e4410b35ab8485ddf7d84a39a58088539301f9 100644 (file)
--- a/gcc/ada/libgnat/s-putima.ads
+++ b/gcc/ada/libgnat/s-putima.ads
@@ -47,6 +47,8 @@ package System.Put_Images is
    --  after them. See Exp_Put_Image in the compiler for details of these
    --  calls.
 
+   pragma Preelaborate;
+
    subtype Sink is Ada.Strings.Text_Output.Sink;
 
    procedure Put_Image_Integer (S : in out Sink'Class; X : Integer);

diff --git a/gcc/ada/libgnat/s-rannum.adb b/gcc/ada/libgnat/s-rannum.adb
index baf5cbe97cbf72dc50ea2a256af04534f9fbb4d5..01a6e91bd82a79b287880f0e411a1a0a22079b5b 100644 (file)
--- a/gcc/ada/libgnat/s-rannum.adb
+++ b/gcc/ada/libgnat/s-rannum.adb
@@ -86,6 +86,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Ada.Strings.Text_Output.Utils;
 with Ada.Unchecked_Conversion;
 
 with System.Random_Seed;
@@ -639,6 +640,16 @@ is
       return Result;
    end Image;
 
+   ---------------
+   -- Put_Image --
+   ---------------
+
+   procedure Put_Image
+     (S : in out Strings.Text_Output.Sink'Class; V : State) is
+   begin
+      Strings.Text_Output.Utils.Put_String (S, Image (V));
+   end Put_Image;
+
    -----------
    -- Value --
    -----------

diff --git a/gcc/ada/libgnat/s-rannum.ads b/gcc/ada/libgnat/s-rannum.ads
index ed2d35e0742f722f4c85ec973959bef583d43d17..1851b692dac098a0d1cfb68be3e92423ac71f911 100644 (file)
--- a/gcc/ada/libgnat/s-rannum.ads
+++ b/gcc/ada/libgnat/s-rannum.ads
@@ -57,6 +57,8 @@
 
 with Interfaces;
 
+private with Ada.Strings.Text_Output;
+
 package System.Random_Numbers with
   SPARK_Mode => Off
 is
@@ -142,7 +144,10 @@ private
    --  Feedback distance from the current position
 
    subtype State_Val is Interfaces.Unsigned_32;
-   type State is array (0 .. N - 1) of State_Val;
+   type State is array (0 .. N - 1) of State_Val with Put_Image => Put_Image;
+
+   procedure Put_Image
+     (S : in out Ada.Strings.Text_Output.Sink'Class; V : State);
 
    type Writable_Access (Self : access Generator) is limited null record;
    --  Auxiliary type to make Generator a self-referential type