OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-wtedit.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                        GNAT RUN-TIME COMPONENTS                          --
4
--                                                                          --
5
--             A D A . W I D E _ T E X T _ I O . E D I T I N G              --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
10
--                                                                          --
11
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
17
--                                                                          --
18
-- As a special exception under Section 7 of GPL version 3, you are granted --
19
-- additional permissions described in the GCC Runtime Library Exception,   --
20
-- version 3.1, as published by the Free Software Foundation.               --
21
--                                                                          --
22
-- You should have received a copy of the GNU General Public License and    --
23
-- a copy of the GCC Runtime Library Exception along with this program;     --
24
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
27
-- GNAT was originally developed  by the GNAT team at  New York University. --
28
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
29
--                                                                          --
30
------------------------------------------------------------------------------
31
 
32
with Ada.Strings.Fixed;
33
with Ada.Strings.Wide_Fixed;
34
 
35
package body Ada.Wide_Text_IO.Editing is
36
 
37
   package Strings            renames Ada.Strings;
38
   package Strings_Fixed      renames Ada.Strings.Fixed;
39
   package Strings_Wide_Fixed renames Ada.Strings.Wide_Fixed;
40
   package Wide_Text_IO       renames Ada.Wide_Text_IO;
41
 
42
   -----------------------
43
   -- Local_Subprograms --
44
   -----------------------
45
 
46
   function To_Wide (C : Character) return Wide_Character;
47
   pragma Inline (To_Wide);
48
   --  Convert Character to corresponding Wide_Character
49
 
50
   ---------------------
51
   -- Blank_When_Zero --
52
   ---------------------
53
 
54
   function Blank_When_Zero (Pic : Picture) return Boolean is
55
   begin
56
      return Pic.Contents.Original_BWZ;
57
   end Blank_When_Zero;
58
 
59
   --------------------
60
   -- Decimal_Output --
61
   --------------------
62
 
63
   package body Decimal_Output is
64
 
65
      -----------
66
      -- Image --
67
      -----------
68
 
69
      function Image
70
        (Item       : Num;
71
         Pic        : Picture;
72
         Currency   : Wide_String    := Default_Currency;
73
         Fill       : Wide_Character := Default_Fill;
74
         Separator  : Wide_Character := Default_Separator;
75
         Radix_Mark : Wide_Character := Default_Radix_Mark) return Wide_String
76
      is
77
      begin
78
         return Format_Number
79
            (Pic.Contents, Num'Image (Item),
80
             Currency, Fill, Separator, Radix_Mark);
81
      end Image;
82
 
83
      ------------
84
      -- Length --
85
      ------------
86
 
87
      function Length
88
        (Pic      : Picture;
89
         Currency : Wide_String := Default_Currency) return Natural
90
      is
91
         Picstr     : constant String := Pic_String (Pic);
92
         V_Adjust   : Integer := 0;
93
         Cur_Adjust : Integer := 0;
94
 
95
      begin
96
         --  Check if Picstr has 'V' or '$'
97
 
98
         --  If 'V', then length is 1 less than otherwise
99
 
100
         --  If '$', then length is Currency'Length-1 more than otherwise
101
 
102
         --  This should use the string handling package ???
103
 
104
         for J in Picstr'Range loop
105
            if Picstr (J) = 'V' then
106
               V_Adjust := -1;
107
 
108
            elsif Picstr (J) = '$' then
109
               Cur_Adjust := Currency'Length - 1;
110
            end if;
111
         end loop;
112
 
113
         return Picstr'Length - V_Adjust + Cur_Adjust;
114
      end Length;
115
 
116
      ---------
117
      -- Put --
118
      ---------
119
 
120
      procedure Put
121
        (File       : Wide_Text_IO.File_Type;
122
         Item       : Num;
123
         Pic        : Picture;
124
         Currency   : Wide_String    := Default_Currency;
125
         Fill       : Wide_Character := Default_Fill;
126
         Separator  : Wide_Character := Default_Separator;
127
         Radix_Mark : Wide_Character := Default_Radix_Mark)
128
      is
129
      begin
130
         Wide_Text_IO.Put (File, Image (Item, Pic,
131
                                   Currency, Fill, Separator, Radix_Mark));
132
      end Put;
133
 
134
      procedure Put
135
        (Item       : Num;
136
         Pic        : Picture;
137
         Currency   : Wide_String    := Default_Currency;
138
         Fill       : Wide_Character := Default_Fill;
139
         Separator  : Wide_Character := Default_Separator;
140
         Radix_Mark : Wide_Character := Default_Radix_Mark)
141
      is
142
      begin
143
         Wide_Text_IO.Put (Image (Item, Pic,
144
                             Currency, Fill, Separator, Radix_Mark));
145
      end Put;
146
 
147
      procedure Put
148
        (To         : out Wide_String;
149
         Item       : Num;
150
         Pic        : Picture;
151
         Currency   : Wide_String    := Default_Currency;
152
         Fill       : Wide_Character := Default_Fill;
153
         Separator  : Wide_Character := Default_Separator;
154
         Radix_Mark : Wide_Character := Default_Radix_Mark)
155
      is
156
         Result : constant Wide_String :=
157
           Image (Item, Pic, Currency, Fill, Separator, Radix_Mark);
158
 
159
      begin
160
         if Result'Length > To'Length then
161
            raise Wide_Text_IO.Layout_Error;
162
         else
163
            Strings_Wide_Fixed.Move (Source => Result, Target => To,
164
                                     Justify => Strings.Right);
165
         end if;
166
      end Put;
167
 
168
      -----------
169
      -- Valid --
170
      -----------
171
 
172
      function Valid
173
        (Item     : Num;
174
         Pic      : Picture;
175
         Currency : Wide_String := Default_Currency) return Boolean
176
      is
177
      begin
178
         declare
179
            Temp : constant Wide_String := Image (Item, Pic, Currency);
180
            pragma Warnings (Off, Temp);
181
         begin
182
            return True;
183
         end;
184
 
185
      exception
186
         when Layout_Error => return False;
187
 
188
      end Valid;
189
   end Decimal_Output;
190
 
191
   ------------
192
   -- Expand --
193
   ------------
194
 
195
   function Expand (Picture : String) return String is
196
      Result        : String (1 .. MAX_PICSIZE);
197
      Picture_Index : Integer := Picture'First;
198
      Result_Index  : Integer := Result'First;
199
      Count         : Natural;
200
      Last          : Integer;
201
 
202
   begin
203
      if Picture'Length < 1 then
204
         raise Picture_Error;
205
      end if;
206
 
