Implement Put_Image for the random number packages and for
Ada.Containers.Vectors. More to come.
Tested on x86_64-pc-linux-gnu, committed on trunk
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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
