Natools

Check-in [ee89558365]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:s_expressions-printers-pretty: redesign the package around an abstract type with user-provided backend write procedure
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: ee89558365348430e6ae5e3ef439ca4c37d3acdc
User & Date: nat on 2014-06-04 21:05:09
Other Links: manifest | tags
Context
2014-06-05
20:20
s_expressions-file_writers: new package providing a pretty printer based on Stream_IO files check-in: 9d6c39db7d user: nat tags: trunk
2014-06-04
21:05
s_expressions-printers-pretty: redesign the package around an abstract type with user-provided backend write procedure check-in: ee89558365 user: nat tags: trunk
2014-06-03
21:22
s_expressions-printers-pretty-config-tests: add tests to reach a decent coverage of the rewritten version check-in: 6fb20358ef user: nat tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified src/natools-s_expressions-printers-pretty.adb from [b778534f67] to [b5a4a6c160].

︙
257
258
259
260
261
262
263

264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281

282
283
284
285
286
287
288
289


290
291
292

293
294
295
296
297
298
299
300
301
302
303
304
305
306
307


308
309
310
311
312
313
314

257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281

282
283
284
285
286
287
288


289
290
291
292

293

294
295
296
297
298
299
300
301
302
303
304
305


306
307
308
309
310
311
312
313
314








+

















-
+






-
-
+
+


-
+
-












-
-
+
+








      end case;
   end Is_Newline;


   procedure Newline (Output : in out Printer) is
      Data : Atom (0 .. 1);
      Length : Count;
      Writer : Printer'Class renames Printer'Class (Output);
   begin
      case Output.Param.Newline is
         when CR =>
            Data (0) := Encodings.CR;
            Length := 1;
         when LF =>
            Data (0) := Encodings.LF;
            Length := 1;
         when CR_LF =>
            Data (0) := Encodings.CR;
            Data (1) := Encodings.LF;
            Length := 2;
         when LF_CR =>
            Data (0) := Encodings.LF;
            Data (1) := Encodings.CR;
            Length := 2;
      end case;
      Output.Stream.Write (Data (0 .. Length - 1));
      Writer.Write_Raw (Data (0 .. Length - 1));

      if Output.Indent_Level > 0 and Output.Param.Indentation > 0 then
         case Output.Param.Indent is
            when Spaces =>
               Output.Cursor := Output.Param.Indentation * Output.Indent_Level
                                + 1;
               Output.Stream.Write ((1 .. Count (Output.Cursor) - 1
                                     => Encodings.Space));
               Writer.Write_Raw
                 ((1 .. Count (Output.Cursor) - 1 => Encodings.Space));
            when Tabs =>
               Output.Cursor := Output.Param.Indentation * Output.Indent_Level;
               Output.Stream.Write ((1 .. Count (Output.Cursor)
               Writer.Write_Raw ((1 .. Count (Output.Cursor) => Encodings.HT));
                                     => Encodings.HT));
               Output.Cursor := Output.Cursor * Output.Param.Tab_Stop;
            when Tabs_And_Spaces =>
               Output.Cursor := Output.Param.Indentation * Output.Indent_Level
                                + 1;
               declare
                  Tab_Count : constant Count
                    := (Count (Output.Cursor) - 1)
                        / Count (Output.Param.Tab_Stop);
                  Space_Count : constant Count
                    := (Count (Output.Cursor) - 1)
                        mod Count (Output.Param.Tab_Stop);
               begin
                  Output.Stream.Write ((1 .. Tab_Count => Encodings.HT));
                  Output.Stream.Write ((1 .. Space_Count => Encodings.Space));
                  Writer.Write_Raw ((1 .. Tab_Count => Encodings.HT));
                  Writer.Write_Raw ((1 .. Space_Count => Encodings.Space));
               end;
         end case;
      else
         Output.Cursor := 1;
      end if;
   end Newline;
︙
469
470
471
472
473
474
475

476
477
478
479
480



481
482

483
484
485
486
487
488
489
490
491


492
493
494
495
496
497


498
499
500
501
502
503



504
505
506
507
508
509
510
511
512
513
514
515
516

517
518
519
520
521
522




523
524

525
526
527
528
529
530
531
532

533
534
535
536

537
538
539



540
541
542

543
544
545
546




547
548
549
550
551
552
553

469
470
471
472
473
474
475
476
477
478



479
480
481
482