207
      if Picture (Picture'First) = '(' then
208
         raise Picture_Error;
209
      end if;
210
 
211
      loop
212
         case Picture (Picture_Index) is
213
 
214
            when '(' =>
215
 
216
               --  We now need to scan out the count after a left paren. In
217
               --  the non-wide version we used Integer_IO.Get, but that is
218
               --  not convenient here, since we don't want to drag in normal
219
               --  Text_IO just for this purpose. So we do the scan ourselves,
220
               --  with the normal validity checks.
221
 
222
               Last := Picture_Index + 1;
223
               Count := 0;
224
 
225
               if Picture (Last) not in '0' .. '9' then
226
                  raise Picture_Error;
227
               end if;
228
 
229
               Count := Character'Pos (Picture (Last)) - Character'Pos ('0');
230
               Last := Last + 1;
231
 
232
               loop
233
                  if Last > Picture'Last then
234
                     raise Picture_Error;
235
                  end if;
236
 
237
                  if Picture (Last) = '_' then
238
                     if Picture (Last - 1) = '_' then
239
                        raise Picture_Error;
240
                     end if;
241
 
242
                  elsif Picture (Last) = ')' then
243
                     exit;
244
 
245
                  elsif Picture (Last) not in '0' .. '9' then
246
                     raise Picture_Error;
247
 
248
                  else
249
                     Count := Count * 10
250
                                +  Character'Pos (Picture (Last)) -
251
                                   Character'Pos ('0');
252
                  end if;
253
 
254
                  Last := Last + 1;
255
               end loop;
256
 
257
               --  In what follows note that one copy of the repeated
258
               --  character has already been made, so a count of one is
259
               --  no-op, and a count of zero erases a character.
260
 
261
               for J in 2 .. Count loop
262
                  Result (Result_Index + J - 2) := Picture (Picture_Index - 1);
263
               end loop;
264
 
265
               Result_Index := Result_Index + Count - 1;
266
 
267
               --  Last was a ')' throw it away too
268
 
269
               Picture_Index := Last + 1;
270
 
271
            when ')' =>
272
               raise Picture_Error;
273
 
274
            when others =>
275
               Result (Result_Index) := Picture (Picture_Index);
276
               Picture_Index := Picture_Index + 1;
277
               Result_Index := Result_Index + 1;
278
 
279
         end case;
280
 
281
         exit when Picture_Index > Picture'Last;
282
      end loop;
283
 
284
      return Result (1 .. Result_Index - 1);
285
 
286
   exception
287
      when others =>
288
         raise Picture_Error;
289
   end Expand;
290
 
291
   -------------------
292
   -- Format_Number --
293
   -------------------
294
 
295
   function Format_Number
296
     (Pic                 : Format_Record;
297
      Number              : String;
298
      Currency_Symbol     : Wide_String;
299
      Fill_Character      : Wide_Character;
300
      Separator_Character : Wide_Character;
301
      Radix_Point         : Wide_Character) return Wide_String
302
   is
303
      Attrs    : Number_Attributes := Parse_Number_String (Number);
304
      Position : Integer;
305
      Rounded  : String := Number;
306
 
307
      Sign_Position : Integer := Pic.Sign_Position; --  may float.
308
 
309
      Answer       : Wide_String (1 .. Pic.Picture.Length);
310
      Last         : Integer;
311
      Currency_Pos : Integer := Pic.Start_Currency;
312
 
313
      Dollar : Boolean := False;
314
      --  Overridden immediately if necessary
315
 
316
      Zero : Boolean := True;
317
      --  Set to False when a non-zero digit is output
318
 
319
   begin
320
 
321
      --  If the picture has fewer decimal places than the number, the image
322
      --  must be rounded according to the usual rules.
323
 
324
      if Attrs.Has_Fraction then
325
         declare
326
            R : constant Integer :=
327
              (Attrs.End_Of_Fraction - Attrs.Start_Of_Fraction + 1)
328
                - Pic.Max_Trailing_Digits;
329
            R_Pos : Integer;
330
 
331
         begin
332
            if R > 0 then
333
               R_Pos := Rounded'Length - R;
334
 
335
               if Rounded (R_Pos + 1) > '4' then
336
 
337
                  if Rounded (R_Pos) = '.' then
338
                     R_Pos := R_Pos - 1;
339
                  end if;
340
 
341
                  if Rounded (R_Pos) /= '9' then
342
                     Rounded (R_Pos) := Character'Succ (Rounded (R_Pos));
343
                  else
344
                     Rounded (R_Pos) := '0';
345
                     R_Pos := R_Pos - 1;
346
 
347
                     while R_Pos > 1 loop
348
                        if Rounded (R_Pos) = '.' then
349
                           R_Pos := R_Pos - 1;
350
                        end if;
351
 
352
                        if Rounded (R_Pos) /= '9' then
353
                           Rounded (R_Pos) := Character'Succ (Rounded (R_Pos));
354
                           exit;
355
                        else
356
                           Rounded (R_Pos) := '0';
357
                           R_Pos := R_Pos - 1;
358
                        end if;
359
                     end loop;
360
 
361
                     --  The rounding may add a digit in front. Either the
362
                     --  leading blank or the sign (already captured) can be
363
                     --  overwritten.
364
 
365
                     if R_Pos = 1 then
366
                        Rounded (R_Pos) := '1';
367
                        Attrs.Start_Of_Int := Attrs.Start_Of_Int - 1;
368
                     end if;
369
                  end if;
370
               end if;
371
            end if;
372
         end;
373
      end if;
374
 
375
      for J in Answer'Range loop
376
         Answer (J) := To_Wide (Pic.Picture.Expanded (J));
377
      end loop;
378
 
379
      if Pic.Start_Currency /= Invalid_Position then
380
         Dollar := Answer (Pic.Start_Currency) = '$';
381
      end if;
382
 
383
      --  Fix up "direct inserts" outside the playing field. Set up as one
384
      --  loop to do the beginning, one (reverse) loop to do the end.
385
 
386
      Last := 1;
387
      loop
388
         exit when Last = Pic.Start_Float;
389
         exit when Last = Pic.Radix_Position;
390
         exit when Answer (Last) = '9';
391
 
392
         case Answer (Last) is
393
 
394
            when '_' =>
395
               Answer (Last) := Separator_Character;
396
 
397
            when 'b' =>
398
               Answer (Last) := ' ';
399
 
400
            when others =>
401
               null;
402
 
403
         end case;
404
 
405
         exit when Last = Answer'Last;
406
 
407
         Last := Last + 1;
408
      end loop;
409
 
410
      --  Now for the end...
411
 
412
      for J in reverse Last .. Answer'Last loop
413
         exit when J = Pic.Radix_Position;
414
 
415
         --  Do this test First, Separator_Character can equal Pic.Floater
416
 
417
         if Answer (J) = Pic.Floater then
418
            exit;
419
         end if;
420
 
421
         case Answer (J) is
422
 
423
            when '_' =>
424
               Answer (J) := Separator_Character;
425
 
426
            when 'b' =>
427
               Answer (J) := ' ';
428
 
429
            when '9' =>
430
               exit;
431
 
432
            when others =>
433
               null;
434
 
435
         end case;
436
      end loop;
437
 
438
      --  Non-floating sign
439
 
440
      if Pic.Start_Currency /= -1
441
        and then Answer (Pic.Start_Currency) = '#'
442
        and then Pic.Floater /= '#'
443
      then
444
         if Currency_Symbol'Length >
445
            Pic.End_Currency - Pic.Start_Currency + 1
446
         then
447
            raise Picture_Error;
448
 
449
         elsif Currency_Symbol'Length =
450
            Pic.End_Currency - Pic.Start_Currency + 1
451
         then
452
            Answer (Pic.Start_Currency .. Pic.End_Currency) :=
453
              Currency_Symbol;
454
 
455
         elsif Pic.Radix_Position = Invalid_Position
456
           or else Pic.Start_Currency < Pic.Radix_Position
457
         then
458
            Answer (Pic.Start_Currency .. Pic.End_Currency) :=
459
                                                        (others => ' ');
460
            Answer (Pic.End_Currency - Currency_Symbol'Length + 1 ..
461
                    Pic.End_Currency) := Currency_Symbol;
462
 
463
         else
464
            Answer (Pic.Start_Currency .. Pic.End_Currency) :=
465
                                                        (others => ' ');
466
            Answer (Pic.Start_Currency ..
467
                    Pic.Start_Currency + Currency_Symbol'Length - 1) :=
468
                                                        Currency_Symbol;
469
         end if;
470
      end if;
471
 
472
      --  Fill in leading digits
473
 
474
      if Attrs.End_Of_Int - Attrs.Start_Of_Int + 1 >
475
                                                Pic.Max_Leading_Digits
476
      then
477
         raise Layout_Error;
478
      end if;
479
 
480
      Position :=
481
        (if Pic.Radix_Position = Invalid_Position then Answer'Last
482
         else Pic.Radix_Position - 1);
483
 
484
      for J in reverse Attrs.Start_Of_Int .. Attrs.End_Of_Int loop
485
         while Answer (Position) /= '9'
486
                 and then
487
               Answer (Position) /= Pic.Floater
488
         loop
489
            if Answer (Position) = '_' then
490
               Answer (Position) := Separator_Character;
491
            elsif Answer (Position) = 'b' then
492
               Answer (Position) := ' ';
493
            end if;
494
 
495
            Position := Position - 1;
496
         end loop;
497
 
498
         Answer (Position) := To_Wide (Rounded (J));
499
 
500
         if Rounded (J) /= '0' then
501
            Zero := False;
502
         end if;
503
 
504
         Position := Position - 1;
505
      end loop;
506
 
507
      --  Do lead float
508
 
509
      if Pic.Start_Float = Invalid_Position then
510
 
511
         --  No leading floats, but need to change '9' to '0', '_' to
512
         --  Separator_Character and 'b' to ' '.
513
 
514
         for J in Last .. Position loop
515
 
516
            --  Last set when fixing the "uninteresting" leaders above.
517
            --  Don't duplicate the work.
518
 
519
            if Answer (J) = '9' then
520
               Answer (J) := '0';
521
 
522
            elsif Answer (J) = '_' then
523
               Answer (J) := Separator_Character;
524
 
525
            elsif Answer (J) = 'b' then
526
               Answer (J) := ' ';
527
 
528
            end if;
529
 
530
         end loop;
531
 
532
      elsif Pic.Floater = '<'
533
              or else
534
            Pic.Floater = '+'
535
              or else
536
            Pic.Floater = '-'
537
      then
538
         for J in Pic.End_Float .. Position loop --  May be null range
539
            if Answer (J) = '9' then
540
               Answer (J) := '0';
541
 
542
            elsif Answer (J) = '_' then
543
               Answer (J) := Separator_Character;
544
 
545
            elsif Answer (J) = 'b' then
546
               Answer (J) := ' ';
547
 
548
            end if;
549
         end loop;
550
 
551
         if Position > Pic.End_Float then
552
            Position := Pic.End_Float;
553
         end if;
554
 
555
         for J in Pic.Start_Float .. Position - 1 loop
556
            Answer (J) := ' ';
557
         end loop;
558
 
559
         Answer (Position) := Pic.Floater;
560
         Sign_Position     := Position;
561
 
562
      elsif Pic.Floater = '$' then
563
 
564
         for J in Pic.End_Float .. Position loop --  May be null range
565
            if Answer (J) = '9' then
566
               Answer (J) := '0';
567
 
568
            elsif Answer (J) = '_' then
569
               Answer (J) := ' ';   --  no separator before leftmost digit
570
 
571
            elsif Answer (J) = 'b' then
572
               Answer (J) := ' ';
573
            end if;
574
         end loop;
575
 
576
         if Position > Pic.End_Float then
577
            Position := Pic.End_Float;
578
         end if;
579
 
580
         for J in Pic.Start_Float .. Position - 1 loop
581
            Answer (J) := ' ';
582
         end loop;
583
 
584
         Answer (Position) := Pic.Floater;
585
         Currency_Pos      := Position;
586
 
587
      elsif Pic.Floater = '*' then
588
 
589
         for J in Pic.End_Float .. Position loop --  May be null range
590
            if Answer (J) = '9' then
591
               Answer (J) := '0';
592
 
593
            elsif Answer (J) = '_' then
594
               Answer (J) := Separator_Character;
595
 
596
            elsif Answer (J) = 'b' then
597
               Answer (J) := '*';
598
            end if;
599
         end loop;
600
 
601
         if Position > Pic.End_Float then
602
            Position := Pic.End_Float;
603
         end if;
604
 
605
         for J in Pic.Start_Float .. Position loop
606
            Answer (J) := '*';
607
         end loop;
608
 
609
      else
610
         if Pic.Floater = '#' then
611
            Currency_Pos := Currency_Symbol'Length;
612
         end if;
613
 
614
         for J in reverse Pic.Start_Float .. Position loop
615
            case Answer (J) is
616
 
617
               when '*' =>
618
                  Answer (J) := Fill_Character;
619
 
620
               when 'Z' | 'b' | '/' | '0' =>
621
                  Answer (J) := ' ';
622
 
623
               when '9' =>
624
                  Answer (J) := '0';
625
 
626
               when '.' | 'V' | 'v' | '<' | '$' | '+' | '-' =>
627
                  null;
628
 
629
               when '#' =>
630
                  if Currency_Pos = 0 then
631
                     Answer (J) := ' ';
632
                  else
633
                     Answer (J)   := Currency_Symbol (Currency_Pos);
634
                     Currency_Pos := Currency_Pos - 1;
635
                  end if;
636
 
637
               when '_' =>
638
 
639
                  case Pic.Floater is
640
 
641
                     when '*' =>
642
                        Answer (J) := Fill_Character;
643
 
644
                     when 'Z' | 'b' =>
645
                        Answer (J) := ' ';
646
 
647
                     when '#' =>
648
                        if Currency_Pos = 0 then
649
                           Answer (J) := ' ';
650
 
651
                        else
652
                           Answer (J)   := Currency_Symbol (Currency_Pos);
653
                           Currency_Pos := Currency_Pos - 1;
654
                        end if;
655
 
656
                     when others =>
657
                        null;
658
 
659
                  end case;
660
 
661
               when others =>
662
                  null;
663
 
664
            end case;
665
         end loop;
666
 
667
         if Pic.Floater = '#' and then Currency_Pos /= 0 then
668
            raise Layout_Error;
669
         end if;
670
      end if;
671
 
672
      --  Do sign
673
 
674
      if Sign_Position = Invalid_Position then
675
         if Attrs.Negative then
676
            raise Layout_Error;
677
         end if;
678
 
679
      else
680
         if Attrs.Negative then
681
            case Answer (Sign_Position) is
682
               when 'C' | 'D' | '-' =>
683
                  null;
684
 
685
               when '+' =>
686
                  Answer (Sign_Position) := '-';
687
 
688
               when '<' =>
689
                  Answer (Sign_Position)   := '(';
690
                  Answer (Pic.Second_Sign) := ')';
691
 
692
               when others =>
693
                  raise Picture_Error;
694
 
695
            end case;
696
 
697
         else --  positive
698
 
699
            case Answer (Sign_Position) is
700
 
701
               when '-' =>
702
                  Answer (Sign_Position) := ' ';
703
 
704
               when '<' | 'C' | 'D' =>
705
                  Answer (Sign_Position)   := ' ';
706
                  Answer (Pic.Second_Sign) := ' ';
707
 
708
               when '+' =>
709
                  null;
710
 
711
               when others =>
712
                  raise Picture_Error;
713
 
714
            end case;
715
         end if;
716
      end if;
717
 
718
      --  Fill in trailing digits
719
 
720
      if Pic.Max_Trailing_Digits > 0 then
721
 
722
         if Attrs.Has_Fraction then
723
            Position := Attrs.Start_Of_Fraction;
724
            Last     := Pic.Radix_Position + 1;
725
 
726
            for J in Last .. Answer'Last loop
727
 
728
               if Answer (J) = '9' or else Answer (J) = Pic.Floater then
729
                  Answer (J) := To_Wide (Rounded (Position));
730
 
731
                  if Rounded (Position) /= '0' then
732
                     Zero := False;
733
                  end if;
734
 
735
                  Position := Position + 1;
736
                  Last     := J + 1;
737
 
738
                  --  Used up fraction but remember place in Answer
739
 
740
                  exit when Position > Attrs.End_Of_Fraction;
741
 
742
               elsif Answer (J) = 'b' then
743
                  Answer (J) := ' ';
744
 
745
               elsif Answer (J) = '_' then
746
                  Answer (J) := Separator_Character;
747
 
748
               end if;
749
 
750
               Last := J + 1;
751
            end loop;
752
 
753
            Position := Last;
754
 
755
         else
756
            Position := Pic.Radix_Position + 1;
757
         end if;
758
 
759
         --  Now fill remaining 9's with zeros and _ with separators
760
 
761
         Last := Answer'Last;
762
 
763
         for J in Position .. Last loop
764
            if Answer (J) = '9' then
765
               Answer (J) := '0';
766
 
767
            elsif Answer (J) = Pic.Floater then
768
               Answer (J) := '0';
769
 
770
            elsif Answer (J) = '_' then
771
               Answer (J) := Separator_Character;
772
 
773
            elsif Answer (J) = 'b' then
774
               Answer (J) := ' ';
775
 
776
            end if;
777
         end loop;
778
 
779
         Position := Last + 1;
780
 
781
      else
782
         if Pic.Floater = '#' and then Currency_Pos /= 0 then
783
            raise Layout_Error;
784
         end if;
785
 
786
         --  No trailing digits, but now J may need to stick in a currency
787
         --  symbol or sign.
788
 
789
         Position :=
790
           (if Pic.Start_Currency = Invalid_Position then Answer'Last + 1
791
            else Pic.Start_Currency);
792
      end if;
793
 
794
      for J in Position .. Answer'Last loop
795
         if Pic.Start_Currency /= Invalid_Position and then
796
            Answer (Pic.Start_Currency) = '#' then
797
            Currency_Pos := 1;
798
         end if;
799
 
800
         --  Note: There are some weird cases J can imagine with 'b' or '#' in
801
         --  currency strings where the following code will cause glitches. The
802
         --  trick is to tell when the character in the answer should be
803
         --  checked, and when to look at the original string. Some other time.
804
         --  RIE 11/26/96 ???
805
 
806
         case Answer (J) is
807
            when '*' =>
808
               Answer (J) := Fill_Character;
809
 
810
            when 'b' =>
811
               Answer (J) := ' ';
812
 
813
            when '#' =>
814
               if Currency_Pos > Currency_Symbol'Length then
815
                  Answer (J) := ' ';
816
 
817
               else
818
                  Answer (J)   := Currency_Symbol (Currency_Pos);
819
                  Currency_Pos := Currency_Pos + 1;
820
               end if;
821
 
822
            when '_' =>
823
 
824
               case Pic.Floater is
825
 
826
                  when '*' =>
827
                     Answer (J) := Fill_Character;
828
 
829
                  when 'Z' | 'z' =>
830
                     Answer (J) := ' ';
831
 
832
                  when '#' =>
833
                     if Currency_Pos > Currency_Symbol'Length then
834
                        Answer (J) := ' ';
835
                     else
836
                        Answer (J)   := Currency_Symbol (Currency_Pos);
837
                        Currency_Pos := Currency_Pos + 1;
838
                     end if;
839
 
840
                  when others =>
841
                     null;
842
 
843
               end case;
844
 
845
            when others =>
846
               exit;
847
 
848
         end case;
849
      end loop;
850
 
851
      --  Now get rid of Blank_when_Zero and complete Star fill
852
 
853
      if Zero and then Pic.Blank_When_Zero then
854
 
855
         --  Value is zero, and blank it
856
 
857
         Last := Answer'Last;
858
 
859
         if Dollar then
860
            Last := Last - 1 + Currency_Symbol'Length;
861
         end if;
862
 
863
         if Pic.Radix_Position /= Invalid_Position and then
864
            Answer (Pic.Radix_Position) = 'V' then
865
            Last := Last - 1;
866
         end if;
867
 
868
         return Wide_String'(1 .. Last => ' ');
869
 
870
      elsif Zero and then Pic.Star_Fill then
871
         Last := Answer'Last;
872
 
873
         if Dollar then
874
            Last := Last - 1 + Currency_Symbol'Length;
875
         end if;
876
 
877
         if Pic.Radix_Position /= Invalid_Position then
878
 
879
            if Answer (Pic.Radix_Position) = 'V' then
880
               Last := Last - 1;
881
 
882
            elsif Dollar then
883
               if Pic.Radix_Position > Pic.Start_Currency then
884
                  return Wide_String'(1 .. Pic.Radix_Position - 1 => '*') &
885
                     Radix_Point &
886
                     Wide_String'(Pic.Radix_Position + 1 .. Last => '*');
887
 
888
               else
889
                  return
890
                     Wide_String'
891
                     (1 ..
892
                      Pic.Radix_Position + Currency_Symbol'Length - 2
893
                                             => '*') &
894
                     Radix_Point &
895
                     Wide_String'
896
                       (Pic.Radix_Position + Currency_Symbol'Length .. Last
897
                                             => '*');
898
               end if;
899
 
900
            else
901
               return
902
                 Wide_String'(1 .. Pic.Radix_Position - 1 => '*') &
903
                 Radix_Point &
904
                 Wide_String'(Pic.Radix_Position + 1 .. Last => '*');
905
            end if;
906
         end if;
907
 
908
         return Wide_String'(1 .. Last => '*');
909
      end if;
910
 
911
      --  This was once a simple return statement, now there are nine
912
      --  different return cases.  Not to mention the five above to deal
913
      --  with zeros.  Why not split things out?
914
 
915
      --  Processing the radix and sign expansion separately
916
      --  would require lots of copying--the string and some of its
917
      --  indicies--without really simplifying the logic.  The cases are:
918
 
919
      --  1) Expand $, replace '.' with Radix_Point
920
      --  2) No currency expansion, replace '.' with Radix_Point
921
      --  3) Expand $, radix blanked
