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