483
484
485
486
487
488
489
490


491
492
493
494
495
496


497
498
499
500
501



502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520




521
522
523
524
525

526
527
528
529
530
531
532
533

534
535
536
537
538
539



540
541
542
543
544
545
546




547
548
549
550
551
552
553
554
555
556
557








+


-
-
-
+
+
+

-
+







-
-
+
+




-
-
+
+



-
-
-
+
+
+













+


-
-
-
-
+
+
+
+

-
+







-
+




+
-
-
-
+
+
+



+
-
-
-
-
+
+
+
+








   end Single_Line_Quoted_Width;


   procedure Write_Base64 (Output : in out Printer; Data : in Atom) is
      Available : Screen_Offset;
      I : Offset := Data'First;
      Chunk_Size : Count;
      Writer : Printer'Class renames Printer'Class (Output);
   begin
      if Output.Param.Width = 0 then
         Output.Stream.Write ((0 => Encodings.Base64_Atom_Begin));
         Output.Stream.Write (Encodings.Encode_Base64 (Data));
         Output.Stream.Write ((0 => Encodings.Base64_Atom_End));
         Writer.Write_Raw ((0 => Encodings.Base64_Atom_Begin));
         Writer.Write_Raw (Encodings.Encode_Base64 (Data));
         Writer.Write_Raw ((0 => Encodings.Base64_Atom_End));
      else
         Output.Stream.Write ((0 => Encodings.Base64_Atom_Begin));
         Writer.Write_Raw ((0 => Encodings.Base64_Atom_Begin));
         Output.Cursor := Output.Cursor + 1;

         loop
            Available := Output.Param.Width + 1 - Output.Cursor;
            Chunk_Size := Count'Max (1, Count (Available) / 4) * 3;

            if Available mod 4 /= 0 and then I in Data'Range then
               Output.Stream.Write
                 ((1 .. Count (Available mod 4) => Encodings.Space));
               Writer.Write_Raw
                 (((1 .. Count (Available mod 4) => Encodings.Space)));
               Output.Cursor := Output.Cursor + (Available mod 4);
            end if;

            if I + Chunk_Size - 1 in Data'Range then
               Output.Stream.Write (Encodings.Encode_Base64
                                      (Data (I .. I + Chunk_Size - 1)));
               Writer.Write_Raw
                 (Encodings.Encode_Base64 (Data (I .. I + Chunk_Size - 1)));
               Newline (Output);
               I := I + Chunk_Size;
            else
               Output.Stream.Write (Encodings.Encode_Base64
                                      (Data (I .. Data'Last)));
               Output.Stream.Write ((0 => Encodings.Base64_Atom_End));
               Writer.Write_Raw
                 (Encodings.Encode_Base64 (Data (I .. Data'Last)));
               Writer.Write_Raw ((0 => Encodings.Base64_Atom_End));
               Output.Cursor := Output.Cursor
                 + Screen_Offset (Data'Last - I + 2) / 3 * 4 + 1;
               exit;
            end if;
         end loop;
      end if;
   end Write_Base64;


   procedure Write_Hex (Output : in out Printer; Data : in Atom) is
      Available : Screen_Offset;
      I : Offset := Data'First;
      Chunk_Size : Count;
      Writer : Printer'Class renames Printer'Class (Output);
   begin
      if Output.Param.Width = 0 then
         Output.Stream.Write ((0 => Encodings.Hex_Atom_Begin));
         Output.Stream.Write (Encodings.Encode_Hex (Data,
                                                    Output.Param.Hex_Casing));
         Output.Stream.Write ((0 => Encodings.Hex_Atom_End));
         Writer.Write_Raw ((0 => Encodings.Hex_Atom_Begin));
         Writer.Write_Raw
           (Encodings.Encode_Hex (Data, Output.Param.Hex_Casing));
         Writer.Write_Raw ((0 => Encodings.Hex_Atom_End));
      else
         Output.Stream.Write ((0 => Encodings.Hex_Atom_Begin));
         Writer.Write_Raw ((0 => Encodings.Hex_Atom_Begin));
         Output.Cursor := Output.Cursor + 1;

         loop
            Available := Output.Param.Width + 1 - Output.Cursor;
            Chunk_Size := Count'Max (1, Count (Available) / 2);

            if Available mod 2 = 1 and then I in Data'Range then
               Output.Stream.Write ((0 => Encodings.Space));
               Writer.Write_Raw ((0 => Encodings.Space));
               Output.Cursor := Output.Cursor + 1;
            end if;

            if I + Chunk_Size - 1 in Data'Range then
               Writer.Write_Raw
               Output.Stream.Write (Encodings.Encode_Hex
                                      (Data (I .. I + Chunk_Size - 1),
                                       Output.Param.Hex_Casing));
                 (Encodings.Encode_Hex
                    (Data (I .. I + Chunk_Size - 1),
                     Output.Param.Hex_Casing));
               Newline (Output);
               I := I + Chunk_Size;
            else
               Writer.Write_Raw
               Output.Stream.Write (Encodings.Encode_Hex
                                      (Data (I .. Data'Last),
                                       Output.Param.Hex_Casing));
               Output.Stream.Write ((0 => Encodings.Hex_Atom_End));
                 (Encodings.Encode_Hex
                    (Data (I .. Data'Last),
                     Output.Param.Hex_Casing));
               Writer.Write_Raw ((0 => Encodings.Hex_Atom_End));
               Output.Cursor := Output.Cursor
                 + Screen_Offset (Data'Last - I + 1) * 2 + 1;
               exit;
            end if;
         end loop;
      end if;
   end Write_Hex;
︙
751
752
753
754
755
756
757
758

759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774


775
776
777
778
779
780
781

755
756
757
758
759
760
761

762
763
764
765
766
767
768
769
770
771
772
773
774
775
776


777
778
779
780
781
782
783
784
785








-
+














-
-
+
+








               Output.Cursor := New_Cursor;
            end if;
         end loop;

         pragma Assert (O = Result'Last);
         Result (O) := Encodings.Quoted_Atom_End;

         Output.Stream.Write (Result);
         Write_Raw (Printer'Class (Output), Result);
      end;
   end Write_Quoted;


   procedure Write_Verbatim (Output : in out Printer; Data : in Atom) is
      Length_Image : constant String := Count'Image (Data'Length);
      Prefix : Atom (0 .. Length_Image'Length - 1);
   begin
      for I in Length_Image'First + 1 .. Length_Image'Last loop
         Prefix (Count (I) - Count (Length_Image'First + 1)) :=
           Character'Pos (Length_Image (I));
      end loop;
      Prefix (Prefix'Last) := Encodings.Verbatim_Begin;

      Output.Stream.Write (Prefix);
      Output.Stream.Write (Data);
      Write_Raw (Printer'Class (Output), Prefix);
      Write_Raw (Printer'Class (Output), Data);
      Output.Cursor := Output.Cursor + Screen_Offset (Prefix'Length)
        + Screen_Offset (Data'Length);
   end Write_Verbatim;



   -----------------------
︙
792
793
794
795
796
797
798
799

800
801
802
803
804
805
806

807
808
809
810
811
812
813

796
797
798
799
800
801
802

803
804
805
806
807
808
809

810
811
812
813
814
815
816
817








-
+






-
+








         Output.First := True;  --  inhibit extra space or newline
      end if;

      if not Output.First then
         if Output.Param.Newline_At (Output.Previous, Opening) then
            Newline (Output);
         elsif Output.Param.Space_At (Output.Previous, Opening) then
            Output.Stream.Write ((0 => Encodings.Space));
            Write_Raw (Printer'Class (Output), (0 => Encodings.Space));
            Output.Cursor := Output.Cursor + 1;
         end if;
      else
         Output.First := False;
      end if;

      Output.Stream.Write ((0 => Encodings.List_Begin));
      Write_Raw (Printer'Class (Output), (0 => Encodings.List_Begin));
      Output.Cursor := Output.Cursor + 1;
      Output.Indent_Level := Output.Indent_Level + 1;
      Output.Previous := Opening;
      Output.Need_Blank := False;
   end Open_List;
︙
851
852
853
854
855
856
857
858

859
860
861

862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877

878
879
880
881
882
883
884

855
856
857
858
859
860
861

862
863
864

865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880

881
882
883
884
885
886
887
888








-
+


-
+















-
+








                 - 2;
         begin
            if not At_Origin
              and then not Fit_In_Line (Output, Blank_Width + Width)
            then
               Newline (Output);
            elsif Output.Need_Blank then
               Output.Stream.Write ((0 => Encodings.Space));
               Write_Raw (Printer'Class (Output), (0 => Encodings.Space));
               Output.Cursor := Output.Cursor + 1;
            end if;
            Output.Stream.Write (Data);
            Write_Raw (Printer'Class (Output), Data);
            Output.Cursor := Output.Cursor + Width;
            Output.Need_Blank := True;
            return;
         end;
      end if;

      --  Single-line quoted string if requested and possible

      if Output.Param.Quoted = Single_Line then
         declare
            Width : constant Screen_Offset
              := Single_Line_Quoted_Width (Data, Output.Param.Char_Encoding);
         begin
            if Fit_In_Line (Output, Blank_Width + Width) then
               if Output.Need_Blank then
                  Output.Stream.Write ((0 => Encodings.Space));
                  Write_Raw (Printer'Class (Output), (0 => Encodings.Space));
                  Output.Cursor := Output.Cursor + 1;
               end if;
               Write_Quoted (Output, Data, True);
               Output.Need_Blank := False;
               return;
            end if;
︙
913
914
915
916
917
918
919
920

921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940

941
942
943
944
945
946
947

917
918
919
920
921
922
923

924
925
926
927
928
929
930
931






932
933
934
935
936
937

938
939
940
941
942
943
944
945








-
+







-
-
-
-
-
-






-
+








               end;
         end case;

         if Output.Param.Quoted = When_Shorter
           and then Multi_Line_Quoted_Size (Output, Data) <= Size
         then
            if Output.Need_Blank then
               Output.Stream.Write ((0 => Encodings.Space));
               Write_Raw (Printer'Class (Output), (0 => Encodings.Space));
               Output.Cursor := Output.Cursor + 1;
            end if;
            Write_Quoted (Output, Data, False);
            Output.Need_Blank := False;
            return;
         end if;

--       if Output.Param.Quoted = When_Shorter then
--          String'Write (Output.Stream,
--            "{" & Count'Image (Size) & "|"
--            & Count'Image (Multi_Line_Quoted_Size (Output, Data)) & "}");
--       end if;

         if not At_Origin
           and then
           not Fit_In_Line (Output, Blank_Width + Screen_Offset (Size))
         then
            Newline (Output);
         elsif Output.Need_Blank then
            Output.Stream.Write ((0 => Encodings.Space));
            Write_Raw (Printer'Class (Output), (0 => Encodings.Space));
            Output.Cursor := Output.Cursor + 1;
         end if;

         case Output.Param.Fallback is
            when Base64 =>
               Write_Base64 (Output, Data);
            when Hexadecimal =>
︙
966
967
968
969
970
971
972
973

974
975
976
977
978
979
980

981
982
983
984
985
986
987

964
965
966
967
968
969
970

971
972
973
974
975
976
977

978
979
980
981
982
983
984
985








-
+






-
+








         Output.First := True;  --  inhibit extra space or newline
      end if;

      if not Output.First then
         if Output.Param.Newline_At (Output.Previous, Closing) then
            Newline (Output);
         elsif Output.Param.Space_At (Output.Previous, Closing) then
            Output.Stream.Write ((0 => Encodings.Space));
            Write_Raw (Printer'Class (Output), (0 => Encodings.Space));
            Output.Cursor := Output.Cursor + 1;
         end if;
      else
         Output.First := False;
      end if;

      Output.Stream.Write ((0 => Encodings.List_End));
      Write_Raw (Printer'Class (Output), (0 => Encodings.List_End));
      Output.Cursor := Output.Cursor + 1;
      Output.Previous := Closing;
      Output.Need_Blank := False;
   end Close_List;
︙
1100
1101
1102
1103
1104
1105
1106








1107

1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113








+
+
+
+
+
+
+
+


   procedure Set_Newline
     (Output : in out Printer;
      Newline : in Newline_Encoding) is
   begin
      Output.Param.Newline := Newline;
   end Set_Newline;


   overriding procedure Write_Raw
     (Output : in out Stream_Printer;
      Data : in Ada.Streams.Stream_Element_Array) is
   begin
      Output.Stream.Write (Data);
   end Write_Raw;

end Natools.S_Expressions.Printers.Pretty;

Modified src/natools-s_expressions-printers-pretty.ads from [19a4ff4e65] to [04d3c06d6b].

︙
54
55
56
57
58
59
60
61
62






63
64
65
66
67
68
69

54
55
56
57
58
59
60


61
62
63
64
65
66
67
68
69
70
71
72
73








-
-
+
+
+
+
+
+








      Char_Encoding : Character_Encoding;
      Fallback      : Atom_Encoding;
      Newline       : Newline_Encoding;
   end record;

   Canonical : constant Parameters;

   type Printer (Stream : access Ada.Streams.Root_Stream_Type'Class) is
     new Printers.Printer with private;
   type Printer is abstract limited new Printers.Printer with private;

   procedure Write_Raw
     (Output : in out Printer;
      Data : in Ada.Streams.Stream_Element_Array)
     is abstract;

   overriding procedure Open_List (Output : in out Printer);
   overriding procedure Append_Atom
     (Output : in out Printer;
      Data : in Atom);
   overriding procedure Close_List (Output : in out Printer);
︙
106
107
108
109
110
111
112




113
114
115
116

117
118
119
120
121
122
123

110
111
112
113
114
115
116
117
118
119
120
121
122


123
124
125
126
127
128
129
130








+
+
+
+


-
-
+








   procedure Set_Fallback
     (Output : in out Printer;
      Fallback : in Atom_Encoding);
   procedure Set_Newline
     (Output : in out Printer;
      Newline : in Newline_Encoding);


   type Stream_Printer (Stream : access Ada.Streams.Root_Stream_Type'Class) is
     limited new Printers.Printer with private;

private

   type Printer (Stream : access Ada.Streams.Root_Stream_Type'Class) is
     new Printers.Printer with record
   type Printer is abstract limited new Printers.Printer with record
      Param        : Parameters;
      Cursor       : Screen_Column := 1;
      Previous     : Entity;
      First        : Boolean := True;
      Indent_Level : Screen_Offset := 0;
      Need_Blank   : Boolean := False;
   end record;
︙
132
133
134
135
136
137
138
139







140

139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154









+
+
+
+
+
+
+


      Quoted        => No_Quoted,
      Token         => No_Token,
      Hex_Casing    => Encodings.Upper,  --  unused
      Quoted_Escape => Octal_Escape,  --  unused
      Char_Encoding => ASCII,  --  unused
      Fallback      => Verbatim,
      Newline       => LF);  --  unused

   type Stream_Printer (Stream : access Ada.Streams.Root_Stream_Type'Class) is
     new Printer with null record;

   overriding procedure Write_Raw
     (Output : in out Stream_Printer;
      Data : in Ada.Streams.Stream_Element_Array);

end Natools.S_Expressions.Printers.Pretty;

Modified tests/natools-s_expressions-printers-pretty-tests.adb from [c8351fae34] to [ec7ce81f68].

︙
41
42
43
44
45
46
47
48

49
50
51
52
53
54
55

41
42
43
44
45
46
47

48
49
50
51
52
53
54
55








-
+








     (Test : in out NT.Test;
      Param : in Parameters;
      Expected : in Atom) is
   begin
      declare
         Input, Output : aliased Test_Tools.Memory_Stream;
         Parser : Parsers.Stream_Parser (Input'Access);
         Pretty_Printer : Printer (Output'Access);
         Pretty_Printer : Stream_Printer (Output'Access);
      begin
         Input.Set_Data (Expected);
         Output.Set_Expected (Expected);
         Pretty_Printer.Set_Parameters (Param);
         Parser.Next;
         Transfer (Parser, Pretty_Printer);
         Output.Check_Stream (Test);
︙
135
136
137
138
139
140
141
142

143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161

162
163
164
165
166
167
168

135
136
137
138
139
140
141

142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160

161
162
163
164
165
166
167
168








-
+


















-
+








            Quoted_Escape => Hex_Escape,
            Char_Encoding => ASCII,
            Fallback => Hexadecimal,
            Newline => LF);
   begin
      declare
         Output : aliased Test_Tools.Memory_Stream;
         Pr : Printer (Output'Access);
         Pr : Stream_Printer (Output'Access);
      begin
         Output.Set_Expected (To_Atom ("(" & Latin_1.LF
            & "   #303132" & Latin_1.LF
            & "    333435" & Latin_1.LF
            & "    3637#)"));
         Pr.Set_Parameters (Param);

         Pr.Open_List;
         Pr.Append_Atom (To_Atom ("01234567"));
         Pr.Close_List;

         Output.Check_Stream (Test);
      end;

      Param.Fallback := Base64;

      declare
         Output : aliased Test_Tools.Memory_Stream;
         Pr : Printer (Output'Access);
         Pr : Stream_Printer (Output'Access);
      begin
         Output.Set_Expected (To_Atom ("(" & Latin_1.LF
            & "   |  YWJj" & Latin_1.LF
            & "      REVG" & Latin_1.LF
            & "      Z2hp" & Latin_1.LF
            & "      SktM" & Latin_1.LF
            & "   |)"));
︙
180
181
182
183
184
185
186
187

188
189
190
191
192
193
194

180
181
182
183
184
185
186

187
188
189
190
191
192
193
194








-
+










   procedure Basic_Printing (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Basic printing");
   begin
      declare
         Output : aliased Test_Tools.Memory_Stream;
         P : Printer (Output'Access);
         P : Stream_Printer (Output'Access);
      begin
         Output.Set_Expected (To_Atom ("(7:command(6:subarg)3:arg)3:end"));
         P.Set_Parameters (Canonical);

         P.Open_List;
         P.Append_Atom (To_Atom ("command"));
         P.Open_List;
︙
257
258
259
260
261
262
263
264

265
266

267
268
269
270
271
272
273

257
258
259
260
261
262
263

264
265

266
267
268
269
270
271
272
273








-
+

-
+








      when Error : others => Test.Report_Exception (Error);
   end Indentation;


   procedure Newline_Formats (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Newline formats");

      procedure Print (Pr : in out Printer);
      procedure Print (Pr : in out Stream_Printer);

      procedure Print (Pr : in out Printer) is
      procedure Print (Pr : in out Stream_Printer) is
      begin
         Pr.Open_List;
         Pr.Append_Atom (To_Atom ("begin"));
         Pr.Append_Atom (To_Atom
           ("quoted" & Latin_1.CR & Latin_1.LF & Latin_1.CR & "str"));
         Pr.Close_List;
      end Print;
︙
287
288
289
290
291
292
293
294

295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311

312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327

328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343

344
345
346
347
348
349
350

287
288
289
290
291
292
293

294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310

311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326

327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342

343
344
345
346
347
348
349
350








-
+
















-
+















-
+















-
+








            Fallback => Hexadecimal,
            Newline => CR);
   begin
      Param.Newline_At (Atom_Data, Atom_Data) := True;

      declare
         Output : aliased Test_Tools.Memory_Stream;
         Pr : Printer (Output'Access);
         Pr : Stream_Printer (Output'Access);
      begin
         Pr.Set_Parameters (Param);
         Output.Set_Expected (To_Atom
           ("(begin" & Latin_1.CR
            & " ""quot\" & Latin_1.CR
            & "ed" & Latin_1.CR
            & "\n" & Latin_1.CR
            & "str"")"));
         Print (Pr);
         Output.Check_Stream (Test);
      end;

      Param.Newline := LF;

      declare
         Output : aliased Test_Tools.Memory_Stream;
         Pr : Printer (Output'Access);
         Pr : Stream_Printer (Output'Access);
      begin
         Pr.Set_Parameters (Param);
         Output.Set_Expected (To_Atom
           ("(begin" & Latin_1.LF
            & " ""quot\" & Latin_1.LF
            & "ed\r" & Latin_1.LF
            & "\rstr"")"));
         Print (Pr);
         Output.Check_Stream (Test);
      end;

      Param.Newline := CR_LF;

      declare
         Output : aliased Test_Tools.Memory_Stream;
         Pr : Printer (Output'Access);
         Pr : Stream_Printer (Output'Access);
      begin
         Pr.Set_Parameters (Param);
         Output.Set_Expected (To_Atom
           ("(begin" & Latin_1.CR & Latin_1.LF
            & " ""quot\" & Latin_1.CR & Latin_1.LF
            & "ed" & Latin_1.CR & Latin_1.LF
            & "\rstr"")"));
         Print (Pr);
         Output.Check_Stream (Test);
      end;

      Param.Newline := LF_CR;

      declare
         Output : aliased Test_Tools.Memory_Stream;
         Pr : Printer (Output'Access);
         Pr : Stream_Printer (Output'Access);
      begin
         Pr.Set_Parameters (Param);
         Output.Set_Expected (To_Atom
           ("(begin" & Latin_1.LF & Latin_1.CR
            & " ""quot\" & Latin_1.LF & Latin_1.CR
            & "ed\r" & Latin_1.LF & Latin_1.CR
            & "str"")"));
︙
385
386
387
388
389
390
391
392

393
394
395
396
397
398
399

385
386
387
388
389
390
391

392
393
394
395
396
397
398
399








-
+








            Quoted_Escape => Hex_Escape,
            Char_Encoding => UTF_8,
            Fallback => Hexadecimal,
            Newline => CR_LF);
   begin
      declare
         Output : aliased Test_Tools.Memory_Stream;
         Pr : Printer (Output'Access);
         Pr : Stream_Printer (Output'Access);
      begin
         Pr.Set_Parameters (Initial);

         Pr.Set_Width (Final.Width);
         Pr.Set_Newline_At (Final.Newline_At);
         Pr.Set_Space_At (Final.Space_At);
         Pr.Set_Tab_Stop (Final.Tab_Stop);
︙
460
461
462
463
464
465
466
467

468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483

484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503

504
505
506
507
508
509
510

460
461
462
463
464
465
466

467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482

483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502

503
504
505
506
507
508
509
510








-
+















-
+



















-
+








            Quoted_Escape => Hex_Escape,
            Char_Encoding => ASCII,
            Fallback => Hexadecimal,
            Newline => CR_LF);
   begin
      declare
         Output : aliased Test_Tools.Memory_Stream;
         Pr : Printer (Output'Access);
         Pr : Stream_Printer (Output'Access);
      begin
         --  Check that the first quoted string encoding is exactly as long as
         --  fallback (hexadecimal) encoding, by trying with one less char.
         Output.Set_Expected
           (Encodings.Hex_Atom_Begin
            & Encodings.Encode_Hex
               (Source (Source'First + 1 .. Source'Last), Param.Hex_Casing)
            & Encodings.Hex_Atom_End);
         Pr.Set_Parameters (Param);
         Pr.Append_Atom (Source (Source'First + 1 .. Source'Last));
         Output.Check_Stream (Test);
      end;

      declare
         Output : aliased Test_Tools.Memory_Stream;
         Pr : Printer (Output'Access);
         Pr : Stream_Printer (Output'Access);
      begin
         Output.Set_Expected (To_Atom
           ("""Special: \b\t\n\v\f\r\\\""\x00"
            & "UTF-8 sequences: \xC3\xA9, \xE2\x88\x92, \xF0\x9F\x81\xA1, "
            & "\xF9\x88\xB4\x95\xA7, \xFD\xB6\x95\x83\x88\x90"
            & "Invalid UTF-8 sequences: "
            & "\xAA, \xC3, \xE2\x88, \xF0\x9F\x81, \xF9\x88\xB4\x95, "
            & "\xFD\xB6\x95\x83\x88, \xFE." & Latin_1.CR & Latin_1.LF
            & "<>\r\n"""));
         Pr.Set_Parameters (Param);
         Pr.Append_Atom (Source);
         Output.Check_Stream (Test);
      end;

      Param.Char_Encoding := Latin;
      Param.Hex_Casing := Encodings.Lower;

      declare
         Output : aliased Test_Tools.Memory_Stream;
         Pr : Printer (Output'Access);
         Pr : Stream_Printer (Output'Access);
      begin
         Output.Set_Expected (To_Atom
           ("""Special: \b\t\n\v\f\r\\\""\x00"
            & "UTF-8 sequences: "
            & Character'Val (16#C3#) & Character'Val (16#A9#)
            & ", " & Character'Val (16#E2#) & "\x88\x92, "
            & Character'Val (16#F0#) & "\x9f\x81"
︙
531
532
533
534
535
536
537
538

539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556

557
558
559
560
561
562
563

531
532
533
534
535
536
537

538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555

556
557
558
559
560
561
562
563








-
+

















-
+








      end;

      Param.Char_Encoding := UTF_8;
      Param.Quoted_Escape := Octal_Escape;

      declare
         Output : aliased Test_Tools.Memory_Stream;
         Pr : Printer (Output'Access);
         Pr : Stream_Printer (Output'Access);
      begin
         Output.Set_Expected (To_Atom ("""Special: \b\t\n\v\f\r\\\""\000")
            & Source (18 .. 62)
            & To_Atom ("Invalid UTF-8 sequences: "
               & "\252, \303, \342\210, \360\237\201, "
               & "\371\210\264\225, \375\266\225\203\210, \376."
               & Latin_1.CR & Latin_1.LF
               & "<>\r\n"""));
         Pr.Set_Parameters (Param);
         Pr.Append_Atom (Source);
         Output.Check_Stream (Test);
      end;

      Param.Width := 31;

      declare
         Output : aliased Test_Tools.Memory_Stream;
         Pr : Printer (Output'Access);
         Pr : Stream_Printer (Output'Access);
      begin
         Output.Set_Expected (To_Atom ("""Special: \b\t\n\v\f\r\\\""\000"
                                 & '\' & Latin_1.CR & Latin_1.LF)
            & Source (18 .. 62)
            & To_Atom ('\' & Latin_1.CR & Latin_1.LF
               & "Invalid UTF-8 sequences: \252,\" & Latin_1.CR & Latin_1.LF
               & " \303, \342\210, \360\237\201,\" & Latin_1.CR & Latin_1.LF
︙
571
572
573
574
575
576
577
578

579
580

581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599

600
601
602
603
604
605
606
607
608
609
610
611

612
613
614
615
616
617
618
619
620
621
622
623
624
625

626
627
628
629
630
631
632

571
572
573
574
575
576
577

578
579

580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598

599
600
601
602
603
604
605
606
607
608
609
610

611
612
613
614
615
616
617
618
619
620
621
622
623
624

625
626
627
628
629
630
631
632








-
+

-
+


















-
+











-
+













-
+








      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Quoted_String_Escapes;


   procedure Separators (Report : in out NT.Reporter'Class) is
      procedure Test_Exp (Pr : in out Printer);
      procedure Test_Exp (Pr : in out Stream_Printer);

      procedure Test_Exp (Pr : in out Printer) is
      procedure Test_Exp (Pr : in out Stream_Printer) is
      begin
         Pr.Append_Atom (To_Atom ("begin"));
         Pr.Open_List;
         Pr.Open_List;
         Pr.Close_List;
         Pr.Open_List;
         Pr.Append_Atom (To_Atom ("head"));
         Pr.Append_Atom (To_Atom ("tail"));
         Pr.Close_List;
         Pr.Close_List;
         Pr.Append_Atom (To_Atom ("end"));
      end Test_Exp;

      Test : NT.Test := Report.Item ("Separators");
      Param : Parameters := Canonical;
   begin
      declare
         Output : aliased Test_Tools.Memory_Stream;
         Pr : Printer (Output'Access);
         Pr : Stream_Printer (Output'Access);
      begin
         Output.Set_Expected (To_Atom ("5:begin(()(4:head4:tail))3:end"));
         Pr.Set_Parameters (Param);
         Test_Exp (Pr);
         Output.Check_Stream (Test);
      end;

      Param.Space_At := (others => (others => True));

      declare
         Output : aliased Test_Tools.Memory_Stream;
         Pr : Printer (Output'Access);
         Pr : Stream_Printer (Output'Access);
      begin
         Output.Set_Expected
           (To_Atom ("5:begin ( ( ) ( 4:head 4:tail ) ) 3:end"));
         Pr.Set_Parameters (Param);
         Test_Exp (Pr);
         Output.Check_Stream (Test);
      end;

      Param.Newline_At := (others => (others => True));
      Param.Newline := LF;

      declare
         Output : aliased Test_Tools.Memory_Stream;
         Pr : Printer (Output'Access);
         Pr : Stream_Printer (Output'Access);
      begin
         Output.Set_Expected (To_Atom ("5:begin" & Latin_1.LF
           & '(' & Latin_1.LF
           & '(' & Latin_1.LF
           & ')' & Latin_1.LF
           & '(' & Latin_1.LF
           & "4:head" & Latin_1.LF
︙
645
646
647
648
649
650
651
652

653
654
655
656
657
658
659

645
646
647
648
649
650
651

652
653
654
655
656
657
658
659








-
+









   procedure Token_Separation (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Token separation");
      Token : constant Atom := To_Atom ("token");
   begin
      declare
         Output : aliased Test_Tools.Memory_Stream;
         Pr : Printer (Output'Access);
         Pr : Stream_Printer (Output'Access);
      begin
         Output.Set_Expected (To_Atom
           ("(begin(token ""quoted\n""token token #4865780A#token "
            & "|QmFzZS02NAo=|token)end)"));
         Pr.Set_Parameters
          ((Width => 0,
            Newline_At => (others => (others => False)),
︙

This page was generated in about 0.006s by Fossil 2.23 [47362306a7] 2023-11-01 18:56:47