922
      --  4) No currency expansion, radix blanked
923
      --  5) Elide V
924
      --  6) Expand $, Elide V
925
      --  7) Elide V, Expand $ (Two cases depending on order.)
926
      --  8) No radix, expand $
927
      --  9) No radix, no currency expansion
928
 
929
      if Pic.Radix_Position /= Invalid_Position then
930
 
931
         if Answer (Pic.Radix_Position) = '.' then
932
            Answer (Pic.Radix_Position) := Radix_Point;
933
 
934
            if Dollar then
935
 
936
               --  1) Expand $, replace '.' with Radix_Point
937
 
938
               return
939
                 Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
940
                 Answer (Currency_Pos + 1 .. Answer'Last);
941
 
942
            else
943
               --  2) No currency expansion, replace '.' with Radix_Point
944
 
945
               return Answer;
946
            end if;
947
 
948
         elsif Answer (Pic.Radix_Position) = ' ' then --  blanked radix.
949
            if Dollar then
950
 
951
               --  3) Expand $, radix blanked
952
 
953
               return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
954
                 Answer (Currency_Pos + 1 .. Answer'Last);
955
 
956
            else
957
               --  4) No expansion, radix blanked
958
 
959
               return Answer;
960
            end if;
961
 
962
         --  V cases
963
 
964
         else
965
            if not Dollar then
966
 
967
               --  5) Elide V
968
 
969
               return Answer (1 .. Pic.Radix_Position - 1) &
970
                  Answer (Pic.Radix_Position + 1 .. Answer'Last);
971
 
972
            elsif Currency_Pos < Pic.Radix_Position then
973
 
974
               --  6) Expand $, Elide V
975
 
976
               return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
977
                  Answer (Currency_Pos + 1 .. Pic.Radix_Position - 1) &
978
                  Answer (Pic.Radix_Position + 1 .. Answer'Last);
979
 
980
            else
981
               --  7) Elide V, Expand $
982
 
983
               return Answer (1 .. Pic.Radix_Position - 1) &
984
                  Answer (Pic.Radix_Position + 1 .. Currency_Pos - 1) &
985
                  Currency_Symbol &
986
                  Answer (Currency_Pos + 1 .. Answer'Last);
987
            end if;
988
         end if;
989
 
990
      elsif Dollar then
991
 
992
         --  8) No radix, expand $
