From 26349b6d9a4c03cb22104eb1da30362ece3addc5 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Thu, 2 Jul 2020 13:32:40 -0400 Subject: [PATCH] [Ada] Ada2020: AI12-0304 Put_Image attrs of lang-def types gcc/ada/ * exp_put_image.adb (Build_Elementary_Put_Image_Call): Use the base type to recognize various cases of access types. * libgnat/a-cbdlli.adb, libgnat/a-cbdlli.ads, libgnat/a-cbhama.adb, libgnat/a-cbhama.ads, libgnat/a-cbhase.adb, libgnat/a-cbhase.ads, libgnat/a-cbmutr.adb, libgnat/a-cbmutr.ads, libgnat/a-cborma.adb, libgnat/a-cborma.ads, libgnat/a-cborse.adb, libgnat/a-cborse.ads, libgnat/a-cdlili.adb, libgnat/a-cdlili.ads, libgnat/a-cidlli.adb, libgnat/a-cidlli.ads, libgnat/a-cihama.adb, libgnat/a-cihama.ads, libgnat/a-cihase.adb, libgnat/a-cihase.ads, libgnat/a-cimutr.adb, libgnat/a-cimutr.ads, libgnat/a-ciorma.adb, libgnat/a-ciorma.ads, libgnat/a-ciormu.adb, libgnat/a-ciormu.ads, libgnat/a-ciorse.adb, libgnat/a-ciorse.ads, libgnat/a-coboho.adb, libgnat/a-coboho.ads, libgnat/a-cobove.adb, libgnat/a-cobove.ads, libgnat/a-cohama.adb, libgnat/a-cohama.ads, libgnat/a-cohase.adb, libgnat/a-cohase.ads, libgnat/a-coinho.adb, libgnat/a-coinho.ads, libgnat/a-coinho__shared.adb, libgnat/a-coinho__shared.ads, libgnat/a-coinve.adb, libgnat/a-coinve.ads, libgnat/a-comutr.adb, libgnat/a-comutr.ads, libgnat/a-coorma.adb, libgnat/a-coorma.ads, libgnat/a-coormu.adb, libgnat/a-coormu.ads, libgnat/a-coorse.adb, libgnat/a-coorse.ads, libgnat/a-strunb.adb, libgnat/a-strunb.ads, libgnat/a-strunb__shared.adb, libgnat/a-strunb__shared.ads: Implement Put_Image attibute. * libgnat/a-stteou.ads, libgnat/s-putima.ads, libgnat/a-stouut.ads, libgnat/a-stoubu.adb: Make Ada.Strings.Text_Output, Ada.Strings.Text_Output.Utils, and System.Put_Images Pure, so they can be with'ed by Pure units that should have Put_Image defined. * libgnat/a-stouut.adb: Add missing column adjustments, and remove a redundant one. * libgnat/s-putima.adb (Put_Arrow): New routine to print an arrow. Avoids adding a with clause to some containers. --- gcc/ada/exp_put_image.adb | 4 +-- gcc/ada/libgnat/a-cbdlli.adb | 26 ++++++++++++++++ gcc/ada/libgnat/a-cbdlli.ads | 6 +++- gcc/ada/libgnat/a-cbhama.adb | 31 ++++++++++++++++++++ gcc/ada/libgnat/a-cbhama.ads | 7 ++++- gcc/ada/libgnat/a-cbhase.adb | 26 ++++++++++++++++ gcc/ada/libgnat/a-cbhase.ads | 7 ++++- gcc/ada/libgnat/a-cbmutr.adb | 44 ++++++++++++++++++++++++++++ gcc/ada/libgnat/a-cbmutr.ads | 6 +++- gcc/ada/libgnat/a-cborma.adb | 31 ++++++++++++++++++++ gcc/ada/libgnat/a-cborma.ads | 7 ++++- gcc/ada/libgnat/a-cborse.adb | 26 ++++++++++++++++ gcc/ada/libgnat/a-cborse.ads | 7 ++++- gcc/ada/libgnat/a-cdlili.adb | 26 ++++++++++++++++ gcc/ada/libgnat/a-cdlili.ads | 6 +++- gcc/ada/libgnat/a-cidlli.adb | 26 ++++++++++++++++ gcc/ada/libgnat/a-cidlli.ads | 6 +++- gcc/ada/libgnat/a-cihama.adb | 31 ++++++++++++++++++++ gcc/ada/libgnat/a-cihama.ads | 6 +++- gcc/ada/libgnat/a-cihase.adb | 26 ++++++++++++++++ gcc/ada/libgnat/a-cihase.ads | 6 +++- gcc/ada/libgnat/a-cimutr.adb | 44 ++++++++++++++++++++++++++++ gcc/ada/libgnat/a-cimutr.ads | 6 +++- gcc/ada/libgnat/a-ciorma.adb | 31 ++++++++++++++++++++ gcc/ada/libgnat/a-ciorma.ads | 6 +++- gcc/ada/libgnat/a-ciormu.adb | 26 ++++++++++++++++ gcc/ada/libgnat/a-ciormu.ads | 6 +++- gcc/ada/libgnat/a-ciorse.adb | 26 ++++++++++++++++ gcc/ada/libgnat/a-ciorse.ads | 6 +++- gcc/ada/libgnat/a-coboho.adb | 15 ++++++++++ gcc/ada/libgnat/a-coboho.ads | 6 +++- gcc/ada/libgnat/a-cobove.adb | 26 ++++++++++++++++ gcc/ada/libgnat/a-cobove.ads | 6 +++- gcc/ada/libgnat/a-cohama.adb | 31 ++++++++++++++++++++ gcc/ada/libgnat/a-cohama.ads | 6 +++- gcc/ada/libgnat/a-cohase.adb | 26 ++++++++++++++++ gcc/ada/libgnat/a-cohase.ads | 6 +++- gcc/ada/libgnat/a-coinho.adb | 17 +++++++++++ gcc/ada/libgnat/a-coinho.ads | 7 ++++- gcc/ada/libgnat/a-coinho__shared.adb | 17 +++++++++++ gcc/ada/libgnat/a-coinho__shared.ads | 7 ++++- gcc/ada/libgnat/a-coinve.adb | 26 ++++++++++++++++ gcc/ada/libgnat/a-coinve.ads | 6 +++- gcc/ada/libgnat/a-comutr.adb | 44 ++++++++++++++++++++++++++++ gcc/ada/libgnat/a-comutr.ads | 6 +++- gcc/ada/libgnat/a-coorma.adb | 31 ++++++++++++++++++++ gcc/ada/libgnat/a-coorma.ads | 6 +++- gcc/ada/libgnat/a-coormu.adb | 26 ++++++++++++++++ gcc/ada/libgnat/a-coormu.ads | 6 +++- gcc/ada/libgnat/a-coorse.adb | 26 ++++++++++++++++ gcc/ada/libgnat/a-coorse.ads | 6 +++- gcc/ada/libgnat/a-stoubu.adb | 16 ++++++++-- gcc/ada/libgnat/a-stouut.adb | 3 +- gcc/ada/libgnat/a-stouut.ads | 5 ++-- gcc/ada/libgnat/a-strunb.adb | 10 +++++++ gcc/ada/libgnat/a-strunb.ads | 7 ++++- gcc/ada/libgnat/a-strunb__shared.adb | 10 +++++++ gcc/ada/libgnat/a-strunb__shared.ads | 6 +++- gcc/ada/libgnat/a-stteou.ads | 12 ++++---- gcc/ada/libgnat/s-putima.adb | 5 ++++ gcc/ada/libgnat/s-putima.ads | 8 +++-- 61 files changed, 904 insertions(+), 43 deletions(-) diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb index 80b49a70cce..1933bd0597b 100644 --- a/gcc/ada/exp_put_image.adb +++ b/gcc/ada/exp_put_image.adb @@ -314,9 +314,9 @@ package body Exp_Put_Image is end if; elsif Is_Access_Type (U_Type) then - if Is_Access_Protected_Subprogram_Type (U_Type) then + if Is_Access_Protected_Subprogram_Type (Base_Type (U_Type)) then Lib_RE := RE_Put_Image_Access_Prot_Subp; - elsif Is_Access_Subprogram_Type (U_Type) then + elsif Is_Access_Subprogram_Type (Base_Type (U_Type)) then Lib_RE := RE_Put_Image_Access_Subp; elsif P_Size = System_Address_Size then Lib_RE := RE_Put_Image_Thin_Pointer; diff --git a/gcc/ada/libgnat/a-cbdlli.adb b/gcc/ada/libgnat/a-cbdlli.adb index 8f40d6c0b8d..fa8174b5c3f 100644 --- a/gcc/ada/libgnat/a-cbdlli.adb +++ b/gcc/ada/libgnat/a-cbdlli.adb @@ -28,6 +28,7 @@ ------------------------------------------------------------------------------ with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Bounded_Doubly_Linked_Lists with SPARK_Mode => Off @@ -1491,6 +1492,31 @@ is end; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : List) + 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; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-cbdlli.ads b/gcc/ada/libgnat/a-cbdlli.ads index 62624f34e07..7f16368a599 100644 --- a/gcc/ada/libgnat/a-cbdlli.ads +++ b/gcc/ada/libgnat/a-cbdlli.ads @@ -36,6 +36,7 @@ with Ada.Iterator_Interfaces; with Ada.Containers.Helpers; private with Ada.Streams; private with Ada.Finalization; +private with Ada.Strings.Text_Output; generic type Element_Type is private; @@ -279,7 +280,10 @@ private Last : Count_Type := 0; Length : Count_Type := 0; 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 : List); procedure Read (Stream : not null access Root_Stream_Type'Class; diff --git a/gcc/ada/libgnat/a-cbhama.adb b/gcc/ada/libgnat/a-cbhama.adb index 1881db212bc..b2137c1619b 100644 --- a/gcc/ada/libgnat/a-cbhama.adb +++ b/gcc/ada/libgnat/a-cbhama.adb @@ -38,6 +38,7 @@ with Ada.Containers.Helpers; use Ada.Containers.Helpers; with Ada.Containers.Prime_Numbers; use Ada.Containers.Prime_Numbers; with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Bounded_Hashed_Maps with SPARK_Mode => Off @@ -885,6 +886,36 @@ is end; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map) + is + First_Time : Boolean := True; + use System.Put_Images; + + procedure Put_Key_Value (Position : Cursor); + procedure Put_Key_Value (Position : Cursor) is + begin + if First_Time then + First_Time := False; + else + Simple_Array_Between (S); + end if; + + Key_Type'Put_Image (S, Key (Position)); + Put_Arrow (S); + Element_Type'Put_Image (S, Element (Position)); + end Put_Key_Value; + + begin + Array_Before (S); + Iterate (V, Put_Key_Value'Access); + Array_After (S); + end Put_Image; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-cbhama.ads b/gcc/ada/libgnat/a-cbhama.ads index d1225e090a3..9a1aee97c4f 100644 --- a/gcc/ada/libgnat/a-cbhama.ads +++ b/gcc/ada/libgnat/a-cbhama.ads @@ -36,6 +36,7 @@ with Ada.Iterator_Interfaces; private with Ada.Containers.Hash_Tables; private with Ada.Streams; private with Ada.Finalization; +private with Ada.Strings.Text_Output; generic type Key_Type is private; @@ -342,7 +343,11 @@ private new Hash_Tables.Generic_Bounded_Hash_Table_Types (Node_Type); type Map (Capacity : Count_Type; Modulus : Hash_Type) is - new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record; + new HT_Types.Hash_Table_Type (Capacity, Modulus) + with null record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map); use HT_Types, HT_Types.Implementation; use Ada.Streams; diff --git a/gcc/ada/libgnat/a-cbhase.adb b/gcc/ada/libgnat/a-cbhase.adb index 09505535e5e..db61f77f1cd 100644 --- a/gcc/ada/libgnat/a-cbhase.adb +++ b/gcc/ada/libgnat/a-cbhase.adb @@ -38,6 +38,7 @@ with Ada.Containers.Helpers; use Ada.Containers.Helpers; with Ada.Containers.Prime_Numbers; use Ada.Containers.Prime_Numbers; with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Bounded_Hashed_Sets with SPARK_Mode => Off @@ -1108,6 +1109,31 @@ is end; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set) + 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; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-cbhase.ads b/gcc/ada/libgnat/a-cbhase.ads index 2d8a7ee56f6..70a311931d5 100644 --- a/gcc/ada/libgnat/a-cbhase.ads +++ b/gcc/ada/libgnat/a-cbhase.ads @@ -37,6 +37,7 @@ private with Ada.Containers.Hash_Tables; with Ada.Containers.Helpers; private with Ada.Streams; private with Ada.Finalization; +private with Ada.Strings.Text_Output; generic type Element_Type is private; @@ -500,7 +501,11 @@ private new Hash_Tables.Generic_Bounded_Hash_Table_Types (Node_Type); type Set (Capacity : Count_Type; Modulus : Hash_Type) is - new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record; + new HT_Types.Hash_Table_Type (Capacity, Modulus) + with null record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set); use HT_Types, HT_Types.Implementation; use Ada.Streams; diff --git a/gcc/ada/libgnat/a-cbmutr.adb b/gcc/ada/libgnat/a-cbmutr.adb index 58db8cf4471..3b25d20ebb5 100644 --- a/gcc/ada/libgnat/a-cbmutr.adb +++ b/gcc/ada/libgnat/a-cbmutr.adb @@ -29,6 +29,7 @@ with Ada.Finalization; with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Bounded_Multiway_Trees with SPARK_Mode => Off @@ -2322,6 +2323,49 @@ is end; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Tree) + is + use System.Put_Images; + + procedure Rec (Position : Cursor); + -- Recursive routine operating on cursors + + procedure Rec (Position : Cursor) is + First_Time : Boolean := True; + begin + Array_Before (S); + + for X in Iterate_Children (V, Position) loop + if First_Time then + First_Time := False; + else + Array_Between (S); + end if; + + Element_Type'Put_Image (S, Element (X)); + if Child_Count (X) > 0 then + Simple_Array_Between (S); + Rec (X); + end if; + end loop; + + Array_After (S); + end Rec; + + begin + if First_Child (Root (V)) = No_Element then + Array_Before (S); + Array_After (S); + else + Rec (First_Child (Root (V))); + end if; + end Put_Image; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-cbmutr.ads b/gcc/ada/libgnat/a-cbmutr.ads index 653407bfcdc..82b3d60c977 100644 --- a/gcc/ada/libgnat/a-cbmutr.ads +++ b/gcc/ada/libgnat/a-cbmutr.ads @@ -35,6 +35,7 @@ with Ada.Iterator_Interfaces; with Ada.Containers.Helpers; private with Ada.Streams; +private with Ada.Strings.Text_Output; generic type Element_Type is private; @@ -307,7 +308,10 @@ private Free : Count_Type'Base := No_Node; TC : aliased Tamper_Counts; Count : Count_Type := 0; - end record; + end record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Tree); procedure Write (Stream : not null access Root_Stream_Type'Class; diff --git a/gcc/ada/libgnat/a-cborma.adb b/gcc/ada/libgnat/a-cborma.adb index 6f59471cb7c..23e21dac073 100644 --- a/gcc/ada/libgnat/a-cborma.adb +++ b/gcc/ada/libgnat/a-cborma.adb @@ -38,6 +38,7 @@ pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Bounded_Keys); with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Bounded_Ordered_Maps with SPARK_Mode => Off @@ -1289,6 +1290,36 @@ is end; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map) + is + First_Time : Boolean := True; + use System.Put_Images; + + procedure Put_Key_Value (Position : Cursor); + procedure Put_Key_Value (Position : Cursor) is + begin + if First_Time then + First_Time := False; + else + Simple_Array_Between (S); + end if; + + Key_Type'Put_Image (S, Key (Position)); + Put_Arrow (S); + Element_Type'Put_Image (S, Element (Position)); + end Put_Key_Value; + + begin + Array_Before (S); + Iterate (V, Put_Key_Value'Access); + Array_After (S); + end Put_Image; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-cborma.ads b/gcc/ada/libgnat/a-cborma.ads index 6dac0504e9c..b10b0d05edb 100644 --- a/gcc/ada/libgnat/a-cborma.ads +++ b/gcc/ada/libgnat/a-cborma.ads @@ -36,6 +36,7 @@ with Ada.Iterator_Interfaces; private with Ada.Containers.Red_Black_Trees; private with Ada.Streams; private with Ada.Finalization; +private with Ada.Strings.Text_Output; generic type Key_Type is private; @@ -250,7 +251,11 @@ private new Red_Black_Trees.Generic_Bounded_Tree_Types (Node_Type); type Map (Capacity : Count_Type) is - new Tree_Types.Tree_Type (Capacity) with null record; + new Tree_Types.Tree_Type (Capacity) + with null record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map); use Red_Black_Trees; use Tree_Types, Tree_Types.Implementation; diff --git a/gcc/ada/libgnat/a-cborse.adb b/gcc/ada/libgnat/a-cborse.adb index af4f87f157d..2daad8e17da 100644 --- a/gcc/ada/libgnat/a-cborse.adb +++ b/gcc/ada/libgnat/a-cborse.adb @@ -41,6 +41,7 @@ pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Bounded_Set_Operations); with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Bounded_Ordered_Sets with SPARK_Mode => Off @@ -1628,6 +1629,31 @@ is end; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set) + 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; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-cborse.ads b/gcc/ada/libgnat/a-cborse.ads index 1b711c41370..90e68e3c4d0 100644 --- a/gcc/ada/libgnat/a-cborse.ads +++ b/gcc/ada/libgnat/a-cborse.ads @@ -37,6 +37,7 @@ with Ada.Containers.Helpers; private with Ada.Containers.Red_Black_Trees; private with Ada.Streams; private with Ada.Finalization; +private with Ada.Strings.Text_Output; generic type Element_Type is private; @@ -338,7 +339,11 @@ private new Red_Black_Trees.Generic_Bounded_Tree_Types (Node_Type); type Set (Capacity : Count_Type) is - new Tree_Types.Tree_Type (Capacity) with null record; + new Tree_Types.Tree_Type (Capacity) + with null record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set); use Tree_Types, Tree_Types.Implementation; use Ada.Finalization; diff --git a/gcc/ada/libgnat/a-cdlili.adb b/gcc/ada/libgnat/a-cdlili.adb index 0e25418368b..f07190ec2f4 100644 --- a/gcc/ada/libgnat/a-cdlili.adb +++ b/gcc/ada/libgnat/a-cdlili.adb @@ -30,6 +30,7 @@ with Ada.Unchecked_Deallocation; with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Doubly_Linked_Lists with SPARK_Mode => Off @@ -1267,6 +1268,31 @@ is end; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : List) + 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; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-cdlili.ads b/gcc/ada/libgnat/a-cdlili.ads index 6d369c06652..dc525649619 100644 --- a/gcc/ada/libgnat/a-cdlili.ads +++ b/gcc/ada/libgnat/a-cdlili.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; generic type Element_Type is private; @@ -281,7 +282,10 @@ private Last : Node_Access := null; Length : Count_Type := 0; 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 : List); overriding procedure Adjust (Container : in out List); diff --git a/gcc/ada/libgnat/a-cidlli.adb b/gcc/ada/libgnat/a-cidlli.adb index 0898db8c401..ea962c32cf6 100644 --- a/gcc/ada/libgnat/a-cidlli.adb +++ b/gcc/ada/libgnat/a-cidlli.adb @@ -30,6 +30,7 @@ with Ada.Unchecked_Deallocation; with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Indefinite_Doubly_Linked_Lists with SPARK_Mode => Off @@ -1297,6 +1298,31 @@ is end; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : List) + 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; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-cidlli.ads b/gcc/ada/libgnat/a-cidlli.ads index e9220a6e257..fe9c7e10471 100644 --- a/gcc/ada/libgnat/a-cidlli.ads +++ b/gcc/ada/libgnat/a-cidlli.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; generic type Element_Type (<>) is private; @@ -269,7 +270,10 @@ private Last : Node_Access := null; Length : Count_Type := 0; 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 : List); overriding procedure Adjust (Container : in out List); diff --git a/gcc/ada/libgnat/a-cihama.adb b/gcc/ada/libgnat/a-cihama.adb index 9f5aed7b02b..2b4499c6eb5 100644 --- a/gcc/ada/libgnat/a-cihama.adb +++ b/gcc/ada/libgnat/a-cihama.adb @@ -38,6 +38,7 @@ with Ada.Containers.Helpers; use Ada.Containers.Helpers; with Ada.Unchecked_Deallocation; with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Indefinite_Hashed_Maps with SPARK_Mode => Off @@ -952,6 +953,36 @@ is end; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map) + is + First_Time : Boolean := True; + use System.Put_Images; + + procedure Put_Key_Value (Position : Cursor); + procedure Put_Key_Value (Position : Cursor) is + begin + if First_Time then + First_Time := False; + else + Simple_Array_Between (S); + end if; + + Key_Type'Put_Image (S, Key (Position)); + Put_Arrow (S); + Element_Type'Put_Image (S, Element (Position)); + end Put_Key_Value; + + begin + Array_Before (S); + Iterate (V, Put_Key_Value'Access); + Array_After (S); + end Put_Image; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-cihama.ads b/gcc/ada/libgnat/a-cihama.ads index d29cbb402f7..f92331415d2 100644 --- a/gcc/ada/libgnat/a-cihama.ads +++ b/gcc/ada/libgnat/a-cihama.ads @@ -36,6 +36,7 @@ with Ada.Iterator_Interfaces; private with Ada.Containers.Hash_Tables; private with Ada.Finalization; private with Ada.Streams; +private with Ada.Strings.Text_Output; generic type Key_Type (<>) is private; @@ -330,7 +331,10 @@ private type Map is new Ada.Finalization.Controlled with record HT : HT_Types.Hash_Table_Type; - end record; + end record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map); overriding procedure Adjust (Container : in out Map); diff --git a/gcc/ada/libgnat/a-cihase.adb b/gcc/ada/libgnat/a-cihase.adb index b91532dc974..dc0cfed58f8 100644 --- a/gcc/ada/libgnat/a-cihase.adb +++ b/gcc/ada/libgnat/a-cihase.adb @@ -40,6 +40,7 @@ with Ada.Containers.Helpers; use Ada.Containers.Helpers; with Ada.Containers.Prime_Numbers; with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Indefinite_Hashed_Sets with SPARK_Mode => Off @@ -1264,6 +1265,31 @@ is end; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set) + 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; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-cihase.ads b/gcc/ada/libgnat/a-cihase.ads index 8af0b7d19e0..965071cc39d 100644 --- a/gcc/ada/libgnat/a-cihase.ads +++ b/gcc/ada/libgnat/a-cihase.ads @@ -37,6 +37,7 @@ private with Ada.Containers.Hash_Tables; with Ada.Containers.Helpers; private with Ada.Streams; private with Ada.Finalization; +private with Ada.Strings.Text_Output; generic type Element_Type (<>) is private; @@ -494,7 +495,10 @@ private type Set is new Ada.Finalization.Controlled with record HT : HT_Types.Hash_Table_Type; - end record; + end record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set); overriding procedure Adjust (Container : in out Set); diff --git a/gcc/ada/libgnat/a-cimutr.adb b/gcc/ada/libgnat/a-cimutr.adb index 293275ae5a9..b358aad3366 100644 --- a/gcc/ada/libgnat/a-cimutr.adb +++ b/gcc/ada/libgnat/a-cimutr.adb @@ -30,6 +30,7 @@ with Ada.Unchecked_Deallocation; with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Indefinite_Multiway_Trees with SPARK_Mode => Off @@ -1875,6 +1876,49 @@ is Process (Position.Node.Element.all); end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Tree) + is + use System.Put_Images; + + procedure Rec (Position : Cursor); + -- Recursive routine operating on cursors + + procedure Rec (Position : Cursor) is + First_Time : Boolean := True; + begin + Array_Before (S); + + for X in Iterate_Children (V, Position) loop + if First_Time then + First_Time := False; + else + Array_Between (S); + end if; + + Element_Type'Put_Image (S, Element (X)); + if Child_Count (X) > 0 then + Simple_Array_Between (S); + Rec (X); + end if; + end loop; + + Array_After (S); + end Rec; + + begin + if First_Child (Root (V)) = No_Element then + Array_Before (S); + Array_After (S); + else + Rec (First_Child (Root (V))); + end if; + end Put_Image; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-cimutr.ads b/gcc/ada/libgnat/a-cimutr.ads index 474a1b57aa9..9e03eb9f79b 100644 --- a/gcc/ada/libgnat/a-cimutr.ads +++ b/gcc/ada/libgnat/a-cimutr.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; generic type Element_Type (<>) is private; @@ -348,7 +349,10 @@ private Root : aliased Tree_Node_Type; TC : aliased Tamper_Counts; Count : Count_Type := 0; - end record; + end record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Tree); overriding procedure Adjust (Container : in out Tree); diff --git a/gcc/ada/libgnat/a-ciorma.adb b/gcc/ada/libgnat/a-ciorma.adb index 86cd01f09c8..7cfe07d0eb9 100644 --- a/gcc/ada/libgnat/a-ciorma.adb +++ b/gcc/ada/libgnat/a-ciorma.adb @@ -38,6 +38,7 @@ with Ada.Containers.Red_Black_Trees.Generic_Keys; pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Keys); with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Indefinite_Ordered_Maps with SPARK_Mode => Off @@ -1291,6 +1292,36 @@ is end; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map) + is + First_Time : Boolean := True; + use System.Put_Images; + + procedure Put_Key_Value (Position : Cursor); + procedure Put_Key_Value (Position : Cursor) is + begin + if First_Time then + First_Time := False; + else + Simple_Array_Between (S); + end if; + + Key_Type'Put_Image (S, Key (Position)); + Put_Arrow (S); + Element_Type'Put_Image (S, Element (Position)); + end Put_Key_Value; + + begin + Array_Before (S); + Iterate (V, Put_Key_Value'Access); + Array_After (S); + end Put_Image; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-ciorma.ads b/gcc/ada/libgnat/a-ciorma.ads index 909ab7af941..dbc59488d25 100644 --- a/gcc/ada/libgnat/a-ciorma.ads +++ b/gcc/ada/libgnat/a-ciorma.ads @@ -36,6 +36,7 @@ with Ada.Iterator_Interfaces; private with Ada.Containers.Red_Black_Trees; private with Ada.Finalization; private with Ada.Streams; +private with Ada.Strings.Text_Output; generic type Key_Type (<>) is private; @@ -258,7 +259,10 @@ private type Map is new Ada.Finalization.Controlled with record Tree : Tree_Types.Tree_Type; - end record; + end record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map); overriding procedure Adjust (Container : in out Map); diff --git a/gcc/ada/libgnat/a-ciormu.adb b/gcc/ada/libgnat/a-ciormu.adb index 110d734db59..c3672f4b17f 100644 --- a/gcc/ada/libgnat/a-ciormu.adb +++ b/gcc/ada/libgnat/a-ciormu.adb @@ -39,6 +39,7 @@ with Ada.Containers.Red_Black_Trees.Generic_Set_Operations; pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Set_Operations); with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Indefinite_Ordered_Multisets with SPARK_Mode => Off @@ -1657,6 +1658,31 @@ is end; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set) + 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; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-ciormu.ads b/gcc/ada/libgnat/a-ciormu.ads index 474ccc75e0d..5667e2c52eb 100644 --- a/gcc/ada/libgnat/a-ciormu.ads +++ b/gcc/ada/libgnat/a-ciormu.ads @@ -35,6 +35,7 @@ private with Ada.Containers.Red_Black_Trees; private with Ada.Finalization; private with Ada.Streams; +private with Ada.Strings.Text_Output; with Ada.Iterator_Interfaces; generic @@ -468,7 +469,10 @@ private type Set is new Ada.Finalization.Controlled with record Tree : Tree_Types.Tree_Type; - end record; + end record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set); overriding procedure Adjust (Container : in out Set); diff --git a/gcc/ada/libgnat/a-ciorse.adb b/gcc/ada/libgnat/a-ciorse.adb index 772061d886c..df56e481dd0 100644 --- a/gcc/ada/libgnat/a-ciorse.adb +++ b/gcc/ada/libgnat/a-ciorse.adb @@ -41,6 +41,7 @@ pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Set_Operations); with Ada.Unchecked_Deallocation; with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Indefinite_Ordered_Sets with SPARK_Mode => Off @@ -1722,6 +1723,31 @@ is end; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set) + 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; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-ciorse.ads b/gcc/ada/libgnat/a-ciorse.ads index 84c680ac713..b75a7a34cf3 100644 --- a/gcc/ada/libgnat/a-ciorse.ads +++ b/gcc/ada/libgnat/a-ciorse.ads @@ -37,6 +37,7 @@ with Ada.Containers.Helpers; private with Ada.Containers.Red_Black_Trees; private with Ada.Finalization; private with Ada.Streams; +private with Ada.Strings.Text_Output; generic type Element_Type (<>) is private; @@ -359,7 +360,10 @@ private type Set is new Ada.Finalization.Controlled with record Tree : Tree_Types.Tree_Type; - end record; + end record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set); overriding procedure Adjust (Container : in out Set); diff --git a/gcc/ada/libgnat/a-coboho.adb b/gcc/ada/libgnat/a-coboho.adb index eefb1064b8d..5d441634aba 100644 --- a/gcc/ada/libgnat/a-coboho.adb +++ b/gcc/ada/libgnat/a-coboho.adb @@ -26,6 +26,7 @@ ------------------------------------------------------------------------------ with Unchecked_Conversion; +with System.Put_Images; package body Ada.Containers.Bounded_Holders is @@ -64,6 +65,20 @@ package body Ada.Containers.Bounded_Holders is return Get (Left) = Get (Right); end "="; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Holder) + is + use System.Put_Images; + begin + Array_Before (S); + Element_Type'Put_Image (S, Get (V)); + Array_After (S); + end Put_Image; + --------- -- Get -- --------- diff --git a/gcc/ada/libgnat/a-coboho.ads b/gcc/ada/libgnat/a-coboho.ads index cb24c8904e2..024e6a66a81 100644 --- a/gcc/ada/libgnat/a-coboho.ads +++ b/gcc/ada/libgnat/a-coboho.ads @@ -30,6 +30,7 @@ ------------------------------------------------------------------------------ private with System; +private with Ada.Strings.Text_Output; generic type Element_Type (<>) is private; @@ -93,11 +94,14 @@ private type Holder is record Data : Storage_Array (1 .. Max_Size_In_Storage_Elements); end record - with Alignment => Standard'Maximum_Alignment; + with Alignment => Standard'Maximum_Alignment, Put_Image => Put_Image; -- We would like to say "Alignment => Element_Type'Alignment", but that -- is illegal because it's not static, so we use the maximum possible -- (default) alignment instead. + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Holder); + type Element_Access is access all Element_Type; pragma Assert (Element_Access'Size = Standard'Address_Size, "cannot instantiate with an array type"); diff --git a/gcc/ada/libgnat/a-cobove.adb b/gcc/ada/libgnat/a-cobove.adb index 410686b42bb..ba105a2a59f 100644 --- a/gcc/ada/libgnat/a-cobove.adb +++ b/gcc/ada/libgnat/a-cobove.adb @@ -30,6 +30,7 @@ with Ada.Containers.Generic_Array_Sort; with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Bounded_Vectors is @@ -2118,6 +2119,31 @@ package body Ada.Containers.Bounded_Vectors is Query_Element (Position.Container.all, Position.Index, Process); end Query_Element; + --------------- + -- 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; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-cobove.ads b/gcc/ada/libgnat/a-cobove.ads index 265fd52675a..4c8905cf51e 100644 --- a/gcc/ada/libgnat/a-cobove.ads +++ b/gcc/ada/libgnat/a-cobove.ads @@ -36,6 +36,7 @@ with Ada.Iterator_Interfaces; with Ada.Containers.Helpers; private with Ada.Streams; private with Ada.Finalization; +private with Ada.Strings.Text_Output; generic type Index_Type is range <>; @@ -392,7 +393,10 @@ private Elements : Elements_Array (1 .. Capacity) := (others => <>); 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); procedure Write (Stream : not null access Root_Stream_Type'Class; diff --git a/gcc/ada/libgnat/a-cohama.adb b/gcc/ada/libgnat/a-cohama.adb index 7f2d8e16ab5..44bf3d5b729 100644 --- a/gcc/ada/libgnat/a-cohama.adb +++ b/gcc/ada/libgnat/a-cohama.adb @@ -38,6 +38,7 @@ pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Keys); with Ada.Containers.Helpers; use Ada.Containers.Helpers; with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Hashed_Maps with SPARK_Mode => Off @@ -870,6 +871,36 @@ is end; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map) + is + First_Time : Boolean := True; + use System.Put_Images; + + procedure Put_Key_Value (Position : Cursor); + procedure Put_Key_Value (Position : Cursor) is + begin + if First_Time then + First_Time := False; + else + Simple_Array_Between (S); + end if; + + Key_Type'Put_Image (S, Key (Position)); + Put_Arrow (S); + Element_Type'Put_Image (S, Element (Position)); + end Put_Key_Value; + + begin + Array_Before (S); + Iterate (V, Put_Key_Value'Access); + Array_After (S); + end Put_Image; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-cohama.ads b/gcc/ada/libgnat/a-cohama.ads index 4c87aeae294..cb5d2c5bf3e 100644 --- a/gcc/ada/libgnat/a-cohama.ads +++ b/gcc/ada/libgnat/a-cohama.ads @@ -36,6 +36,7 @@ with Ada.Iterator_Interfaces; private with Ada.Containers.Hash_Tables; private with Ada.Finalization; private with Ada.Streams; +private with Ada.Strings.Text_Output; -- The language-defined generic package Containers.Hashed_Maps provides -- private types Map and Cursor, and a set of operations for each type. A map @@ -425,7 +426,10 @@ private type Map is new Ada.Finalization.Controlled with record HT : HT_Types.Hash_Table_Type; - end record; + end record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map); overriding procedure Adjust (Container : in out Map); diff --git a/gcc/ada/libgnat/a-cohase.adb b/gcc/ada/libgnat/a-cohase.adb index bc4e53f68f3..4de3dacf714 100644 --- a/gcc/ada/libgnat/a-cohase.adb +++ b/gcc/ada/libgnat/a-cohase.adb @@ -40,6 +40,7 @@ with Ada.Containers.Helpers; use Ada.Containers.Helpers; with Ada.Containers.Prime_Numbers; with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Hashed_Sets with SPARK_Mode => Off @@ -1149,6 +1150,31 @@ is end; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set) + 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; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-cohase.ads b/gcc/ada/libgnat/a-cohase.ads index 38d079fbbcc..451f592ce47 100644 --- a/gcc/ada/libgnat/a-cohase.ads +++ b/gcc/ada/libgnat/a-cohase.ads @@ -37,6 +37,7 @@ private with Ada.Containers.Hash_Tables; with Ada.Containers.Helpers; private with Ada.Finalization; private with Ada.Streams; +private with Ada.Strings.Text_Output; generic type Element_Type is private; @@ -504,7 +505,10 @@ private type Set is new Ada.Finalization.Controlled with record HT : HT_Types.Hash_Table_Type; - end record; + end record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set); overriding procedure Adjust (Container : in out Set); diff --git a/gcc/ada/libgnat/a-coinho.adb b/gcc/ada/libgnat/a-coinho.adb index c5da9432dd9..6c99c8d2fb1 100644 --- a/gcc/ada/libgnat/a-coinho.adb +++ b/gcc/ada/libgnat/a-coinho.adb @@ -26,6 +26,7 @@ ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; +with System.Put_Images; package body Ada.Containers.Indefinite_Holders is @@ -229,6 +230,22 @@ package body Ada.Containers.Indefinite_Holders is B := B - 1; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Holder) + is + use System.Put_Images; + begin + Array_Before (S); + if not Is_Empty (V) then + Element_Type'Put_Image (S, Element (V)); + end if; + Array_After (S); + end Put_Image; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-coinho.ads b/gcc/ada/libgnat/a-coinho.ads index bf6165e954d..372f0693506 100644 --- a/gcc/ada/libgnat/a-coinho.ads +++ b/gcc/ada/libgnat/a-coinho.ads @@ -31,6 +31,7 @@ private with Ada.Finalization; private with Ada.Streams; +private with Ada.Strings.Text_Output; generic type Element_Type (<>) is private; @@ -115,7 +116,11 @@ private type Holder is new Ada.Finalization.Controlled with record Element : Element_Access; Busy : Natural := 0; - end record; + end record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Holder); + for Holder'Read use Read; for Holder'Write use Write; diff --git a/gcc/ada/libgnat/a-coinho__shared.adb b/gcc/ada/libgnat/a-coinho__shared.adb index 43f5d52f7db..16bb7081e33 100644 --- a/gcc/ada/libgnat/a-coinho__shared.adb +++ b/gcc/ada/libgnat/a-coinho__shared.adb @@ -33,6 +33,7 @@ -- internal shared object and element). with Ada.Unchecked_Deallocation; +with System.Put_Images; package body Ada.Containers.Indefinite_Holders is @@ -319,6 +320,22 @@ package body Ada.Containers.Indefinite_Holders is B := B - 1; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Holder) + is + use System.Put_Images; + begin + Array_Before (S); + if not Is_Empty (V) then + Element_Type'Put_Image (S, Element (V)); + end if; + Array_After (S); + end Put_Image; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-coinho__shared.ads b/gcc/ada/libgnat/a-coinho__shared.ads index 0345b5ee0db..e7bea85b4ac 100644 --- a/gcc/ada/libgnat/a-coinho__shared.ads +++ b/gcc/ada/libgnat/a-coinho__shared.ads @@ -36,6 +36,7 @@ private with Ada.Finalization; private with Ada.Streams; private with System.Atomic_Counters; +private with Ada.Strings.Text_Output; generic type Element_Type (<>) is private; @@ -130,7 +131,11 @@ private type Holder is new Ada.Finalization.Controlled with record Reference : Shared_Holder_Access; Busy : Natural := 0; - end record; + end record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Holder); + for Holder'Read use Read; for Holder'Write use Write; diff --git a/gcc/ada/libgnat/a-coinve.adb b/gcc/ada/libgnat/a-coinve.adb index 19a6659e894..5999a2c2d30 100644 --- a/gcc/ada/libgnat/a-coinve.adb +++ b/gcc/ada/libgnat/a-coinve.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.Indefinite_Vectors with SPARK_Mode => Off @@ -2649,6 +2650,31 @@ is end if; end Query_Element; + --------------- + -- 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; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-coinve.ads b/gcc/ada/libgnat/a-coinve.ads index 2220d939678..1f15722319a 100644 --- a/gcc/ada/libgnat/a-coinve.ads +++ b/gcc/ada/libgnat/a-coinve.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; generic type Index_Type is range <>; @@ -393,7 +394,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/a-comutr.adb b/gcc/ada/libgnat/a-comutr.adb index 76ff7515616..78f93f02b9d 100644 --- a/gcc/ada/libgnat/a-comutr.adb +++ b/gcc/ada/libgnat/a-comutr.adb @@ -31,6 +31,7 @@ with Ada.Unchecked_Conversion; with Ada.Unchecked_Deallocation; with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Multiway_Trees with SPARK_Mode => Off @@ -1858,6 +1859,49 @@ is Process (Position.Node.Element); end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Tree) + is + use System.Put_Images; + + procedure Rec (Position : Cursor); + -- Recursive routine operating on cursors + + procedure Rec (Position : Cursor) is + First_Time : Boolean := True; + begin + Array_Before (S); + + for X in Iterate_Children (V, Position) loop + if First_Time then + First_Time := False; + else + Array_Between (S); + end if; + + Element_Type'Put_Image (S, Element (X)); + if Child_Count (X) > 0 then + Simple_Array_Between (S); + Rec (X); + end if; + end loop; + + Array_After (S); + end Rec; + + begin + if First_Child (Root (V)) = No_Element then + Array_Before (S); + Array_After (S); + else + Rec (First_Child (Root (V))); + end if; + end Put_Image; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-comutr.ads b/gcc/ada/libgnat/a-comutr.ads index 46934a113c0..a1f51affbf4 100644 --- a/gcc/ada/libgnat/a-comutr.ads +++ b/gcc/ada/libgnat/a-comutr.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; generic type Element_Type is private; @@ -400,7 +401,10 @@ private Root : aliased Root_Node_Type; TC : aliased Tamper_Counts; Count : Count_Type := 0; - end record; + end record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Tree); overriding procedure Adjust (Container : in out Tree); diff --git a/gcc/ada/libgnat/a-coorma.adb b/gcc/ada/libgnat/a-coorma.adb index 4106d58ff4e..15d08f57b60 100644 --- a/gcc/ada/libgnat/a-coorma.adb +++ b/gcc/ada/libgnat/a-coorma.adb @@ -38,6 +38,7 @@ with Ada.Containers.Red_Black_Trees.Generic_Keys; pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Keys); with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Ordered_Maps with SPARK_Mode => Off @@ -1214,6 +1215,36 @@ is end; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map) + is + First_Time : Boolean := True; + use System.Put_Images; + + procedure Put_Key_Value (Position : Cursor); + procedure Put_Key_Value (Position : Cursor) is + begin + if First_Time then + First_Time := False; + else + Simple_Array_Between (S); + end if; + + Key_Type'Put_Image (S, Key (Position)); + Put_Arrow (S); + Element_Type'Put_Image (S, Element (Position)); + end Put_Key_Value; + + begin + Array_Before (S); + Iterate (V, Put_Key_Value'Access); + Array_After (S); + end Put_Image; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-coorma.ads b/gcc/ada/libgnat/a-coorma.ads index 524aa048fc0..f80836e96ea 100644 --- a/gcc/ada/libgnat/a-coorma.ads +++ b/gcc/ada/libgnat/a-coorma.ads @@ -36,6 +36,7 @@ with Ada.Iterator_Interfaces; private with Ada.Containers.Red_Black_Trees; private with Ada.Finalization; private with Ada.Streams; +private with Ada.Strings.Text_Output; generic type Key_Type is private; @@ -259,7 +260,10 @@ private type Map is new Ada.Finalization.Controlled with record Tree : Tree_Types.Tree_Type; - end record; + end record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Map); overriding procedure Adjust (Container : in out Map); diff --git a/gcc/ada/libgnat/a-coormu.adb b/gcc/ada/libgnat/a-coormu.adb index c02a9f1540e..c7db472e50b 100644 --- a/gcc/ada/libgnat/a-coormu.adb +++ b/gcc/ada/libgnat/a-coormu.adb @@ -39,6 +39,7 @@ with Ada.Containers.Red_Black_Trees.Generic_Set_Operations; pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Set_Operations); with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Ordered_Multisets with SPARK_Mode => Off @@ -1565,6 +1566,31 @@ is end; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set) + 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; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-coormu.ads b/gcc/ada/libgnat/a-coormu.ads index 9c6c3ae8d98..95aec73ea26 100644 --- a/gcc/ada/libgnat/a-coormu.ads +++ b/gcc/ada/libgnat/a-coormu.ads @@ -34,6 +34,7 @@ private with Ada.Containers.Red_Black_Trees; private with Ada.Finalization; private with Ada.Streams; +private with Ada.Strings.Text_Output; with Ada.Iterator_Interfaces; generic @@ -472,7 +473,10 @@ private type Set is new Ada.Finalization.Controlled with record Tree : Tree_Types.Tree_Type; - end record; + end record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set); overriding procedure Adjust (Container : in out Set); diff --git a/gcc/ada/libgnat/a-coorse.adb b/gcc/ada/libgnat/a-coorse.adb index 15b59dd4bc5..8a648e889e1 100644 --- a/gcc/ada/libgnat/a-coorse.adb +++ b/gcc/ada/libgnat/a-coorse.adb @@ -41,6 +41,7 @@ with Ada.Containers.Red_Black_Trees.Generic_Set_Operations; pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Set_Operations); with System; use type System.Address; +with System.Put_Images; package body Ada.Containers.Ordered_Sets with SPARK_Mode => Off @@ -1580,6 +1581,31 @@ is end; end Query_Element; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set) + 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; + ---------- -- Read -- ---------- diff --git a/gcc/ada/libgnat/a-coorse.ads b/gcc/ada/libgnat/a-coorse.ads index c08d4957d99..a5577e9e858 100644 --- a/gcc/ada/libgnat/a-coorse.ads +++ b/gcc/ada/libgnat/a-coorse.ads @@ -37,6 +37,7 @@ with Ada.Containers.Helpers; private with Ada.Containers.Red_Black_Trees; private with Ada.Finalization; private with Ada.Streams; +private with Ada.Strings.Text_Output; generic type Element_Type is private; @@ -342,7 +343,10 @@ private type Set is new Ada.Finalization.Controlled with record Tree : Tree_Types.Tree_Type; - end record; + end record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Set); overriding procedure Adjust (Container : in out Set); diff --git a/gcc/ada/libgnat/a-stoubu.adb b/gcc/ada/libgnat/a-stoubu.adb index 9fb6c5ad3e5..663d4ba9906 100644 --- a/gcc/ada/libgnat/a-stoubu.adb +++ b/gcc/ada/libgnat/a-stoubu.adb @@ -35,6 +35,8 @@ with Ada.Strings.UTF_Encoding.Wide_Strings; with Ada.Strings.UTF_Encoding.Wide_Wide_Strings; package body Ada.Strings.Text_Output.Buffers is + type Chunk_Access is access all Chunk; + function New_Buffer (Indent_Amount : Natural := Default_Indent_Amount; Chunk_Length : Positive := Default_Chunk_Length) return Buffer @@ -46,13 +48,20 @@ package body Ada.Strings.Text_Output.Buffers is end return; end New_Buffer; + -- We need type conversions of Chunk_Access values in the following two + -- procedures, because the one in Text_Output has Storage_Size => 0, + -- because Text_Output is Pure. We do not run afoul of 13.11.2(16/3), + -- which requires the allocation and deallocation to have the same pool, + -- because the allocation in Full_Method and the deallocation in Destroy + -- use the same access type, and therefore the same pool. + procedure Destroy (S : in out Buffer) is procedure Free is new Unchecked_Deallocation (Chunk, Chunk_Access); - Cur : Chunk_Access := S.Initial_Chunk.Next; + Cur : Chunk_Access := Chunk_Access (S.Initial_Chunk.Next); begin while Cur /= null loop declare - Temp : constant Chunk_Access := Cur.Next; + Temp : constant Chunk_Access := Chunk_Access (Cur.Next); begin Free (Cur); Cur := Temp; @@ -66,7 +75,8 @@ package body Ada.Strings.Text_Output.Buffers is begin pragma Assert (S.Cur_Chunk.Next = null); pragma Assert (S.Last = S.Cur_Chunk.Chars'Length); - S.Cur_Chunk.Next := new Chunk (S.Chunk_Length); + S.Cur_Chunk.Next := + Text_Output.Chunk_Access (Chunk_Access'(new Chunk (S.Chunk_Length))); S.Cur_Chunk := S.Cur_Chunk.Next; S.Num_Extra_Chunks := @ + 1; S.Last := 0; diff --git a/gcc/ada/libgnat/a-stouut.adb b/gcc/ada/libgnat/a-stouut.adb index b5a8f971570..2011408218a 100644 --- a/gcc/ada/libgnat/a-stouut.adb +++ b/gcc/ada/libgnat/a-stouut.adb @@ -142,6 +142,7 @@ package body Ada.Strings.Text_Output.Utils is S.Cur_Chunk.Chars (S.Last + 1 .. S.Last + Item'Length) := Item; S.Last := S.Last + Item'Length; + S.Column := S.Column + Item'Length; Full (S); -- ???Seems like maybe we shouldn't call Full until we have MORE -- characters. But then we can't pass Chunk_Length => 1 to @@ -175,6 +176,7 @@ package body Ada.Strings.Text_Output.Utils is S.Cur_Chunk.Chars (S.Last + 1 .. S.Last + Item'Length) := Item; S.Last := S.Last + Item'Length; + S.Column := S.Column + Item'Length; else Put_UTF_8_Outline (S, Item); end if; @@ -191,7 +193,6 @@ package body Ada.Strings.Text_Output.Utils is Put_UTF_8 (S, Item (Line_Start .. Index - 1)); end if; New_Line (S); - S.Column := 1; Line_Start := Index + 1; end if; diff --git a/gcc/ada/libgnat/a-stouut.ads b/gcc/ada/libgnat/a-stouut.ads index 28d7eca77c6..5056080d4bf 100644 --- a/gcc/ada/libgnat/a-stouut.ads +++ b/gcc/ada/libgnat/a-stouut.ads @@ -29,7 +29,7 @@ -- -- ------------------------------------------------------------------------------ -package Ada.Strings.Text_Output.Utils with Preelaborate is +package Ada.Strings.Text_Output.Utils with Pure is -- This package provides utility functions on Sink'Class. These are -- intended for use by Put_Image attributes, both the default versions @@ -70,7 +70,8 @@ package Ada.Strings.Text_Output.Utils with Preelaborate is -- Send data that is already UTF-8 encoded (including 7-bit ASCII) to -- S. These are more efficient than Put_String. - procedure New_Line (S : in out Sink'Class) with Inline; + procedure New_Line (S : in out Sink'Class) with + Inline, Post => Column (S) = 1; -- Puts the new-line character. function Column (S : Sink'Class) return Positive with Inline; diff --git a/gcc/ada/libgnat/a-strunb.adb b/gcc/ada/libgnat/a-strunb.adb index 988de424f80..7d1e6ddb727 100644 --- a/gcc/ada/libgnat/a-strunb.adb +++ b/gcc/ada/libgnat/a-strunb.adb @@ -778,6 +778,16 @@ package body Ada.Strings.Unbounded is end if; end Overwrite; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Unbounded_String) is + begin + String'Put_Image (S, To_String (V)); + end Put_Image; + ----------------------- -- Realloc_For_Chunk -- ----------------------- diff --git a/gcc/ada/libgnat/a-strunb.ads b/gcc/ada/libgnat/a-strunb.ads index 3471dbb4a9f..7de9bbcbdc4 100644 --- a/gcc/ada/libgnat/a-strunb.ads +++ b/gcc/ada/libgnat/a-strunb.ads @@ -41,6 +41,7 @@ pragma Assertion_Policy (Pre => Ignore); with Ada.Strings.Maps; with Ada.Finalization; +private with Ada.Strings.Text_Output; -- The language-defined package Strings.Unbounded provides a private type -- Unbounded_String and a set of operations. An object of type @@ -744,7 +745,11 @@ private type Unbounded_String is new AF.Controlled with record Reference : String_Access := Null_String'Access; Last : Natural := 0; - end record; + end record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Unbounded_String); + -- The Unbounded_String is using a buffered implementation to increase -- speed of the Append/Delete/Insert procedures. The Reference string -- pointer above contains the current string value and extra room at the diff --git a/gcc/ada/libgnat/a-strunb__shared.adb b/gcc/ada/libgnat/a-strunb__shared.adb index 0ff34d817ef..54a2932c00c 100644 --- a/gcc/ada/libgnat/a-strunb__shared.adb +++ b/gcc/ada/libgnat/a-strunb__shared.adb @@ -1296,6 +1296,16 @@ package body Ada.Strings.Unbounded is end if; end Overwrite; + --------------- + -- Put_Image -- + --------------- + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Unbounded_String) is + begin + String'Put_Image (S, To_String (V)); + end Put_Image; + --------------- -- Reference -- --------------- diff --git a/gcc/ada/libgnat/a-strunb__shared.ads b/gcc/ada/libgnat/a-strunb__shared.ads index 5a5ad93a6e4..2cd81666fdc 100644 --- a/gcc/ada/libgnat/a-strunb__shared.ads +++ b/gcc/ada/libgnat/a-strunb__shared.ads @@ -78,6 +78,7 @@ pragma Assertion_Policy (Pre => Ignore); with Ada.Strings.Maps; private with Ada.Finalization; private with System.Atomic_Counters; +private with Ada.Strings.Text_Output; package Ada.Strings.Unbounded with Initial_Condition => Length (Null_Unbounded_String) = 0 @@ -738,7 +739,10 @@ private type Unbounded_String is new AF.Controlled with record Reference : not null Shared_String_Access := Empty_Shared_String'Access; - end record; + end record with Put_Image => Put_Image; + + procedure Put_Image + (S : in out Ada.Strings.Text_Output.Sink'Class; V : Unbounded_String); pragma Stream_Convert (Unbounded_String, To_Unbounded, To_String); -- Provide stream routines without dragging in Ada.Streams diff --git a/gcc/ada/libgnat/a-stteou.ads b/gcc/ada/libgnat/a-stteou.ads index 924b55003c6..9eaf98a820c 100644 --- a/gcc/ada/libgnat/a-stteou.ads +++ b/gcc/ada/libgnat/a-stteou.ads @@ -32,7 +32,7 @@ with Ada.Strings.UTF_Encoding; with Ada.Strings.UTF_Encoding.Wide_Wide_Strings; -package Ada.Strings.Text_Output with Preelaborate is +package Ada.Strings.Text_Output with Pure is -- This package provides a "Sink" abstraction, to which characters of type -- Character, Wide_Character, and Wide_Wide_Character can be sent. This @@ -48,7 +48,11 @@ package Ada.Strings.Text_Output with Preelaborate is -- extended. It is designed with particular extensions in mind, and these -- extensions are declared in child packages of this package, because they -- depend on implementation details in the private part of this - -- package. The primary extensions of Sink are: + -- package. + -- + -- Users are not expected to extend type Sink. + -- + -- The primary extensions of Sink are: -- -- Buffer. The characters sent to a Buffer are stored in memory, and can -- be retrieved via Get functions. This is intended for the @@ -141,15 +145,13 @@ package Ada.Strings.Text_Output with Preelaborate is -- slows things down, but increasing it doesn't gain much. private - type String_Access is access all String; - -- For Buffer, the "internal buffer" mentioned above is implemented as a -- linked list of chunks. When the current chunk is full, we allocate a new -- one. For File, there is only one chunk. When it is full, we send the -- data to the file, and empty it. type Chunk; - type Chunk_Access is access all Chunk; + type Chunk_Access is access all Chunk with Storage_Size => 0; type Chunk (Length : Positive) is limited record Next : Chunk_Access := null; Chars : UTF_8_Lines (1 .. Length); diff --git a/gcc/ada/libgnat/s-putima.adb b/gcc/ada/libgnat/s-putima.adb index 4ae612d0062..e4b9e670ddf 100644 --- a/gcc/ada/libgnat/s-putima.adb +++ b/gcc/ada/libgnat/s-putima.adb @@ -250,6 +250,11 @@ package body System.Put_Images is Put_7bit (S, ')'); end Record_After; + procedure Put_Arrow (S : in out Sink'Class) is + begin + Put_UTF_8 (S, " => "); + end Put_Arrow; + procedure Put_Image_Unknown (S : in out Sink'Class; Type_Name : String) is begin Put_UTF_8 (S, "{"); diff --git a/gcc/ada/libgnat/s-putima.ads b/gcc/ada/libgnat/s-putima.ads index 17e184a5539..bf565079c96 100644 --- a/gcc/ada/libgnat/s-putima.ads +++ b/gcc/ada/libgnat/s-putima.ads @@ -32,7 +32,7 @@ with Ada.Strings.Text_Output; with System.Unsigned_Types; -package System.Put_Images is +package System.Put_Images with Pure is -- This package contains subprograms that are called by the generated code -- for the 'Put_Image attribute. @@ -64,8 +64,8 @@ package System.Put_Images is type Byte is new Character with Alignment => 1; type Byte_String is array (Positive range <>) of Byte with Alignment => 1; - type Thin_Pointer is access all Byte; - type Fat_Pointer is access all Byte_String; + type Thin_Pointer is access all Byte with Storage_Size => 0; + type Fat_Pointer is access all Byte_String with Storage_Size => 0; procedure Put_Image_Thin_Pointer (S : in out Sink'Class; X : Thin_Pointer); procedure Put_Image_Fat_Pointer (S : in out Sink'Class; X : Fat_Pointer); -- Print "null", or the address of the designated object as an unsigned @@ -95,6 +95,8 @@ package System.Put_Images is procedure Record_Between (S : in out Sink'Class); procedure Record_After (S : in out Sink'Class); + procedure Put_Arrow (S : in out Sink'Class); + procedure Put_Image_Unknown (S : in out Sink'Class; Type_Name : String); -- For Put_Image of types that don't have the attribute, such as type -- Sink. -- 2.30.2