aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBob Duff <duff@adacore.com>2020-06-12 18:24:52 -0400
committerPierre-Marie de Rodat <derodat@adacore.com>2020-07-27 04:05:15 -0400
commit1e29b5465e4d8dc30cea2ff2677294fbcecd0f21 (patch)
tree40a3eff789d5be98873ae445f04bcc19a828f6b7
parent7f5c0f328eced560a204bb8e3eae0d45795dd235 (diff)
downloadgcc-1e29b5465e4d8dc30cea2ff2677294fbcecd0f21.zip
gcc-1e29b5465e4d8dc30cea2ff2677294fbcecd0f21.tar.gz
gcc-1e29b5465e4d8dc30cea2ff2677294fbcecd0f21.tar.bz2
[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.
-rw-r--r--gcc/ada/exp_put_image.adb10
-rw-r--r--gcc/ada/libgnat/a-convec.adb26
-rw-r--r--gcc/ada/libgnat/a-convec.ads6
-rw-r--r--gcc/ada/libgnat/s-putima.adb3
-rw-r--r--gcc/ada/libgnat/s-putima.ads2
-rw-r--r--gcc/ada/libgnat/s-rannum.adb11
-rw-r--r--gcc/ada/libgnat/s-rannum.ads7
7 files changed, 57 insertions, 8 deletions
diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb
index d550a1d..9bcf522 100644
--- 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 c4d1406..c2a0a83 100644
--- 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 7b2e176..a12e456 100644
--- 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 1b214bf..20991c3 100644
--- 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 da62930..d4e4410 100644
--- 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 baf5cbe..01a6e91 100644
--- 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 ed2d35e..1851b69 100644
--- 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