993
 
994
         return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
995
            Answer (Currency_Pos + 1 .. Answer'Last);
996
 
997
      else
998
         --  9) No radix, no currency expansion
999
 
1000
         return Answer;
1001
      end if;
1002
   end Format_Number;
1003
 
1004
   -------------------------
1005
   -- Parse_Number_String --
1006
   -------------------------
1007
 
1008
   function Parse_Number_String (Str : String) return Number_Attributes is
1009
      Answer : Number_Attributes;
1010
 
1011
   begin
1012
      for J in Str'Range loop
1013
         case Str (J) is
1014
 
1015
            when ' ' =>
1016
               null; --  ignore
1017
 
1018
            when '1' .. '9' =>
1019
 
1020
               --  Decide if this is the start of a number.
1021
               --  If so, figure out which one...
1022
 
1023
               if Answer.Has_Fraction then
1024
                  Answer.End_Of_Fraction := J;
1025
               else
1026
                  if Answer.Start_Of_Int = Invalid_Position then
1027
                     --  start integer
1028
                     Answer.Start_Of_Int := J;
1029
                  end if;
1030
                  Answer.End_Of_Int := J;
1031
               end if;
1032
 
1033
            when '0' =>
1034
 
1035
               --  Only count a zero before the decimal point if it follows a
1036
               --  non-zero digit.  After the decimal point, zeros will be
1037
               --  counted if followed by a non-zero digit.
1038
 
1039
               if not Answer.Has_Fraction then
1040
                  if Answer.Start_Of_Int /= Invalid_Position then
1041
                     Answer.End_Of_Int := J;
1042
                  end if;
1043
               end if;
1044
 
1045
            when '-' =>
1046
 
1047
               --  Set negative
1048
 
1049
               Answer.Negative := True;
1050
 
1051
            when '.' =>
1052
 
1053
               --  Close integer, start fraction
1054
 
1055
               if Answer.Has_Fraction then
1056
                  raise Picture_Error;
1057
               end if;
1058
 
1059
               --  Two decimal points is a no-no
1060
 
1061
               Answer.Has_Fraction    := True;
1062
               Answer.End_Of_Fraction := J;
1063
 
1064
               --  Could leave this at Invalid_Position, but this seems the
1065
               --  right way to indicate a null range...
1066
 
1067
               Answer.Start_Of_Fraction := J + 1;
1068
               Answer.End_Of_Int        := J - 1;
1069
 
1070
            when others =>
1071
               raise Picture_Error; -- can this happen? probably not!
1072
         end case;
1073
      end loop;
1074
 
1075
      if Answer.Start_Of_Int = Invalid_Position then
1076
         Answer.Start_Of_Int := Answer.End_Of_Int + 1;
1077
      end if;
1078
 
1079
      --  No significant (intger) digits needs a null range
1080
 
1081
      return Answer;
1082
   end Parse_Number_String;
1083
 
1084
   ----------------
1085
   -- Pic_String --
1086
   ----------------
1087
 
1088
   --  The following ensures that we return B and not b being careful not
1089
   --  to break things which expect lower case b for blank. See CXF3A02.
1090
 
1091
   function Pic_String (Pic : Picture) return String is
1092
      Temp : String (1 .. Pic.Contents.Picture.Length) :=
1093
                              Pic.Contents.Picture.Expanded;
1094
   begin
1095
      for J in Temp'Range loop
1096
         if Temp (J) = 'b' then
1097
            Temp (J) := 'B';
1098
         end if;
1099
      end loop;
1100
 
1101
      return Temp;
1102
   end Pic_String;
1103
 
1104
   ------------------
1105
   -- Precalculate --
1106
   ------------------
1107
 
1108
   procedure Precalculate  (Pic : in out Format_Record) is
1109
 
1110
      Computed_BWZ : Boolean := True;
1111
 
1112
      type Legality is  (Okay, Reject);
1113
      State : Legality := Reject;
1114
      --  Start in reject, which will reject null strings
1115
 
1116
      Index : Pic_Index := Pic.Picture.Expanded'First;
1117
 
1118
      function At_End return Boolean;
1119
      pragma Inline (At_End);
1120
 
1121
      procedure Set_State (L : Legality);
1122
      pragma Inline (Set_State);
1123
 
1124
      function Look return Character;
1125
      pragma Inline (Look);
1126
 
1127
      function Is_Insert return Boolean;
1128
      pragma Inline (Is_Insert);
1129
 
1130
      procedure Skip;
1131
      pragma Inline (Skip);
1132
 
1133
      procedure Trailing_Currency;
1134
      procedure Trailing_Bracket;
1135
      procedure Number_Fraction;
1136
      procedure Number_Completion;
1137
      procedure Number_Fraction_Or_Bracket;
1138
      procedure Number_Fraction_Or_Z_Fill;
1139
      procedure Zero_Suppression;
1140
      procedure Floating_Bracket;
1141
      procedure Number_Fraction_Or_Star_Fill;
1142
      procedure Star_Suppression;
1143
      procedure Number_Fraction_Or_Dollar;
1144
      procedure Leading_Dollar;
1145
      procedure Number_Fraction_Or_Pound;
1146
      procedure Leading_Pound;
1147
      procedure Picture;
1148
      procedure Floating_Plus;
1149
      procedure Floating_Minus;
1150
      procedure Picture_Plus;
1151
      procedure Picture_Minus;
1152
      procedure Picture_Bracket;
1153
      procedure Number;
1154
      procedure Optional_RHS_Sign;
1155
      procedure Picture_String;
1156
 
1157
      ------------
1158
      -- At_End --
1159
      ------------
1160
 
1161
      function At_End return Boolean is
1162
      begin
1163
         return Index > Pic.Picture.Length;
1164
      end At_End;
1165
 
1166
      ----------------------
1167
      -- Floating_Bracket --
1168
      ----------------------
1169
 
1170
      --  Note that Floating_Bracket is only called with an acceptable
1171
      --  prefix. But we don't set Okay, because we must end with a '>'.
1172
 
1173
      procedure Floating_Bracket is
1174
      begin
1175
         Pic.Floater := '<';
1176
         Pic.End_Float := Index;
1177
         Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1178
 
1179
         --  First bracket wasn't counted...
1180
 
1181
         Skip; --  known '<'
1182
 
1183
         loop
1184
            if At_End then
1185
               return;
1186
            end if;
1187
 
1188
            case Look is
1189
 
1190
               when '_' | '0' | '/' =>
1191
                  Pic.End_Float := Index;
1192
                  Skip;
1193
 
1194
               when 'B' | 'b'  =>
1195
                  Pic.End_Float := Index;
1196
                  Pic.Picture.Expanded (Index) := 'b';
1197
                  Skip;
1198
 
1199
               when '<' =>
1200
                  Pic.End_Float := Index;
1201
                  Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1202
                  Skip;
1203
 
1204
               when '9' =>
1205
                  Number_Completion;
1206
 
1207
               when '$' =>
1208
                  Leading_Dollar;
1209
 
1210
               when '#' =>
1211
                  Leading_Pound;
1212
 
1213
               when 'V' | 'v' | '.' =>
1214
                  Pic.Radix_Position := Index;
1215
                  Skip;
1216
                  Number_Fraction_Or_Bracket;
1217
                  return;
1218
 
1219
               when others =>
1220
               return;
1221
            end case;
1222
         end loop;
1223
      end Floating_Bracket;
1224
 
1225
      --------------------
1226
      -- Floating_Minus --
1227
      --------------------
1228
 
1229
      procedure Floating_Minus is
1230
      begin
1231
         loop
1232
            if At_End then
1233
               return;
1234
            end if;
1235
 
1236
            case Look is
1237
               when '_' | '0' | '/' =>
1238
                  Pic.End_Float := Index;
1239
                  Skip;
1240
 
1241
               when 'B' | 'b'  =>
1242
                  Pic.End_Float := Index;
1243
                  Pic.Picture.Expanded (Index) := 'b';
1244
                  Skip;
1245
 
1246
               when '-' =>
1247
                  Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1248
                  Pic.End_Float := Index;
1249
                  Skip;
1250
 
1251
               when '9' =>
1252
                  Number_Completion;
1253
                  return;
1254
 
1255
               when '.' | 'V' | 'v' =>
1256
                  Pic.Radix_Position := Index;
1257
                  Skip; --  Radix
1258
 
1259
                  while Is_Insert loop
1260
                     Skip;
1261
                  end loop;
1262
 
1263
                  if At_End then
1264
                     return;
1265
                  end if;
1266
 
1267
                  if Look = '-' then
1268
                     loop
1269
                        if At_End then
1270
                           return;
1271
                        end if;
1272
 
1273
                        case Look is
1274
 
1275
                           when '-' =>
1276
                              Pic.Max_Trailing_Digits :=
1277
                                Pic.Max_Trailing_Digits + 1;
1278
                              Pic.End_Float := Index;
1279
                              Skip;
1280
 
1281
                           when '_' | '0' | '/' =>
1282
                              Skip;
1283
 
1284
                           when 'B' | 'b'  =>
1285
                              Pic.Picture.Expanded (Index) := 'b';
1286
                              Skip;
1287
 
1288
                           when others =>
1289
                              return;
1290
 
1291
                        end case;
1292
                     end loop;
1293
 
1294
                  else
1295
                     Number_Completion;
1296
                  end if;
1297
 
1298
                  return;
1299
 
1300
               when others =>
1301
                  return;
1302
            end case;
1303
         end loop;
1304
      end Floating_Minus;
1305
 
1306
      -------------------
1307
      -- Floating_Plus --
1308
      -------------------
1309
 
1310
      procedure Floating_Plus is
1311
      begin
1312
         loop
1313
            if At_End then
1314
               return;
1315
            end if;
1316
 
1317
            case Look is
1318
               when '_' | '0' | '/' =>
1319
                  Pic.End_Float := Index;
1320
                  Skip;
1321
 
1322
               when 'B' | 'b'  =>
1323
                  Pic.End_Float := Index;
1324
                  Pic.Picture.Expanded (Index) := 'b';
1325
                  Skip;
1326
 
1327
               when '+' =>
1328
                  Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1329
                  Pic.End_Float := Index;
1330
                  Skip;
1331
 
1332
               when '9' =>
1333
                  Number_Completion;
1334
                  return;
1335
 
1336
               when '.' | 'V' | 'v' =>
1337
                  Pic.Radix_Position := Index;
