From: Bob Duff Date: Fri, 12 Jun 2020 22:24:52 +0000 (-0400) Subject: [Ada] Ada2020: AI12-0304 Put_Image attrs of lang-def types X-Git-Tag: basepoints/gcc-12~5918 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=1e29b5465e4d8dc30cea2ff2677294fbcecd0f21;p=thirdparty%2Fgcc.git [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 d550a1d2cced..9bcf522e8918 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 c4d1406383ea..c2a0a834c4e5 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 7b2e1760834f..a12e4568b565 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 1b214bf87228..20991c390e51 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 da6293004f18..d4e4410b35ab 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 baf5cbe97cbf..01a6e91bd82a 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 ed2d35e0742f..1851b692dac0 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