1338
                  Skip; --  Radix
1339
 
1340
                  while Is_Insert loop
1341
                     Skip;
1342
                  end loop;
1343
 
1344
                  if At_End then
1345
                     return;
1346
                  end if;
1347
 
1348
                  if Look = '+' then
1349
                     loop
1350
                        if At_End then
1351
                           return;
1352
                        end if;
1353
 
1354
                        case Look is
1355
 
1356
                           when '+' =>
1357
                              Pic.Max_Trailing_Digits :=
1358
                                Pic.Max_Trailing_Digits + 1;
1359
                              Pic.End_Float := Index;
1360
                              Skip;
1361
 
1362
                           when '_' | '0' | '/' =>
1363
                              Skip;
1364
 
1365
                           when 'B' | 'b'  =>
1366
                              Pic.Picture.Expanded (Index) := 'b';
1367
                              Skip;
1368
 
1369
                           when others =>
1370
                              return;
1371
 
1372
                        end case;
1373
                     end loop;
1374
 
1375
                  else
1376
                     Number_Completion;
1377
                  end if;
1378
 
1379
                  return;
1380
 
1381
               when others =>
1382
                  return;
1383
 
1384
            end case;
1385
         end loop;
1386
      end Floating_Plus;
1387
 
1388
      ---------------
1389
      -- Is_Insert --
1390
      ---------------
1391
 
1392
      function Is_Insert return Boolean is
1393
      begin
1394
         if At_End then
1395
            return False;
1396
         end if;
1397
 
1398
         case Pic.Picture.Expanded (Index) is
1399
 
1400
            when '_' | '0' | '/' => return True;
1401
 
1402
            when 'B' | 'b' =>
1403
               Pic.Picture.Expanded (Index) := 'b'; --  canonical
1404
               return True;
1405
 
1406
            when others => return False;
1407
         end case;
1408
      end Is_Insert;
1409
 
1410
      --------------------
1411
      -- Leading_Dollar --
1412
      --------------------
1413
 
1414
      --  Note that Leading_Dollar can be called in either State.
1415
      --  It will set state to Okay only if a 9 or (second) $
1416
      --  is encountered.
1417
 
1418
      --  Also notice the tricky bit with State and Zero_Suppression.
1419
      --  Zero_Suppression is Picture_Error if a '$' or a '9' has been
1420
      --  encountered, exactly the cases where State has been set.
1421
 
1422
      procedure Leading_Dollar is
1423
      begin
1424
         --  Treat as a floating dollar, and unwind otherwise
1425
 
1426
         Pic.Floater := '$';
1427
         Pic.Start_Currency := Index;
1428
         Pic.End_Currency := Index;
1429
         Pic.Start_Float := Index;
1430
         Pic.End_Float := Index;
1431
 
1432
         --  Don't increment Pic.Max_Leading_Digits, we need one "real"
1433
         --  currency place.
1434
 
1435
         Skip; --  known '$'
1436
 
1437
         loop
1438
            if At_End then
1439
               return;
1440
            end if;
1441
 
1442
            case Look is
1443
 
1444
               when '_' | '0' | '/' =>
1445
                  Pic.End_Float := Index;
1446
                  Skip;
1447
 
1448
                  --  A trailing insertion character is not part of the
1449
                  --  floating currency, so need to look ahead.
1450
 
1451
                  if Look /= '$' then
1452
                     Pic.End_Float := Pic.End_Float - 1;
1453
                  end if;
1454
 
1455
               when 'B' | 'b'  =>
1456
                  Pic.End_Float := Index;
1457
                  Pic.Picture.Expanded (Index) := 'b';
1458
                  Skip;
1459
 
1460
               when 'Z' | 'z' =>
1461
                  Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1462
 
1463
                  if State = Okay then
1464
                     raise Picture_Error;
1465
                  else
1466
                     --  Will overwrite Floater and Start_Float
1467
 
1468
                     Zero_Suppression;
1469
                  end if;
1470
 
1471
               when '*' =>
1472
                  if State = Okay then
1473
                     raise Picture_Error;
1474
                  else
1475
                     --  Will overwrite Floater and Start_Float
1476
 
1477
                     Star_Suppression;
1478
                  end if;
1479
 
1480
               when '$' =>
1481
                  Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1482
                  Pic.End_Float := Index;
1483
                  Pic.End_Currency := Index;
1484
                  Set_State (Okay); Skip;
1485
 
1486
               when '9' =>
1487
                  if State /= Okay then
1488
                     Pic.Floater := '!';
1489
                     Pic.Start_Float := Invalid_Position;
1490
                     Pic.End_Float := Invalid_Position;
1491
                  end if;
1492
 
1493
                  --  A single dollar does not a floating make
1494
 
1495
                  Number_Completion;
1496
                  return;
1497
 
1498
               when 'V' | 'v' | '.' =>
1499
                  if State /= Okay then
1500
                     Pic.Floater := '!';
1501
                     Pic.Start_Float := Invalid_Position;
1502
                     Pic.End_Float := Invalid_Position;
1503
                  end if;
1504
 
1505
                  --  Only one dollar before the sign is okay, but doesn't
1506
                  --  float.
1507
 
1508
                  Pic.Radix_Position := Index;
1509
                  Skip;
1510
                  Number_Fraction_Or_Dollar;
1511
                  return;
1512
 
1513
               when others =>
1514
                  return;
1515
 
1516
            end case;
1517
         end loop;
1518
      end Leading_Dollar;
1519
 
1520
      -------------------
1521
      -- Leading_Pound --
1522
      -------------------
1523
 
1524
      --  This one is complex!  A Leading_Pound can be fixed or floating,
1525
      --  but in some cases the decision has to be deferred until we leave
1526
      --  this procedure.  Also note that Leading_Pound can be called in
1527
      --  either State.
1528
 
1529
      --  It will set state to Okay only if a 9 or  (second) # is
1530
      --  encountered.
1531
 
1532
      --  One Last note:  In ambiguous cases, the currency is treated as
1533
      --  floating unless there is only one '#'.
1534
 
1535
      procedure Leading_Pound is
1536
 
1537
         Inserts : Boolean := False;
1538
         --  Set to True if a '_', '0', '/', 'B', or 'b' is encountered
1539
 
1540
         Must_Float : Boolean := False;
1541
         --  Set to true if a '#' occurs after an insert
1542
 
1543
      begin
1544
         --  Treat as a floating currency. If it isn't, this will be
1545
         --  overwritten later.
1546
 
1547
         Pic.Floater := '#';
1548
 
1549
         Pic.Start_Currency := Index;
1550
         Pic.End_Currency := Index;
1551
         Pic.Start_Float := Index;
1552
         Pic.End_Float := Index;
1553
 
1554
         --  Don't increment Pic.Max_Leading_Digits, we need one "real"
1555
         --  currency place.
1556
 
1557
         Pic.Max_Currency_Digits := 1; --  we've seen one.
1558
 
1559
         Skip; --  known '#'
1560
 
1561
         loop
1562
            if At_End then
1563
               return;
1564
            end if;
1565
 
1566
            case Look is
1567
 
1568
               when '_' | '0' | '/' =>
1569
                  Pic.End_Float := Index;
1570
                  Inserts := True;
1571
                  Skip;
1572
 
1573
               when 'B' | 'b'  =>
1574
                  Pic.Picture.Expanded (Index) := 'b';
1575
                  Pic.End_Float := Index;
1576
                  Inserts := True;
1577
                  Skip;
1578
 
1579
               when 'Z' | 'z' =>
1580
                  Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1581
 
1582
                  if Must_Float then
1583
                     raise Picture_Error;
1584
                  else
1585
                     Pic.Max_Leading_Digits := 0;
1586
 
1587
                     --  Will overwrite Floater and Start_Float
1588
 
1589
                     Zero_Suppression;
1590
                  end if;
1591
 
1592
               when '*' =>
1593
                  if Must_Float then
1594
                     raise Picture_Error;
1595
                  else
1596
                     Pic.Max_Leading_Digits := 0;
1597
 
1598
                     --  Will overwrite Floater and Start_Float
1599
 
1600
                     Star_Suppression;
1601
                  end if;
1602
 
1603
               when '#' =>
1604
                  if Inserts then
1605
                     Must_Float := True;
1606
                  end if;
1607
 
1608
                  Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1609
                  Pic.End_Float := Index;
1610
                  Pic.End_Currency := Index;
1611
                  Set_State (Okay);
1612
                  Skip;
1613
 
1614
               when '9' =>
1615
                  if State /= Okay then
1616
 
1617
                     --  A single '#' doesn't float
1618
 
1619
                     Pic.Floater := '!';
1620
                     Pic.Start_Float := Invalid_Position;
1621
                     Pic.End_Float := Invalid_Position;
1622
                  end if;
1623
 
1624
                  Number_Completion;
1625
                  return;
1626
 
1627
               when 'V' | 'v' | '.' =>
1628
                  if State /= Okay then
1629
                     Pic.Floater := '!';
1630
                     Pic.Start_Float := Invalid_Position;
1631
                     Pic.End_Float := Invalid_Position;
1632
                  end if;
1633
 
1634
                  --  Only one pound before the sign is okay, but doesn't
1635
                  --  float.
1636
 
1637
                  Pic.Radix_Position := Index;
1638
                  Skip;
1639
                  Number_Fraction_Or_Pound;
1640
                  return;
1641
 
1642
               when others =>
1643
                  return;
1644
            end case;
1645
         end loop;
1646
      end Leading_Pound;
1647
 
1648
      ----------
1649
      -- Look --
1650
      ----------
1651
 
1652
      function Look return Character is
1653
      begin
1654
         if At_End then
1655
            raise Picture_Error;
1656
         end if;
1657
 
1658
         return Pic.Picture.Expanded (Index);
1659
      end Look;
1660
 
1661
      ------------
1662
      -- Number --
1663
      ------------
1664
 
1665
      procedure Number is
1666
      begin
1667
         loop
1668
 
1669
            case Look is
1670
               when '_' | '0' | '/' =>
1671
                  Skip;
1672
 
1673
               when 'B' | 'b'  =>
1674
                  Pic.Picture.Expanded (Index) := 'b';
1675
                  Skip;
1676
 
1677
               when '9' =>
1678
                  Computed_BWZ := False;
1679
                  Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1680
                  Set_State (Okay);
1681
                  Skip;
1682
 
1683
               when '.' | 'V' | 'v' =>
1684
                  Pic.Radix_Position := Index;
1685
                  Skip;
1686
                  Number_Fraction;
1687
                  return;
1688
 
1689
               when others =>
1690
                  return;
1691
 
1692
            end case;
1693
 
1694
            if At_End then
1695
               return;
1696
            end if;
1697
 
1698
            --  Will return in Okay state if a '9' was seen
1699
 
1700
         end loop;
1701
      end Number;
1702
 
1703
      -----------------------
1704
      -- Number_Completion --
1705
      -----------------------
1706
 
1707
      procedure Number_Completion is
1708
      begin
1709
         while not At_End loop
1710
            case Look is
1711
 
1712
               when '_' | '0' | '/' =>
1713
                  Skip;
1714
 
1715
               when 'B' | 'b'  =>
1716
                  Pic.Picture.Expanded (Index) := 'b';
1717
                  Skip;
1718
 
1719
               when '9' =>
1720
                  Computed_BWZ := False;
1721
                  Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1722
                  Set_State (Okay);
1723
                  Skip;
1724
 
1725
               when 'V' | 'v' | '.' =>
1726
                  Pic.Radix_Position := Index;
1727
                  Skip;
1728
                  Number_Fraction;
1729
                  return;
1730
 
1731
               when others =>
1732
                  return;
1733
            end case;
1734
         end loop;
1735
      end Number_Completion;
1736
 
1737
      ---------------------
1738
      -- Number_Fraction --
1739
      ---------------------
1740
 
1741
      procedure Number_Fraction is
1742
      begin
1743
         --  Note that number fraction can be called in either State.
1744
         --  It will set state to Valid only if a 9 is encountered.
1745
 
1746
         loop
1747
            if At_End then
1748
               return;
1749
            end if;
1750
 
1751
            case Look is
1752
               when '_' | '0' | '/' =>
1753
                  Skip;
1754
 
1755
               when 'B' | 'b'  =>
1756
                  Pic.Picture.Expanded (Index) := 'b';
1757
                  Skip;
1758
 
1759
               when '9' =>
1760
                  Computed_BWZ := False;
1761
                  Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1762
                  Set_State (Okay); Skip;
1763
 
1764
               when others =>
1765
                  return;
1766
            end case;
1767
         end loop;
1768
      end Number_Fraction;
1769
 
1770
      --------------------------------
1771
      -- Number_Fraction_Or_Bracket --
1772
      --------------------------------
1773
 
1774
      procedure Number_Fraction_Or_Bracket is
1775
      begin
1776
         loop
1777
            if At_End then
1778
               return;
1779
            end if;
1780
 
1781
            case Look is
1782
 
1783
               when '_' | '0' | '/' => Skip;
1784
 
1785
               when 'B' | 'b'  =>
1786
                  Pic.Picture.Expanded (Index) := 'b';
1787
                  Skip;
1788
 
1789
               when '<' =>
1790
                  Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1791
                  Pic.End_Float := Index;
1792
                  Skip;
1793
 
1794
                  loop
1795
                     if At_End then
1796
                        return;
1797
                     end if;
1798
 
1799
                     case Look is
1800
                        when '_' | '0' | '/' =>
1801
                           Skip;
1802
 
1803
                        when 'B' | 'b'  =>
1804
                           Pic.Picture.Expanded (Index) := 'b';
1805
                           Skip;
1806
 
1807
                        when '<' =>
1808
                           Pic.Max_Trailing_Digits :=
1809
                             Pic.Max_Trailing_Digits + 1;
1810
                           Pic.End_Float := Index;
1811
                           Skip;
1812
 
1813
                        when others =>
1814
                           return;
1815
                     end case;
1816
                  end loop;
1817
 
1818
               when others =>
1819
                  Number_Fraction;
1820
                  return;
1821
            end case;
1822
         end loop;
1823
      end Number_Fraction_Or_Bracket;
1824
 
1825
      -------------------------------
1826
      -- Number_Fraction_Or_Dollar --
1827
      -------------------------------
1828
 
1829
      procedure Number_Fraction_Or_Dollar is
1830
      begin
1831
         loop
1832
            if At_End then
1833
               return;
1834
            end if;
1835
 
1836
            case Look is
1837
               when '_' | '0' | '/' =>
1838
                  Skip;
1839
 
1840
               when 'B' | 'b'  =>
1841
                  Pic.Picture.Expanded (Index) := 'b';
1842
                  Skip;
1843
 
1844
               when '$' =>
1845
                  Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1846
                  Pic.End_Float := Index;
1847
                  Skip;
1848
 
1849
                  loop
1850
                     if At_End then
1851
                        return;
1852
                     end if;
1853
 
1854
                     case Look is
1855
                        when '_' | '0' | '/' =>
1856
                           Skip;
1857
 
1858
                        when 'B' | 'b'  =>
1859
                           Pic.Picture.Expanded (Index) := 'b';
1860
                           Skip;
1861
 
1862
                        when '$' =>
1863
                           Pic.Max_Trailing_Digits :=
1864
                             Pic.Max_Trailing_Digits + 1;
1865
                           Pic.End_Float := Index;
1866
                           Skip;
1867
 
1868
                        when others =>
1869
                           return;
1870
                     end case;
1871
                  end loop;
1872
 
1873
               when others =>
1874
                  Number_Fraction;
1875
                  return;
1876
            end case;
1877
         end loop;
1878
      end Number_Fraction_Or_Dollar;
1879
 
1880
      ------------------------------
1881
      -- Number_Fraction_Or_Pound --
1882
      ------------------------------
1883
 
1884
      procedure Number_Fraction_Or_Pound is
1885
      begin
1886
         loop
1887
            if At_End then
1888
               return;
1889
            end if;
1890
 
1891
            case Look is
1892
 
1893
               when '_' | '0' | '/' =>
1894
                  Skip;
1895
 
1896
               when 'B' | 'b'  =>
1897
                  Pic.Picture.Expanded (Index) := 'b';
1898
                  Skip;
1899
 
1900
               when '#' =>
1901
                  Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1902
                  Pic.End_Float := Index;
1903
                  Skip;
1904
 
1905
                  loop
1906
                     if At_End then
1907
                        return;
1908
                     end if;
1909
 
1910
                     case Look is
1911
 
1912
                        when '_' | '0' | '/' =>
1913
                           Skip;
1914
 
1915
                        when 'B' | 'b'  =>
1916
                           Pic.Picture.Expanded (Index) := 'b';
1917
                           Skip;
1918
 
1919
                        when '#' =>
1920
                           Pic.Max_Trailing_Digits :=
1921
                             Pic.Max_Trailing_Digits + 1;
1922
                           Pic.End_Float := Index;
1923
                           Skip;
1924
 
1925
                        when others =>
1926
                           return;
1927
 
1928
                     end case;
1929
                  end loop;
1930
 
1931
               when others =>
1932
                  Number_Fraction;
1933
                  return;
1934
 
1935
            end case;
1936
         end loop;
1937
      end Number_Fraction_Or_Pound;
1938
 
1939
      ----------------------------------
1940
      -- Number_Fraction_Or_Star_Fill --
1941
      ----------------------------------
1942
 
1943
      procedure Number_Fraction_Or_Star_Fill is
1944
      begin
1945
         loop
1946
            if At_End then
1947
               return;
1948
            end if;
1949
 
1950
            case Look is
1951
 
1952
               when '_' | '0' | '/' =>
1953
                  Skip;
1954
 
1955
               when 'B' | 'b'  =>
1956
                  Pic.Picture.Expanded (Index) := 'b';
1957
                  Skip;
1958
 
1959
               when '*' =>
1960
                  Pic.Star_Fill := True;
1961
                  Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1962
                  Pic.End_Float := Index;
1963
                  Skip;
1964
 
1965
                  loop
1966
                     if At_End then
1967
                        return;
1968
                     end if;
1969
 
1970
                     case Look is
1971
 
1972
                        when '_' | '0' | '/' =>
1973
                           Skip;
1974
 
1975
                        when 'B' | 'b'  =>
1976
                           Pic.Picture.Expanded (Index) := 'b';
1977
                           Skip;
1978
 
1979
                        when '*' =>
1980
                           Pic.Star_Fill := True;
1981
                           Pic.Max_Trailing_Digits :=
1982
                             Pic.Max_Trailing_Digits + 1;
1983
                           Pic.End_Float := Index;
1984
                           Skip;
1985
 
1986
                        when others =>
1987
                           return;
1988
                     end case;
1989
                  end loop;
1990
 
1991
               when others =>
1992
                  Number_Fraction;
1993
                  return;
1994
 
1995
            end case;
1996
         end loop;
1997
      end Number_Fraction_Or_Star_Fill;
1998
 
1999
      -------------------------------
2000
      -- Number_Fraction_Or_Z_Fill --
2001
      -------------------------------
2002
 
2003
      procedure Number_Fraction_Or_Z_Fill is
2004
      begin
2005
         loop
2006
            if At_End then
2007
               return;
2008
            end if;
2009
 
2010
            case Look is
2011
 
2012
               when '_' | '0' | '/' =>
2013
                  Skip;
2014
 
2015
               when 'B' | 'b'  =>
2016
                  Pic.Picture.Expanded (Index) := 'b';
2017
                  Skip;
2018
 
2019
               when 'Z' | 'z' =>
2020
                  Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
2021
                  Pic.End_Float := Index;
2022
                  Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2023
 
2024
                  Skip;
2025
 
2026
                  loop
2027
                     if At_End then
2028
                        return;
2029
                     end if;
2030
 
2031
                     case Look is
2032
 
2033
                        when '_' | '0' | '/' =>
2034
                           Skip;
2035
 
2036
                        when 'B' | 'b'  =>
2037
                           Pic.Picture.Expanded (Index) := 'b';
2038
                           Skip;
2039
 
2040
                        when 'Z' | 'z' =>
2041
                           Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2042
 
2043
                           Pic.Max_Trailing_Digits :=
2044
                             Pic.Max_Trailing_Digits + 1;
2045
                           Pic.End_Float := Index;
2046
                           Skip;
2047
 
2048
                        when others =>
2049
                           return;
2050
                     end case;
2051
                  end loop;
2052
 
2053
               when others =>
2054
                  Number_Fraction;
2055
                  return;
2056
            end case;
2057
         end loop;
2058
      end Number_Fraction_Or_Z_Fill;
2059
 
2060
      -----------------------
2061
      -- Optional_RHS_Sign --
2062
      -----------------------
2063
 
2064
      procedure Optional_RHS_Sign is
2065
      begin
2066
         if At_End then
2067
            return;
2068
         end if;
2069
 
2070
         case Look is
2071
 
2072
            when '+' | '-' =>
2073
               Pic.Sign_Position := Index;
2074
               Skip;
2075
               return;
2076
 
2077
            when 'C' | 'c' =>
2078
               Pic.Sign_Position := Index;
2079
               Pic.Picture.Expanded (Index) := 'C';
2080
               Skip;
2081
 
2082
               if Look = 'R' or else Look = 'r' then
2083
                  Pic.Second_Sign := Index;
2084
                  Pic.Picture.Expanded (Index) := 'R';
2085
                  Skip;
2086
 
2087
               else
2088
                  raise Picture_Error;
2089
               end if;
2090
 
2091
               return;
2092
 
2093
            when 'D' | 'd' =>
2094
               Pic.Sign_Position := Index;
2095
               Pic.Picture.Expanded (Index) := 'D';
2096
               Skip;
2097
 
2098
               if Look = 'B' or else Look = 'b' then
2099
                  Pic.Second_Sign := Index;
2100
                  Pic.Picture.Expanded (Index) := 'B';
2101
                  Skip;
2102
 
2103
               else
2104
                  raise Picture_Error;
2105
               end if;
2106
 
2107
               return;
2108
 
2109
            when '>' =>
2110
               if Pic.Picture.Expanded (Pic.Sign_Position) = '<' then
2111
                  Pic.Second_Sign := Index;
2112
                  Skip;
2113
 
2114
               else
2115
                  raise Picture_Error;
2116
               end if;
2117
 
2118
            when others =>
2119
               return;
2120
 
2121
         end case;
2122
      end Optional_RHS_Sign;
2123
 
2124
      -------------
2125
      -- Picture --
2126
      -------------
2127
 
2128
      --  Note that Picture can be called in either State
2129
 
2130
      --  It will set state to Valid only if a 9 is encountered or floating
2131
      --  currency is called.
2132
 
2133
      procedure Picture is
2134
      begin
2135
         loop
2136
            if At_End then
2137
               return;
2138
            end if;
2139
 
2140
            case Look is
2141
 
2142
               when '_' | '0' | '/' =>
2143
                  Skip;
2144
 
2145
               when 'B' | 'b'  =>
2146
                  Pic.Picture.Expanded (Index) := 'b';
2147
                  Skip;
2148
 
2149
               when '$' =>
2150
                  Leading_Dollar;
2151
                  return;
2152
 
2153
               when '#' =>
2154
                  Leading_Pound;
2155
                  return;
2156
 
2157
               when '9' =>
2158
                  Computed_BWZ := False;
2159
                  Set_State (Okay);
2160
                  Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2161
                  Skip;
2162
 
2163
               when 'V' | 'v' | '.' =>
2164
                  Pic.Radix_Position := Index;
2165
                  Skip;
2166
                  Number_Fraction;
2167
                  Trailing_Currency;
2168
                  return;
2169
 
2170
               when others =>
2171
                  return;
2172
 
2173
            end case;
2174
         end loop;
2175
      end Picture;
2176
 
2177
      ---------------------
2178
      -- Picture_Bracket --
2179
      ---------------------
2180
 
2181
      procedure Picture_Bracket is
2182
      begin
2183
         Pic.Sign_Position := Index;
2184
         Pic.Sign_Position := Index;
2185
 
2186
         --  Treat as a floating sign, and unwind otherwise
2187
 
2188
         Pic.Floater := '<';
2189
         Pic.Start_Float := Index;
2190
         Pic.End_Float := Index;
2191
 
2192
         --  Don't increment Pic.Max_Leading_Digits, we need one "real"
2193
         --  sign place.
2194
 
2195
         Skip; --  Known Bracket
2196
 
2197
         loop
2198
            case Look is
2199
 
2200
               when '_' | '0' | '/' =>
2201
                  Pic.End_Float := Index;
2202
                  Skip;
2203
 
2204
               when 'B' | 'b'  =>
2205
                  Pic.End_Float := Index;
2206
                  Pic.Picture.Expanded (Index) := 'b';
2207
                  Skip;
2208
 
2209
               when '<' =>
2210
                  Set_State (Okay);  --  "<<>" is enough.
2211
                  Floating_Bracket;
2212
                  Trailing_Currency;
2213
                  Trailing_Bracket;
2214
                  return;
2215
 
2216
               when '$' | '#' | '9' | '*' =>
2217
                  if State /= Okay then
2218
                     Pic.Floater := '!';
2219
                     Pic.Start_Float := Invalid_Position;
2220
                     Pic.End_Float := Invalid_Position;
2221
                  end if;
2222
 
2223
                  Picture;
2224
                  Trailing_Bracket;
2225
                  Set_State (Okay);
2226
                  return;
2227
 
2228
               when '.' | 'V' | 'v' =>
2229
                  if State /= Okay then
2230
                     Pic.Floater := '!';
2231
                     Pic.Start_Float := Invalid_Position;
2232
                     Pic.End_Float := Invalid_Position;
2233
                  end if;
2234
 
2235
                  --  Don't assume that state is okay, haven't seen a digit
2236
 
2237
                  Picture;
2238
                  Trailing_Bracket;
2239
                  return;
2240
 
2241
               when others =>
2242
                  raise Picture_Error;
2243
 
2244
            end case;
2245
         end loop;
2246
      end Picture_Bracket;
2247
 
2248
      -------------------
2249
      -- Picture_Minus --
2250
      -------------------
2251
 
2252
      procedure Picture_Minus is
2253
      begin
2254
         Pic.Sign_Position := Index;
2255
 
2256
         --  Treat as a floating sign, and unwind otherwise
2257
 
2258
         Pic.Floater := '-';
2259
         Pic.Start_Float := Index;
2260
         Pic.End_Float := Index;
2261
 
2262
         --  Don't increment Pic.Max_Leading_Digits, we need one "real"
2263
         --  sign place.
2264
 
2265
         Skip; --  Known Minus
2266
 
2267
         loop
2268
            case Look is
2269
 
2270
               when '_' | '0' | '/' =>
2271
                  Pic.End_Float := Index;
2272
                  Skip;
2273
 
2274
               when 'B' | 'b'  =>
2275
                  Pic.End_Float := Index;
2276
                  Pic.Picture.Expanded (Index) := 'b';
2277
                  Skip;
2278
 
2279
               when '-' =>
2280
                  Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2281
                  Pic.End_Float := Index;
2282
                  Skip;
2283
                  Set_State (Okay);  --  "-- " is enough
2284
                  Floating_Minus;
2285
                  Trailing_Currency;
2286
                  return;
2287
 
2288
               when '$' | '#' | '9' | '*' =>
2289
                  if State /= Okay then
2290
                     Pic.Floater := '!';
2291
                     Pic.Start_Float := Invalid_Position;
2292
                     Pic.End_Float := Invalid_Position;
2293
                  end if;
2294
 
2295
                  Picture;
2296
                  Set_State (Okay);
2297
                  return;
2298
 
2299
               when 'Z' | 'z' =>
2300
 
2301
                  --  Can't have Z and a floating sign
2302
 
2303
                  if State = Okay then
2304
                     Set_State (Reject);
2305
                  end if;
2306
 
2307
                  Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2308
                  Zero_Suppression;
2309
                  Trailing_Currency;
2310
                  Optional_RHS_Sign;
2311
                  return;
2312
 
2313
               when '.' | 'V' | 'v' =>
2314
                  if State /= Okay then
2315
                     Pic.Floater := '!';
2316
                     Pic.Start_Float := Invalid_Position;
2317
                     Pic.End_Float := Invalid_Position;
2318
                  end if;
2319
 
2320
                  --  Don't assume that state is okay, haven't seen a digit
2321
 
2322
                  Picture;
2323
                  return;
2324
 
2325
               when others =>
2326
                  return;
2327
 
2328
            end case;
2329
         end loop;
2330
      end Picture_Minus;
2331
 
2332
      ------------------
2333
      -- Picture_Plus --
2334
      ------------------
2335
 
2336
      procedure Picture_Plus is
2337
      begin
2338
         Pic.Sign_Position := Index;
2339
 
2340
         --  Treat as a floating sign, and unwind otherwise
2341
 
2342
         Pic.Floater := '+';
2343
         Pic.Start_Float := Index;
2344
         Pic.End_Float := Index;
2345
 
2346
         --  Don't increment Pic.Max_Leading_Digits, we need one "real"
2347
         --  sign place.
2348
 
2349
         Skip; --  Known Plus
2350
 
2351
         loop
2352
            case Look is
2353
 
2354
               when '_' | '0' | '/' =>
2355
                  Pic.End_Float := Index;
2356
                  Skip;
2357
 
2358
               when 'B' | 'b'  =>
2359
                  Pic.End_Float := Index;
2360
                  Pic.Picture.Expanded (Index) := 'b';
2361
                  Skip;
2362
 
2363
               when '+' =>
2364
                  Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2365
                  Pic.End_Float := Index;
2366
                  Skip;
2367
                  Set_State (Okay);  --  "++" is enough
2368
                  Floating_Plus;
2369
                  Trailing_Currency;
2370
                  return;
2371
 
2372
               when '$' | '#' | '9' | '*' =>
2373
                  if State /= Okay then
2374
                     Pic.Floater := '!';
2375
                     Pic.Start_Float := Invalid_Position;
2376
                     Pic.End_Float := Invalid_Position;
2377
                  end if;
2378
 
2379
                  Picture;
2380
                  Set_State (Okay);
2381
                  return;
2382
 
2383
               when 'Z' | 'z' =>
2384
                  if State = Okay then
2385
                     Set_State (Reject);
2386
                  end if;
2387
 
2388
                  --  Can't have Z and a floating sign
2389
 
2390
                  Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2391
 
2392
                  --  '+Z' is acceptable
2393
 
2394
                  Set_State (Okay);
2395
 
2396
                  Zero_Suppression;
2397
                  Trailing_Currency;
2398
                  Optional_RHS_Sign;
2399
                  return;
2400
 
2401
               when '.' | 'V' | 'v' =>
2402
                  if State /= Okay then
2403
                     Pic.Floater := '!';
2404
                     Pic.Start_Float := Invalid_Position;
2405
                     Pic.End_Float := Invalid_Position;
2406
                  end if;
2407
 
2408
                  --  Don't assume that state is okay, haven't seen a digit
2409
 
2410
                  Picture;
2411
                  return;
2412
 
2413
               when others =>
2414
                  return;
2415
 
2416
            end case;
2417
         end loop;
2418
      end Picture_Plus;
2419
 
2420
      --------------------
2421
      -- Picture_String --
2422
      --------------------
2423
 
2424
      procedure Picture_String is
2425
      begin
2426
         while Is_Insert loop
2427
            Skip;
2428
         end loop;
2429
 
2430
         case Look is
2431
 
2432
            when '$' | '#' =>
2433
               Picture;
2434
               Optional_RHS_Sign;
2435
 
2436
            when '+' =>
2437
               Picture_Plus;
2438
 
2439
            when '-' =>
2440
               Picture_Minus;
2441
 
2442
            when '<' =>
2443
               Picture_Bracket;
2444
 
2445
            when 'Z' | 'z' =>
2446
               Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2447
               Zero_Suppression;
2448
               Trailing_Currency;
2449
               Optional_RHS_Sign;
2450
 
2451
            when '*' =>
2452
               Star_Suppression;
2453
               Trailing_Currency;
2454
               Optional_RHS_Sign;
2455
 
2456
            when '9' | '.' | 'V' | 'v' =>
2457
               Number;
2458
               Trailing_Currency;
2459
               Optional_RHS_Sign;
2460
 
2461
            when others =>
2462
               raise Picture_Error;
2463
 
2464
         end case;
2465
 
2466
         --  Blank when zero either if the PIC does not contain a '9' or if
2467
         --  requested by the user and no '*'.
2468
 
2469
         Pic.Blank_When_Zero :=
2470
           (Computed_BWZ or else Pic.Blank_When_Zero)
2471
             and then not Pic.Star_Fill;
2472
 
2473
         --  Star fill if '*' and no '9'
2474
 
2475
         Pic.Star_Fill := Pic.Star_Fill and then Computed_BWZ;
2476
 
2477
         if not At_End then
2478
            Set_State (Reject);
2479
         end if;
2480
 
2481
      end Picture_String;
2482
 
2483
      ---------------
2484
      -- Set_State --
2485
      ---------------
2486
 
2487
      procedure Set_State (L : Legality) is
2488
      begin
2489
         State := L;
2490
      end Set_State;
2491
 
2492
      ----------
2493
      -- Skip --
2494
      ----------
2495
 
2496
      procedure Skip is
2497
      begin
2498
         Index := Index + 1;
2499
      end Skip;
2500
 
2501
      ----------------------
2502
      -- Star_Suppression --
2503
      ----------------------
2504
 
2505
      procedure Star_Suppression is
2506
      begin
2507
         Pic.Floater := '*';
2508
         Pic.Start_Float := Index;
2509
         Pic.End_Float := Index;
2510
         Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2511
         Set_State (Okay);
2512
 
2513
         --  Even a single * is a valid picture
2514
 
2515
         Pic.Star_Fill := True;
2516
         Skip; --  Known *
2517
 
2518
         loop
2519
            if At_End then
2520
               return;
2521
            end if;
2522
 
2523
            case Look is
2524
 
2525
               when '_' | '0' | '/' =>
2526
                  Pic.End_Float := Index;
2527
                  Skip;
2528
 
2529
               when 'B' | 'b'  =>
2530
                  Pic.End_Float := Index;
2531
                  Pic.Picture.Expanded (Index) := 'b';
2532
                  Skip;
2533
 
2534
               when '*' =>
2535
                  Pic.End_Float := Index;
2536
                  Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2537
                  Set_State (Okay); Skip;
2538
 
2539
               when '9' =>
2540
                  Set_State (Okay);
2541
                  Number_Completion;
2542
                  return;
2543
 
2544
               when '.' | 'V' | 'v' =>
2545
                  Pic.Radix_Position := Index;
2546
                  Skip;
2547
                  Number_Fraction_Or_Star_Fill;
2548
                  return;
2549
 
2550
               when '#' | '$' =>
2551
                  Trailing_Currency;
2552
                  Set_State (Okay);
2553
                  return;
2554
 
2555
               when others => raise Picture_Error;
2556
            end case;
2557
         end loop;
2558
      end Star_Suppression;
2559
 
2560
      ----------------------
2561
      -- Trailing_Bracket --
2562
      ----------------------
2563
 
2564
      procedure Trailing_Bracket is
2565
      begin
2566
         if Look = '>' then
2567
            Pic.Second_Sign := Index;
2568
            Skip;
2569
         else
2570
            raise Picture_Error;
2571
         end if;
2572
      end Trailing_Bracket;
2573
 
2574
      -----------------------
2575
      -- Trailing_Currency --
2576
      -----------------------
2577
 
2578
      procedure Trailing_Currency is
2579
      begin
2580
         if At_End then
2581
            return;
2582
         end if;
2583
 
2584
         if Look = '$' then
2585
            Pic.Start_Currency := Index;
2586
            Pic.End_Currency := Index;
2587
            Skip;
2588
 
2589
         else
2590
            while not At_End and then Look = '#' loop
2591
               if Pic.Start_Currency = Invalid_Position then
2592
                  Pic.Start_Currency := Index;
2593
               end if;
2594
 
2595
               Pic.End_Currency := Index;
2596
               Skip;
2597
            end loop;
2598
         end if;
2599
 
2600
         loop
2601
            if At_End then
2602
               return;
2603
            end if;
2604
 
2605
            case Look is
2606
               when '_' | '0' | '/' => Skip;
2607
 
2608
               when 'B' | 'b'  =>
2609
                  Pic.Picture.Expanded (Index) := 'b';
2610
                  Skip;
2611
 
2612
               when others => return;
2613
            end case;
2614
         end loop;
2615
      end Trailing_Currency;
2616
 
2617
      ----------------------
2618
      -- Zero_Suppression --
2619
      ----------------------
2620
 
2621
      procedure Zero_Suppression is
2622
      begin
2623
         Pic.Floater := 'Z';
2624
         Pic.Start_Float := Index;
2625
         Pic.End_Float := Index;
2626
         Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2627
         Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2628
 
2629
         Skip; --  Known Z
2630
 
2631
         loop
2632
            --  Even a single Z is a valid picture
2633
 
2634
            if At_End then
2635
               Set_State (Okay);
2636
               return;
2637
            end if;
2638
 
2639
            case Look is
2640
               when '_' | '0' | '/' =>
2641
                  Pic.End_Float := Index;
2642
                  Skip;
2643
 
2644
               when 'B' | 'b'  =>
2645
                  Pic.End_Float := Index;
2646
                  Pic.Picture.Expanded (Index) := 'b';
2647
                  Skip;
2648
 
2649
               when 'Z' | 'z' =>
2650
                  Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2651
 
2652
                  Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2653
                  Pic.End_Float := Index;
2654
                  Set_State (Okay);
2655
                  Skip;
2656
 
2657
               when '9' =>
2658
                  Set_State (Okay);
2659
                  Number_Completion;
2660
                  return;
2661
 
2662
               when '.' | 'V' | 'v' =>
2663
                  Pic.Radix_Position := Index;
2664
                  Skip;
2665
                  Number_Fraction_Or_Z_Fill;
2666
                  return;
2667
 
2668
               when '#' | '$' =>
2669
                  Trailing_Currency;
2670
                  Set_State (Okay);
2671
                  return;
2672
 
2673
               when others =>
2674
                  return;
2675
            end case;
2676
         end loop;
2677
      end Zero_Suppression;
2678
 
2679
   --  Start of processing for Precalculate
2680
 
2681
   begin
2682
      Picture_String;
2683
 
2684
      if State = Reject then
2685
         raise Picture_Error;
2686
      end if;
2687
 
2688
   exception
2689
 
2690
      when Constraint_Error =>
2691
 
2692
      --  To deal with special cases like null strings
2693
 
2694
      raise Picture_Error;
2695
 
2696
   end Precalculate;
2697
 
2698
   ----------------
2699
   -- To_Picture --
2700
   ----------------
2701
 
2702
   function To_Picture
2703
     (Pic_String      : String;
2704
      Blank_When_Zero : Boolean := False) return Picture
2705
   is
2706
      Result : Picture;
2707
 
2708
   begin
2709
      declare
2710
         Item : constant String := Expand (Pic_String);
2711
 
2712
      begin
2713
         Result.Contents.Picture         := (Item'Length, Item);
2714
         Result.Contents.Original_BWZ := Blank_When_Zero;
2715
         Result.Contents.Blank_When_Zero := Blank_When_Zero;
2716
         Precalculate (Result.Contents);
2717
         return Result;
2718
      end;
2719
 
2720
   exception
2721
      when others =>
2722
         raise Picture_Error;
2723
 
2724
   end To_Picture;
2725
 
2726
   -------------
2727
   -- To_Wide --
2728
   -------------
2729
 
2730
   function To_Wide (C : Character) return Wide_Character is
2731
   begin
2732
      return Wide_Character'Val (Character'Pos (C));
2733
   end To_Wide;
2734
 
2735
   -----------
2736
   -- Valid --
2737
   -----------
2738
 
2739
   function Valid
2740
     (Pic_String      : String;
2741
      Blank_When_Zero : Boolean := False) return Boolean
2742
   is
2743
   begin
2744
      declare
2745
         Expanded_Pic : constant String := Expand (Pic_String);
2746
         --  Raises Picture_Error if Item not well-formed
2747
 
2748
         Format_Rec : Format_Record;
2749
 
2750
      begin
2751
         Format_Rec.Picture := (Expanded_Pic'Length, Expanded_Pic);
2752
         Format_Rec.Blank_When_Zero := Blank_When_Zero;
2753
         Format_Rec.Original_BWZ := Blank_When_Zero;
2754
         Precalculate (Format_Rec);
2755
 
2756
         --  False only if Blank_When_0 is True but the pic string has a '*'
2757
 
2758
         return not Blank_When_Zero
2759
           or else Strings_Fixed.Index (Expanded_Pic, "*") = 0;
2760
      end;
2761
 
2762
   exception
2763
      when others => return False;
2764
   end Valid;
2765
 
2766
end Ada.Wide_Text_IO.Editing;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.