1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . T E X T _ I O . E D I T I N G --
9 -- Copyright (C) 1992-2023, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada
.Strings
.Fixed
;
33 package body Ada
.Text_IO
.Editing
is
35 package Strings
renames Ada
.Strings
;
36 package Strings_Fixed
renames Ada
.Strings
.Fixed
;
37 package Text_IO
renames Ada
.Text_IO
;
43 function Blank_When_Zero
(Pic
: Picture
) return Boolean is
45 return Pic
.Contents
.Original_BWZ
;
52 function Expand
(Picture
: String) return String is
53 Result
: String (1 .. MAX_PICSIZE
);
54 Picture_Index
: Integer := Picture
'First;
55 Result_Index
: Integer := Result
'First;
59 package Int_IO
is new Ada
.Text_IO
.Integer_IO
(Integer);
62 if Picture
'Length < 1 then
66 if Picture
(Picture
'First) = '(' then
71 case Picture
(Picture_Index
) is
74 (Picture
(Picture_Index
+ 1 .. Picture
'Last), Count
, Last
);
76 if Picture
(Last
+ 1) /= ')' then
80 -- In what follows note that one copy of the repeated character
81 -- has already been made, so a count of one is a no-op, and a
82 -- count of zero erases a character.
84 if Result_Index
+ Count
- 2 > Result
'Last then
88 for J
in 2 .. Count
loop
89 Result
(Result_Index
+ J
- 2) := Picture
(Picture_Index
- 1);
92 Result_Index
:= Result_Index
+ Count
- 1;
94 -- Last + 1 was a ')' throw it away too
96 Picture_Index
:= Last
+ 2;
102 if Result_Index
> Result
'Last then
106 Result
(Result_Index
) := Picture
(Picture_Index
);
107 Picture_Index
:= Picture_Index
+ 1;
108 Result_Index
:= Result_Index
+ 1;
111 exit when Picture_Index
> Picture
'Last;
114 return Result
(1 .. Result_Index
- 1);
125 function Format_Number
126 (Pic
: Format_Record
;
128 Currency_Symbol
: String;
129 Fill_Character
: Character;
130 Separator_Character
: Character;
131 Radix_Point
: Character) return String
133 Attrs
: Number_Attributes
:= Parse_Number_String
(Number
);
135 Rounded
: String := Number
;
137 Sign_Position
: Integer := Pic
.Sign_Position
; -- may float.
139 Answer
: String (1 .. Pic
.Picture
.Length
) := Pic
.Picture
.Expanded
;
141 Currency_Pos
: Integer := Pic
.Start_Currency
;
142 In_Currency
: Boolean := False;
144 Dollar
: Boolean := False;
145 -- Overridden immediately if necessary
147 Zero
: Boolean := True;
148 -- Set to False when a non-zero digit is output
152 -- If the picture has fewer decimal places than the number, the image
153 -- must be rounded according to the usual rules.
155 if Attrs
.Has_Fraction
then
157 R
: constant Integer :=
158 (Attrs
.End_Of_Fraction
- Attrs
.Start_Of_Fraction
+ 1)
159 - Pic
.Max_Trailing_Digits
;
164 R_Pos
:= Attrs
.End_Of_Fraction
- R
;
166 if Rounded
(R_Pos
+ 1) > '4' then
168 if Rounded
(R_Pos
) = '.' then
172 if Rounded
(R_Pos
) /= '9' then
173 Rounded
(R_Pos
) := Character'Succ (Rounded
(R_Pos
));
175 Rounded
(R_Pos
) := '0';
179 if Rounded
(R_Pos
) = '.' then
183 if Rounded
(R_Pos
) /= '9' then
184 Rounded
(R_Pos
) := Character'Succ (Rounded
(R_Pos
));
187 Rounded
(R_Pos
) := '0';
192 -- The rounding may add a digit in front. Either the
193 -- leading blank or the sign (already captured) can
197 Rounded
(R_Pos
) := '1';
198 Attrs
.Start_Of_Int
:= Attrs
.Start_Of_Int
- 1;
206 if Pic
.Start_Currency
/= Invalid_Position
then
207 Dollar
:= Answer
(Pic
.Start_Currency
) = '$';
210 -- Fix up "direct inserts" outside the playing field. Set up as one
211 -- loop to do the beginning, one (reverse) loop to do the end.
215 exit when Last
= Pic
.Start_Float
;
216 exit when Last
= Pic
.Radix_Position
;
217 exit when Answer
(Last
) = '9';
219 case Answer
(Last
) is
221 Answer
(Last
) := Separator_Character
;
224 Answer
(Last
) := ' ';
230 exit when Last
= Answer
'Last;
235 -- Now for the end...
237 for J
in reverse Last
.. Answer
'Last loop
238 exit when J
= Pic
.Radix_Position
;
240 -- Do this test First, Separator_Character can equal Pic.Floater
242 if Answer
(J
) = Pic
.Floater
then
248 Answer
(J
) := Separator_Character
;
263 if Pic
.Start_Currency
/= -1
264 and then Answer
(Pic
.Start_Currency
) = '#'
265 and then Pic
.Floater
/= '#'
267 if Currency_Symbol
'Length >
268 Pic
.End_Currency
- Pic
.Start_Currency
+ 1
272 elsif Currency_Symbol
'Length =
273 Pic
.End_Currency
- Pic
.Start_Currency
+ 1
275 Answer
(Pic
.Start_Currency
.. Pic
.End_Currency
) :=
278 elsif Pic
.Radix_Position
= Invalid_Position
279 or else Pic
.Start_Currency
< Pic
.Radix_Position
281 Answer
(Pic
.Start_Currency
.. Pic
.End_Currency
) :=
283 Answer
(Pic
.End_Currency
- Currency_Symbol
'Length + 1 ..
284 Pic
.End_Currency
) := Currency_Symbol
;
287 Answer
(Pic
.Start_Currency
.. Pic
.End_Currency
) :=
289 Answer
(Pic
.Start_Currency
..
290 Pic
.Start_Currency
+ Currency_Symbol
'Length - 1) :=
295 -- Fill in leading digits
297 if Attrs
.End_Of_Int
- Attrs
.Start_Of_Int
+ 1 >
298 Pic
.Max_Leading_Digits
300 raise Ada
.Text_IO
.Layout_Error
;
304 (if Pic
.Radix_Position
= Invalid_Position
306 else Pic
.Radix_Position
- 1);
308 for J
in reverse Attrs
.Start_Of_Int
.. Attrs
.End_Of_Int
loop
309 while Answer
(Position
) /= '9'
311 Answer
(Position
) /= Pic
.Floater
313 if Answer
(Position
) = '_' then
314 Answer
(Position
) := Separator_Character
;
316 elsif Answer
(Position
) = 'b' then
317 Answer
(Position
) := ' ';
320 Position
:= Position
- 1;
323 Answer
(Position
) := Rounded
(J
);
325 if Rounded
(J
) /= '0' then
329 Position
:= Position
- 1;
334 if Pic
.Start_Float
= Invalid_Position
then
336 -- No leading floats, but need to change '9' to '0', '_' to
337 -- Separator_Character and 'b' to ' '.
339 for J
in Last
.. Position
loop
341 -- Last set when fixing the "uninteresting" leaders above.
342 -- Don't duplicate the work.
344 if Answer
(J
) = '9' then
347 elsif Answer
(J
) = '_' then
348 Answer
(J
) := Separator_Character
;
350 elsif Answer
(J
) = 'b' then
355 elsif Pic
.Floater
= '<'
361 for J
in Pic
.End_Float
.. Position
loop -- May be null range.
362 if Answer
(J
) = '9' then
365 elsif Answer
(J
) = '_' then
366 Answer
(J
) := Separator_Character
;
368 elsif Answer
(J
) = 'b' then
373 if Position
> Pic
.End_Float
then
374 Position
:= Pic
.End_Float
;
377 for J
in Pic
.Start_Float
.. Position
- 1 loop
381 Answer
(Position
) := Pic
.Floater
;
382 Sign_Position
:= Position
;
384 elsif Pic
.Floater
= '$' then
386 for J
in Pic
.End_Float
.. Position
loop -- May be null range.
387 if Answer
(J
) = '9' then
390 elsif Answer
(J
) = '_' then
391 Answer
(J
) := ' '; -- no separators before leftmost digit.
393 elsif Answer
(J
) = 'b' then
398 if Position
> Pic
.End_Float
then
399 Position
:= Pic
.End_Float
;
402 for J
in Pic
.Start_Float
.. Position
- 1 loop
406 Answer
(Position
) := Pic
.Floater
;
407 Currency_Pos
:= Position
;
409 elsif Pic
.Floater
= '*' then
411 for J
in Pic
.End_Float
.. Position
loop -- May be null range.
412 if Answer
(J
) = '9' then
415 elsif Answer
(J
) = '_' then
416 Answer
(J
) := Separator_Character
;
418 elsif Answer
(J
) = 'b' then
419 Answer
(J
) := Fill_Character
;
423 if Position
> Pic
.End_Float
then
424 Position
:= Pic
.End_Float
;
427 for J
in Pic
.Start_Float
.. Position
loop
428 Answer
(J
) := Fill_Character
;
432 if Pic
.Floater
= '#' then
433 Currency_Pos
:= Currency_Symbol
'Length;
437 for J
in reverse Pic
.Start_Float
.. Position
loop
440 Answer
(J
) := Fill_Character
;
443 if In_Currency
and then Currency_Pos
> 0 then
444 Answer
(J
) := Currency_Symbol
(Currency_Pos
);
445 Currency_Pos
:= Currency_Pos
- 1;
456 when '.' |
'V' |
'v' |
'<' |
'$' |
'+' |
'-' =>
460 if Currency_Pos
= 0 then
463 Answer
(J
) := Currency_Symbol
(Currency_Pos
);
464 Currency_Pos
:= Currency_Pos
- 1;
470 Answer
(J
) := Fill_Character
;
476 if Currency_Pos
= 0 then
480 Answer
(J
) := Currency_Symbol
(Currency_Pos
);
481 Currency_Pos
:= Currency_Pos
- 1;
493 if Pic
.Floater
= '#' and then Currency_Pos
/= 0 then
494 raise Ada
.Text_IO
.Layout_Error
;
500 if Sign_Position
= Invalid_Position
then
501 if Attrs
.Negative
then
502 raise Ada
.Text_IO
.Layout_Error
;
506 if Attrs
.Negative
then
507 case Answer
(Sign_Position
) is
508 when 'C' |
'D' |
'-' =>
512 Answer
(Sign_Position
) := '-';
515 Answer
(Sign_Position
) := '(';
516 Answer
(Pic
.Second_Sign
) := ')';
524 case Answer
(Sign_Position
) is
526 Answer
(Sign_Position
) := ' ';
528 when '<' |
'C' |
'D' =>
529 Answer
(Sign_Position
) := ' ';
530 Answer
(Pic
.Second_Sign
) := ' ';
541 -- Fill in trailing digits
543 if Pic
.Max_Trailing_Digits
> 0 then
545 if Attrs
.Has_Fraction
then
546 Position
:= Attrs
.Start_Of_Fraction
;
547 Last
:= Pic
.Radix_Position
+ 1;
549 for J
in Last
.. Answer
'Last loop
550 if Answer
(J
) = '9' or else Answer
(J
) = Pic
.Floater
then
551 Answer
(J
) := Rounded
(Position
);
553 if Rounded
(Position
) /= '0' then
557 Position
:= Position
+ 1;
560 -- Used up fraction but remember place in Answer
562 exit when Position
> Attrs
.End_Of_Fraction
;
564 elsif Answer
(J
) = 'b' then
567 elsif Answer
(J
) = '_' then
568 Answer
(J
) := Separator_Character
;
577 Position
:= Pic
.Radix_Position
+ 1;
580 -- Now fill remaining 9's with zeros and _ with separators
584 for J
in Position
.. Last
loop
585 if Answer
(J
) = '9' then
588 elsif Answer
(J
) = Pic
.Floater
then
591 elsif Answer
(J
) = '_' then
592 Answer
(J
) := Separator_Character
;
594 elsif Answer
(J
) = 'b' then
600 Position
:= Last
+ 1;
603 if Pic
.Floater
= '#' and then Currency_Pos
/= 0 then
604 raise Ada
.Text_IO
.Layout_Error
;
607 -- No trailing digits, but now J may need to stick in a currency
611 (if Pic
.Start_Currency
= Invalid_Position
613 else Pic
.Start_Currency
);
616 for J
in Position
.. Answer
'Last loop
617 if Pic
.Start_Currency
/= Invalid_Position
618 and then Answer
(Pic
.Start_Currency
) = '#'
625 Answer
(J
) := Fill_Character
;
629 Answer
(J
) := Currency_Symbol
(Currency_Pos
);
630 Currency_Pos
:= Currency_Pos
+ 1;
632 if Currency_Pos
> Currency_Symbol
'Length then
633 In_Currency
:= False;
638 if Currency_Pos
> Currency_Symbol
'Length then
643 Answer
(J
) := Currency_Symbol
(Currency_Pos
);
644 Currency_Pos
:= Currency_Pos
+ 1;
646 if Currency_Pos
> Currency_Symbol
'Length then
647 In_Currency
:= False;
652 Answer
(J
) := Currency_Symbol
(Currency_Pos
);
653 Currency_Pos
:= Currency_Pos
+ 1;
657 Answer
(J
) := Fill_Character
;
663 if Currency_Pos
> Currency_Symbol
'Length then
666 Answer
(J
) := Currency_Symbol
(Currency_Pos
);
667 Currency_Pos
:= Currency_Pos
+ 1;
679 -- Now get rid of Blank_when_Zero and complete Star fill
681 if Zero
and then Pic
.Blank_When_Zero
then
683 -- Value is zero, and blank it
688 Last
:= Last
- 1 + Currency_Symbol
'Length;
691 if Pic
.Radix_Position
/= Invalid_Position
692 and then Answer
(Pic
.Radix_Position
) = 'V'
697 return String'(1 .. Last => ' ');
699 elsif Zero and then Pic.Star_Fill then
703 Last := Last - 1 + Currency_Symbol'Length;
706 if Pic.Radix_Position /= Invalid_Position then
708 if Answer (Pic.Radix_Position) = 'V
' then
712 if Pic.Radix_Position > Pic.Start_Currency then
713 return String'(1 .. Pic
.Radix_Position
- 1 => '*') &
715 String'(Pic.Radix_Position + 1 .. Last => '*');
721 Pic
.Radix_Position
+ Currency_Symbol
'Length - 2 =>
724 (Pic.Radix_Position + Currency_Symbol'Length .. Last
729 return String'(1 .. Pic
.Radix_Position
- 1 => '*') &
731 String'(Pic.Radix_Position + 1 .. Last => '*');
735 return String'(1 .. Last
=> '*');
738 -- This was once a simple return statement, now there are nine different
739 -- return cases. Not to mention the five above to deal with zeros. Why
740 -- not split things out?
742 -- Processing the radix and sign expansion separately would require
743 -- lots of copying--the string and some of its indexes--without
744 -- really simplifying the logic. The cases are:
746 -- 1) Expand $, replace '.' with Radix_Point
747 -- 2) No currency expansion, replace '.' with Radix_Point
748 -- 3) Expand $, radix blanked
749 -- 4) No currency expansion, radix blanked
751 -- 6) Expand $, Elide V
752 -- 7) Elide V, Expand $ (Two cases depending on order.)
753 -- 8) No radix, expand $
754 -- 9) No radix, no currency expansion
756 if Pic
.Radix_Position
/= Invalid_Position
then
758 if Answer
(Pic
.Radix_Position
) = '.' then
759 Answer
(Pic
.Radix_Position
) := Radix_Point
;
763 -- 1) Expand $, replace '.' with Radix_Point
765 return Answer
(1 .. Currency_Pos
- 1) & Currency_Symbol
&
766 Answer
(Currency_Pos
+ 1 .. Answer
'Last);
769 -- 2) No currency expansion, replace '.' with Radix_Point
774 elsif Answer
(Pic
.Radix_Position
) = ' ' then -- blanked radix.
777 -- 3) Expand $, radix blanked
779 return Answer
(1 .. Currency_Pos
- 1) & Currency_Symbol
&
780 Answer
(Currency_Pos
+ 1 .. Answer
'Last);
783 -- 4) No expansion, radix blanked
795 return Answer
(1 .. Pic
.Radix_Position
- 1) &
796 Answer
(Pic
.Radix_Position
+ 1 .. Answer
'Last);
798 elsif Currency_Pos
< Pic
.Radix_Position
then
800 -- 6) Expand $, Elide V
802 return Answer
(1 .. Currency_Pos
- 1) & Currency_Symbol
&
803 Answer
(Currency_Pos
+ 1 .. Pic
.Radix_Position
- 1) &
804 Answer
(Pic
.Radix_Position
+ 1 .. Answer
'Last);
807 -- 7) Elide V, Expand $
809 return Answer
(1 .. Pic
.Radix_Position
- 1) &
810 Answer
(Pic
.Radix_Position
+ 1 .. Currency_Pos
- 1) &
812 Answer
(Currency_Pos
+ 1 .. Answer
'Last);
818 -- 8) No radix, expand $
820 return Answer
(1 .. Currency_Pos
- 1) & Currency_Symbol
&
821 Answer
(Currency_Pos
+ 1 .. Answer
'Last);
824 -- 9) No radix, no currency expansion
830 -------------------------
831 -- Parse_Number_String --
832 -------------------------
834 function Parse_Number_String
(Str
: String) return Number_Attributes
is
835 Answer
: Number_Attributes
;
838 for J
in Str
'Range loop
845 -- Decide if this is the start of a number.
846 -- If so, figure out which one...
848 if Answer
.Has_Fraction
then
849 Answer
.End_Of_Fraction
:= J
;
851 if Answer
.Start_Of_Int
= Invalid_Position
then
853 Answer
.Start_Of_Int
:= J
;
855 Answer
.End_Of_Int
:= J
;
860 -- Only count a zero before the decimal point if it follows a
861 -- non-zero digit. After the decimal point, zeros will be
862 -- counted if followed by a non-zero digit.
864 if not Answer
.Has_Fraction
then
865 if Answer
.Start_Of_Int
/= Invalid_Position
then
866 Answer
.End_Of_Int
:= J
;
874 Answer
.Negative
:= True;
878 -- Close integer, start fraction
880 if Answer
.Has_Fraction
then
884 -- Two decimal points is a no-no
886 Answer
.Has_Fraction
:= True;
887 Answer
.End_Of_Fraction
:= J
;
889 -- Could leave this at Invalid_Position, but this seems the
890 -- right way to indicate a null range...
892 Answer
.Start_Of_Fraction
:= J
+ 1;
893 Answer
.End_Of_Int
:= J
- 1;
896 raise Picture_Error
; -- can this happen? probably not
900 if Answer
.Start_Of_Int
= Invalid_Position
then
901 Answer
.Start_Of_Int
:= Answer
.End_Of_Int
+ 1;
904 -- No significant (integer) digits needs a null range
907 end Parse_Number_String
;
913 -- The following ensures that we return B and not b being careful not
914 -- to break things which expect lower case b for blank. See CXF3A02.
916 function Pic_String
(Pic
: Picture
) return String is
917 Temp
: String (1 .. Pic
.Contents
.Picture
.Length
) :=
918 Pic
.Contents
.Picture
.Expanded
;
920 for J
in Temp
'Range loop
921 if Temp
(J
) = 'b' then
933 procedure Precalculate
(Pic
: in out Format_Record
) is
934 Debug
: constant Boolean := False;
935 -- Set True to generate debug output
937 Computed_BWZ
: Boolean := True;
939 type Legality
is (Okay
, Reject
);
941 State
: Legality
:= Reject
;
942 -- Start in reject, which will reject null strings
944 Index
: Pic_Index
:= Pic
.Picture
.Expanded
'First;
946 function At_End
return Boolean;
947 pragma Inline
(At_End
);
949 procedure Set_State
(L
: Legality
);
950 pragma Inline
(Set_State
);
952 function Look
return Character;
953 pragma Inline
(Look
);
955 function Is_Insert
return Boolean;
956 pragma Inline
(Is_Insert
);
959 pragma Inline
(Skip
);
961 procedure Debug_Start
(Name
: String);
962 pragma Inline
(Debug_Start
);
964 procedure Debug_Integer
(Value
: Integer; S
: String);
965 pragma Inline
(Debug_Integer
);
967 procedure Trailing_Currency
;
968 procedure Trailing_Bracket
;
969 procedure Number_Fraction
;
970 procedure Number_Completion
;
971 procedure Number_Fraction_Or_Bracket
;
972 procedure Number_Fraction_Or_Z_Fill
;
973 procedure Zero_Suppression
;
974 procedure Floating_Bracket
;
975 procedure Number_Fraction_Or_Star_Fill
;
976 procedure Star_Suppression
;
977 procedure Number_Fraction_Or_Dollar
;
978 procedure Leading_Dollar
;
979 procedure Number_Fraction_Or_Pound
;
980 procedure Leading_Pound
;
982 procedure Floating_Plus
;
983 procedure Floating_Minus
;
984 procedure Picture_Plus
;
985 procedure Picture_Minus
;
986 procedure Picture_Bracket
;
988 procedure Optional_RHS_Sign
;
989 procedure Picture_String
;
996 function At_End
return Boolean is
998 Debug_Start
("At_End");
999 return Index
> Pic
.Picture
.Length
;
1006 -- Needed to have a procedure to pass to pragma Debug
1008 procedure Set_Debug
is
1010 -- Uncomment this line and make Debug a variable to enable debug
1021 procedure Debug_Integer
(Value
: Integer; S
: String) is
1024 if Debug
and then Value
> 0 then
1025 if Ada
.Text_IO
.Col
> 70 - S
'Length then
1026 Ada
.Text_IO
.New_Line
;
1029 Ada
.Text_IO
.Put
(' ' & S
& Integer'Image (Value
) & ',');
1037 procedure Debug_Start
(Name
: String) is
1040 Ada
.Text_IO
.Put_Line
(" In " & Name
& '.');
1044 ----------------------
1045 -- Floating_Bracket --
1046 ----------------------
1048 -- Note that Floating_Bracket is only called with an acceptable
1049 -- prefix. But we don't set Okay, because we must end with a '>'.
1051 procedure Floating_Bracket
is
1053 Debug_Start
("Floating_Bracket");
1055 -- Two different floats not allowed
1057 if Pic
.Floater
/= '!' and then Pic
.Floater
/= '<' then
1058 raise Picture_Error
;
1064 Pic
.End_Float
:= Index
;
1065 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1067 -- First bracket wasn't counted...
1077 when '_' |
'0' |
'/' =>
1078 Pic
.End_Float
:= Index
;
1082 Pic
.End_Float
:= Index
;
1083 Pic
.Picture
.Expanded
(Index
) := 'b';
1087 Pic
.End_Float
:= Index
;
1088 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1100 when 'V' |
'v' |
'.' =>
1101 Pic
.Radix_Position
:= Index
;
1103 Number_Fraction_Or_Bracket
;
1110 end Floating_Bracket
;
1112 --------------------
1113 -- Floating_Minus --
1114 --------------------
1116 procedure Floating_Minus
is
1118 Debug_Start
("Floating_Minus");
1126 when '_' |
'0' |
'/' =>
1127 Pic
.End_Float
:= Index
;
1131 Pic
.End_Float
:= Index
;
1132 Pic
.Picture
.Expanded
(Index
) := 'b';
1136 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1137 Pic
.End_Float
:= Index
;
1144 when '.' |
'V' |
'v' =>
1145 Pic
.Radix_Position
:= Index
;
1148 while Is_Insert
loop
1164 Pic
.Max_Trailing_Digits
:=
1165 Pic
.Max_Trailing_Digits
+ 1;
1166 Pic
.End_Float
:= Index
;
1169 when '_' |
'0' |
'/' =>
1173 Pic
.Picture
.Expanded
(Index
) := 'b';
1197 procedure Floating_Plus
is
1199 Debug_Start
("Floating_Plus");
1207 when '_' |
'0' |
'/' =>
1208 Pic
.End_Float
:= Index
;
1212 Pic
.End_Float
:= Index
;
1213 Pic
.Picture
.Expanded
(Index
) := 'b';
1217 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1218 Pic
.End_Float
:= Index
;
1225 when '.' |
'V' |
'v' =>
1226 Pic
.Radix_Position
:= Index
;
1229 while Is_Insert
loop
1245 Pic
.Max_Trailing_Digits
:=
1246 Pic
.Max_Trailing_Digits
+ 1;
1247 Pic
.End_Float
:= Index
;
1250 when '_' |
'0' |
'/' =>
1254 Pic
.Picture
.Expanded
(Index
) := 'b';
1278 function Is_Insert
return Boolean is
1284 case Pic
.Picture
.Expanded
(Index
) is
1285 when '_' |
'0' |
'/' =>
1289 Pic
.Picture
.Expanded
(Index
) := 'b'; -- canonical
1297 --------------------
1298 -- Leading_Dollar --
1299 --------------------
1301 -- Note that Leading_Dollar can be called in either State. It will set
1302 -- state to Okay only if a 9 or (second) $ is encountered.
1304 -- Also notice the tricky bit with State and Zero_Suppression.
1305 -- Zero_Suppression is Picture_Error if a '$' or a '9' has been
1306 -- encountered, exactly the cases where State has been set.
1308 procedure Leading_Dollar
is
1310 Debug_Start
("Leading_Dollar");
1312 -- Treat as a floating dollar, and unwind otherwise
1314 if Pic
.Floater
/= '!' and then Pic
.Floater
/= '$' then
1316 -- Two floats not allowed
1318 raise Picture_Error
;
1324 Pic
.Start_Currency
:= Index
;
1325 Pic
.End_Currency
:= Index
;
1326 Pic
.Start_Float
:= Index
;
1327 Pic
.End_Float
:= Index
;
1329 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1340 when '_' |
'0' |
'/' =>
1341 Pic
.End_Float
:= Index
;
1344 -- A trailing insertion character is not part of the
1345 -- floating currency, so need to look ahead.
1348 Pic
.End_Float
:= Pic
.End_Float
- 1;
1352 Pic
.End_Float
:= Index
;
1353 Pic
.Picture
.Expanded
(Index
) := 'b';
1357 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
1359 if State
= Okay
then
1360 raise Picture_Error
;
1362 -- Overwrite Floater and Start_Float
1365 Pic
.Start_Float
:= Index
;
1370 if State
= Okay
then
1371 raise Picture_Error
;
1373 -- Overwrite Floater and Start_Float
1376 Pic
.Start_Float
:= Index
;
1381 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1382 Pic
.End_Float
:= Index
;
1383 Pic
.End_Currency
:= Index
;
1384 Set_State
(Okay
); Skip
;
1387 if State
/= Okay
then
1389 Pic
.Start_Float
:= Invalid_Position
;
1390 Pic
.End_Float
:= Invalid_Position
;
1393 -- A single dollar does not a floating make
1398 when 'V' |
'v' |
'.' =>
1399 if State
/= Okay
then
1401 Pic
.Start_Float
:= Invalid_Position
;
1402 Pic
.End_Float
:= Invalid_Position
;
1405 -- Only one dollar before the sign is okay, but doesn't
1408 Pic
.Radix_Position
:= Index
;
1410 Number_Fraction_Or_Dollar
;
1423 -- This one is complex. A Leading_Pound can be fixed or floating,
1424 -- but in some cases the decision has to be deferred until we leave
1425 -- this procedure. Also note that Leading_Pound can be called in
1428 -- It will set state to Okay only if a 9 or (second) # is encountered
1430 -- One Last note: In ambiguous cases, the currency is treated as
1431 -- floating unless there is only one '#'.
1433 procedure Leading_Pound
is
1435 Inserts
: Boolean := False;
1436 -- Set to True if a '_', '0', '/', 'B', or 'b' is encountered
1438 Must_Float
: Boolean := False;
1439 -- Set to true if a '#' occurs after an insert
1442 Debug_Start
("Leading_Pound");
1444 -- Treat as a floating currency. If it isn't, this will be
1445 -- overwritten later.
1447 if Pic
.Floater
/= '!' and then Pic
.Floater
/= '#' then
1449 -- Two floats not allowed
1451 raise Picture_Error
;
1457 Pic
.Start_Currency
:= Index
;
1458 Pic
.End_Currency
:= Index
;
1459 Pic
.Start_Float
:= Index
;
1460 Pic
.End_Float
:= Index
;
1462 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1465 Pic
.Max_Currency_Digits
:= 1; -- we've seen one.
1475 when '_' |
'0' |
'/' =>
1476 Pic
.End_Float
:= Index
;
1481 Pic
.Picture
.Expanded
(Index
) := 'b';
1482 Pic
.End_Float
:= Index
;
1487 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
1490 raise Picture_Error
;
1492 Pic
.Max_Leading_Digits
:= 0;
1494 -- Overwrite Floater and Start_Float
1497 Pic
.Start_Float
:= Index
;
1503 raise Picture_Error
;
1505 Pic
.Max_Leading_Digits
:= 0;
1507 -- Overwrite Floater and Start_Float
1509 Pic
.Start_Float
:= Index
;
1518 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1519 Pic
.End_Float
:= Index
;
1520 Pic
.End_Currency
:= Index
;
1525 if State
/= Okay
then
1527 -- A single '#' doesn't float
1530 Pic
.Start_Float
:= Invalid_Position
;
1531 Pic
.End_Float
:= Invalid_Position
;
1537 when 'V' |
'v' |
'.' =>
1538 if State
/= Okay
then
1540 Pic
.Start_Float
:= Invalid_Position
;
1541 Pic
.End_Float
:= Invalid_Position
;
1544 -- Only one pound before the sign is okay, but doesn't
1547 Pic
.Radix_Position
:= Index
;
1549 Number_Fraction_Or_Pound
;
1562 function Look
return Character is
1565 raise Picture_Error
;
1568 return Pic
.Picture
.Expanded
(Index
);
1577 Debug_Start
("Number");
1581 when '_' |
'0' |
'/' =>
1585 Pic
.Picture
.Expanded
(Index
) := 'b';
1589 Computed_BWZ
:= False;
1590 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1594 when '.' |
'V' |
'v' =>
1595 Pic
.Radix_Position
:= Index
;
1608 -- Will return in Okay state if a '9' was seen
1613 -----------------------
1614 -- Number_Completion --
1615 -----------------------
1617 procedure Number_Completion
is
1619 Debug_Start
("Number_Completion");
1621 while not At_End
loop
1623 when '_' |
'0' |
'/' =>
1627 Pic
.Picture
.Expanded
(Index
) := 'b';
1631 Computed_BWZ
:= False;
1632 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1636 when 'V' |
'v' |
'.' =>
1637 Pic
.Radix_Position
:= Index
;
1646 end Number_Completion
;
1648 ---------------------
1649 -- Number_Fraction --
1650 ---------------------
1652 procedure Number_Fraction
is
1654 -- Note that number fraction can be called in either State.
1655 -- It will set state to Valid only if a 9 is encountered.
1657 Debug_Start
("Number_Fraction");
1665 when '_' |
'0' |
'/' =>
1669 Pic
.Picture
.Expanded
(Index
) := 'b';
1673 Computed_BWZ
:= False;
1674 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1675 Set_State
(Okay
); Skip
;
1681 end Number_Fraction
;
1683 --------------------------------
1684 -- Number_Fraction_Or_Bracket --
1685 --------------------------------
1687 procedure Number_Fraction_Or_Bracket
is
1689 Debug_Start
("Number_Fraction_Or_Bracket");
1697 when '_' |
'0' |
'/' =>
1701 Pic
.Picture
.Expanded
(Index
) := 'b';
1705 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1706 Pic
.End_Float
:= Index
;
1715 when '_' |
'0' |
'/' =>
1719 Pic
.Picture
.Expanded
(Index
) := 'b';
1723 Pic
.Max_Trailing_Digits
:=
1724 Pic
.Max_Trailing_Digits
+ 1;
1725 Pic
.End_Float
:= Index
;
1738 end Number_Fraction_Or_Bracket
;
1740 -------------------------------
1741 -- Number_Fraction_Or_Dollar --
1742 -------------------------------
1744 procedure Number_Fraction_Or_Dollar
is
1746 Debug_Start
("Number_Fraction_Or_Dollar");
1754 when '_' |
'0' |
'/' =>
1758 Pic
.Picture
.Expanded
(Index
) := 'b';
1762 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1763 Pic
.End_Float
:= Index
;
1772 when '_' |
'0' |
'/' =>
1776 Pic
.Picture
.Expanded
(Index
) := 'b';
1780 Pic
.Max_Trailing_Digits
:=
1781 Pic
.Max_Trailing_Digits
+ 1;
1782 Pic
.End_Float
:= Index
;
1795 end Number_Fraction_Or_Dollar
;
1797 ------------------------------
1798 -- Number_Fraction_Or_Pound --
1799 ------------------------------
1801 procedure Number_Fraction_Or_Pound
is
1809 when '_' |
'0' |
'/' =>
1813 Pic
.Picture
.Expanded
(Index
) := 'b';
1817 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1818 Pic
.End_Float
:= Index
;
1827 when '_' |
'0' |
'/' =>
1831 Pic
.Picture
.Expanded
(Index
) := 'b';
1835 Pic
.Max_Trailing_Digits
:=
1836 Pic
.Max_Trailing_Digits
+ 1;
1837 Pic
.End_Float
:= Index
;
1850 end Number_Fraction_Or_Pound
;
1852 ----------------------------------
1853 -- Number_Fraction_Or_Star_Fill --
1854 ----------------------------------
1856 procedure Number_Fraction_Or_Star_Fill
is
1858 Debug_Start
("Number_Fraction_Or_Star_Fill");
1866 when '_' |
'0' |
'/' =>
1870 Pic
.Picture
.Expanded
(Index
) := 'b';
1874 Pic
.Star_Fill
:= True;
1875 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1876 Pic
.End_Float
:= Index
;
1885 when '_' |
'0' |
'/' =>
1889 Pic
.Picture
.Expanded
(Index
) := 'b';
1893 Pic
.Star_Fill
:= True;
1894 Pic
.Max_Trailing_Digits
:=
1895 Pic
.Max_Trailing_Digits
+ 1;
1896 Pic
.End_Float
:= Index
;
1909 end Number_Fraction_Or_Star_Fill
;
1911 -------------------------------
1912 -- Number_Fraction_Or_Z_Fill --
1913 -------------------------------
1915 procedure Number_Fraction_Or_Z_Fill
is
1917 Debug_Start
("Number_Fraction_Or_Z_Fill");
1925 when '_' |
'0' |
'/' =>
1929 Pic
.Picture
.Expanded
(Index
) := 'b';
1933 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1934 Pic
.End_Float
:= Index
;
1935 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
1945 when '_' |
'0' |
'/' =>
1949 Pic
.Picture
.Expanded
(Index
) := 'b';
1953 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
1955 Pic
.Max_Trailing_Digits
:=
1956 Pic
.Max_Trailing_Digits
+ 1;
1957 Pic
.End_Float
:= Index
;
1970 end Number_Fraction_Or_Z_Fill
;
1972 -----------------------
1973 -- Optional_RHS_Sign --
1974 -----------------------
1976 procedure Optional_RHS_Sign
is
1978 Debug_Start
("Optional_RHS_Sign");
1986 Pic
.Sign_Position
:= Index
;
1991 Pic
.Sign_Position
:= Index
;
1992 Pic
.Picture
.Expanded
(Index
) := 'C';
1995 if Look
= 'R' or else Look
= 'r' then
1996 Pic
.Second_Sign
:= Index
;
1997 Pic
.Picture
.Expanded
(Index
) := 'R';
2001 raise Picture_Error
;
2007 Pic
.Sign_Position
:= Index
;
2008 Pic
.Picture
.Expanded
(Index
) := 'D';
2011 if Look
= 'B' or else Look
= 'b' then
2012 Pic
.Second_Sign
:= Index
;
2013 Pic
.Picture
.Expanded
(Index
) := 'B';
2017 raise Picture_Error
;
2023 if Pic
.Picture
.Expanded
(Pic
.Sign_Position
) = '<' then
2024 Pic
.Second_Sign
:= Index
;
2028 raise Picture_Error
;
2034 end Optional_RHS_Sign
;
2040 -- Note that Picture can be called in either State
2042 -- It will set state to Valid only if a 9 is encountered or floating
2043 -- currency is called.
2045 procedure Picture
is
2047 Debug_Start
("Picture");
2055 when '_' |
'0' |
'/' =>
2059 Pic
.Picture
.Expanded
(Index
) := 'b';
2071 Computed_BWZ
:= False;
2073 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2076 when 'V' |
'v' |
'.' =>
2077 Pic
.Radix_Position
:= Index
;
2089 ---------------------
2090 -- Picture_Bracket --
2091 ---------------------
2093 procedure Picture_Bracket
is
2095 Pic
.Sign_Position
:= Index
;
2096 Debug_Start
("Picture_Bracket");
2097 Pic
.Sign_Position
:= Index
;
2099 -- Treat as a floating sign, and unwind otherwise
2102 Pic
.Start_Float
:= Index
;
2103 Pic
.End_Float
:= Index
;
2105 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2108 Skip
; -- Known Bracket
2112 when '_' |
'0' |
'/' =>
2113 Pic
.End_Float
:= Index
;
2117 Pic
.End_Float
:= Index
;
2118 Pic
.Picture
.Expanded
(Index
) := 'b';
2122 Set_State
(Okay
); -- "<<>" is enough.
2128 when '$' |
'#' |
'9' |
'*' =>
2129 if State
/= Okay
then
2131 Pic
.Start_Float
:= Invalid_Position
;
2132 Pic
.End_Float
:= Invalid_Position
;
2140 when '.' |
'V' |
'v' =>
2141 if State
/= Okay
then
2143 Pic
.Start_Float
:= Invalid_Position
;
2144 Pic
.End_Float
:= Invalid_Position
;
2147 -- Don't assume that state is okay, haven't seen a digit
2154 raise Picture_Error
;
2157 end Picture_Bracket
;
2163 procedure Picture_Minus
is
2165 Debug_Start
("Picture_Minus");
2167 Pic
.Sign_Position
:= Index
;
2169 -- Treat as a floating sign, and unwind otherwise
2172 Pic
.Start_Float
:= Index
;
2173 Pic
.End_Float
:= Index
;
2175 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2178 Skip
; -- Known Minus
2182 when '_' |
'0' |
'/' =>
2183 Pic
.End_Float
:= Index
;
2187 Pic
.End_Float
:= Index
;
2188 Pic
.Picture
.Expanded
(Index
) := 'b';
2192 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2193 Pic
.End_Float
:= Index
;
2195 Set_State
(Okay
); -- "-- " is enough.
2200 when '$' |
'#' |
'9' |
'*' =>
2201 if State
/= Okay
then
2203 Pic
.Start_Float
:= Invalid_Position
;
2204 Pic
.End_Float
:= Invalid_Position
;
2213 -- Can't have Z and a floating sign
2215 if State
= Okay
then
2219 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2225 when '.' |
'V' |
'v' =>
2226 if State
/= Okay
then
2228 Pic
.Start_Float
:= Invalid_Position
;
2229 Pic
.End_Float
:= Invalid_Position
;
2232 -- Don't assume that state is okay, haven't seen a digit
2247 procedure Picture_Plus
is
2249 Debug_Start
("Picture_Plus");
2250 Pic
.Sign_Position
:= Index
;
2252 -- Treat as a floating sign, and unwind otherwise
2255 Pic
.Start_Float
:= Index
;
2256 Pic
.End_Float
:= Index
;
2258 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2265 when '_' |
'0' |
'/' =>
2266 Pic
.End_Float
:= Index
;
2270 Pic
.End_Float
:= Index
;
2271 Pic
.Picture
.Expanded
(Index
) := 'b';
2275 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2276 Pic
.End_Float
:= Index
;
2278 Set_State
(Okay
); -- "++" is enough
2283 when '$' |
'#' |
'9' |
'*' =>
2284 if State
/= Okay
then
2286 Pic
.Start_Float
:= Invalid_Position
;
2287 Pic
.End_Float
:= Invalid_Position
;
2295 if State
= Okay
then
2299 -- Can't have Z and a floating sign
2301 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2303 -- '+Z' is acceptable
2307 -- Overwrite Floater and Start_Float
2310 Pic
.Start_Float
:= Index
;
2317 when '.' |
'V' |
'v' =>
2318 if State
/= Okay
then
2320 Pic
.Start_Float
:= Invalid_Position
;
2321 Pic
.End_Float
:= Invalid_Position
;
2324 -- Don't assume that state is okay, haven't seen a digit
2335 --------------------
2336 -- Picture_String --
2337 --------------------
2339 procedure Picture_String
is
2341 Debug_Start
("Picture_String");
2343 while Is_Insert
loop
2362 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2372 when '9' |
'.' |
'V' |
'v' =>
2378 raise Picture_Error
;
2381 -- Blank when zero either if the PIC does not contain a '9' or if
2382 -- requested by the user and no '*'.
2384 Pic
.Blank_When_Zero
:=
2385 (Computed_BWZ
or else Pic
.Blank_When_Zero
)
2386 and then not Pic
.Star_Fill
;
2388 -- Star fill if '*' and no '9'
2390 Pic
.Star_Fill
:= Pic
.Star_Fill
and then Computed_BWZ
;
2401 procedure Set_State
(L
: Legality
) is
2404 Ada
.Text_IO
.Put_Line
2405 (" Set state from " & Legality
'Image (State
)
2406 & " to " & Legality
'Image (L
));
2419 Ada
.Text_IO
.Put_Line
(" Skip " & Pic
.Picture
.Expanded
(Index
));
2425 ----------------------
2426 -- Star_Suppression --
2427 ----------------------
2429 procedure Star_Suppression
is
2431 Debug_Start
("Star_Suppression");
2433 if Pic
.Floater
/= '!' and then Pic
.Floater
/= '*' then
2435 -- Two floats not allowed
2437 raise Picture_Error
;
2443 Pic
.Start_Float
:= Index
;
2444 Pic
.End_Float
:= Index
;
2445 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2448 -- Even a single * is a valid picture
2450 Pic
.Star_Fill
:= True;
2459 when '_' |
'0' |
'/' =>
2460 Pic
.End_Float
:= Index
;
2464 Pic
.End_Float
:= Index
;
2465 Pic
.Picture
.Expanded
(Index
) := 'b';
2469 Pic
.End_Float
:= Index
;
2470 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2471 Set_State
(Okay
); Skip
;
2478 when '.' |
'V' |
'v' =>
2479 Pic
.Radix_Position
:= Index
;
2481 Number_Fraction_Or_Star_Fill
;
2485 if Pic
.Max_Currency_Digits
> 0 then
2486 raise Picture_Error
;
2489 -- Cannot have leading and trailing currency
2496 raise Picture_Error
;
2499 end Star_Suppression
;
2501 ----------------------
2502 -- Trailing_Bracket --
2503 ----------------------
2505 procedure Trailing_Bracket
is
2507 Debug_Start
("Trailing_Bracket");
2510 Pic
.Second_Sign
:= Index
;
2513 raise Picture_Error
;
2515 end Trailing_Bracket
;
2517 -----------------------
2518 -- Trailing_Currency --
2519 -----------------------
2521 procedure Trailing_Currency
is
2523 Debug_Start
("Trailing_Currency");
2530 Pic
.Start_Currency
:= Index
;
2531 Pic
.End_Currency
:= Index
;
2535 while not At_End
and then Look
= '#' loop
2536 if Pic
.Start_Currency
= Invalid_Position
then
2537 Pic
.Start_Currency
:= Index
;
2540 Pic
.End_Currency
:= Index
;
2551 when '_' |
'0' |
'/' =>
2555 Pic
.Picture
.Expanded
(Index
) := 'b';
2562 end Trailing_Currency
;
2564 ----------------------
2565 -- Zero_Suppression --
2566 ----------------------
2568 procedure Zero_Suppression
is
2570 Debug_Start
("Zero_Suppression");
2573 Pic
.Start_Float
:= Index
;
2574 Pic
.End_Float
:= Index
;
2575 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2576 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2581 -- Even a single Z is a valid picture
2589 when '_' |
'0' |
'/' =>
2590 Pic
.End_Float
:= Index
;
2594 Pic
.End_Float
:= Index
;
2595 Pic
.Picture
.Expanded
(Index
) := 'b';
2599 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2601 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2602 Pic
.End_Float
:= Index
;
2611 when '.' |
'V' |
'v' =>
2612 Pic
.Radix_Position
:= Index
;
2614 Number_Fraction_Or_Z_Fill
;
2626 end Zero_Suppression
;
2628 -- Start of processing for Precalculate
2631 pragma Debug
(Set_Debug
);
2636 Ada
.Text_IO
.New_Line
;
2637 Ada
.Text_IO
.Put
(" Picture : """ &
2638 Pic
.Picture
.Expanded
(1 .. Pic
.Picture
.Length
) & """,");
2639 Ada
.Text_IO
.Put
(" Floater : '" & Pic
.Floater
& "',");
2642 if State
= Reject
then
2643 raise Picture_Error
;
2646 Debug_Integer
(Pic
.Radix_Position
, "Radix Positon : ");
2647 Debug_Integer
(Pic
.Sign_Position
, "Sign Positon : ");
2648 Debug_Integer
(Pic
.Second_Sign
, "Second Sign : ");
2649 Debug_Integer
(Pic
.Start_Float
, "Start Float : ");
2650 Debug_Integer
(Pic
.End_Float
, "End Float : ");
2651 Debug_Integer
(Pic
.Start_Currency
, "Start Currency : ");
2652 Debug_Integer
(Pic
.End_Currency
, "End Currency : ");
2653 Debug_Integer
(Pic
.Max_Leading_Digits
, "Max Leading Digits : ");
2654 Debug_Integer
(Pic
.Max_Trailing_Digits
, "Max Trailing Digits : ");
2657 Ada
.Text_IO
.New_Line
;
2662 when Constraint_Error
=>
2664 -- To deal with special cases like null strings
2666 raise Picture_Error
;
2674 (Pic_String
: String;
2675 Blank_When_Zero
: Boolean := False) return Picture
2681 Item
: constant String := Expand
(Pic_String
);
2684 Result
.Contents
.Picture
:= (Item
'Length, Item
);
2685 Result
.Contents
.Original_BWZ
:= Blank_When_Zero
;
2686 Result
.Contents
.Blank_When_Zero
:= Blank_When_Zero
;
2687 Precalculate
(Result
.Contents
);
2693 raise Picture_Error
;
2701 (Pic_String
: String;
2702 Blank_When_Zero
: Boolean := False) return Boolean
2706 Expanded_Pic
: constant String := Expand
(Pic_String
);
2707 -- Raises Picture_Error if Item not well-formed
2709 Format_Rec
: Format_Record
;
2712 Format_Rec
.Picture
:= (Expanded_Pic
'Length, Expanded_Pic
);
2713 Format_Rec
.Blank_When_Zero
:= Blank_When_Zero
;
2714 Format_Rec
.Original_BWZ
:= Blank_When_Zero
;
2715 Precalculate
(Format_Rec
);
2717 -- False only if Blank_When_Zero is True but the pic string has a '*'
2719 return not Blank_When_Zero
2720 or else Strings_Fixed
.Index
(Expanded_Pic
, "*") = 0;
2724 when others => return False;
2727 --------------------
2728 -- Decimal_Output --
2729 --------------------
2731 package body Decimal_Output
is
2740 Currency
: String := Default_Currency
;
2741 Fill
: Character := Default_Fill
;
2742 Separator
: Character := Default_Separator
;
2743 Radix_Mark
: Character := Default_Radix_Mark
) return String
2746 return Format_Number
2747 (Pic
.Contents
, Num
'Image (Item
),
2748 Currency
, Fill
, Separator
, Radix_Mark
);
2757 Currency
: String := Default_Currency
) return Natural
2759 Picstr
: constant String := Pic_String
(Pic
);
2760 V_Adjust
: Integer := 0;
2761 Cur_Adjust
: Integer := 0;
2764 -- Check if Picstr has 'V' or '$'
2766 -- If 'V', then length is 1 less than otherwise
2768 -- If '$', then length is Currency'Length-1 more than otherwise
2770 -- This should use the string handling package ???
2772 for J
in Picstr
'Range loop
2773 if Picstr
(J
) = 'V' then
2776 elsif Picstr
(J
) = '$' then
2777 Cur_Adjust
:= Currency
'Length - 1;
2781 return Picstr
'Length - V_Adjust
+ Cur_Adjust
;
2789 (File
: Text_IO
.File_Type
;
2792 Currency
: String := Default_Currency
;
2793 Fill
: Character := Default_Fill
;
2794 Separator
: Character := Default_Separator
;
2795 Radix_Mark
: Character := Default_Radix_Mark
)
2798 Text_IO
.Put
(File
, Image
(Item
, Pic
,
2799 Currency
, Fill
, Separator
, Radix_Mark
));
2805 Currency
: String := Default_Currency
;
2806 Fill
: Character := Default_Fill
;
2807 Separator
: Character := Default_Separator
;
2808 Radix_Mark
: Character := Default_Radix_Mark
)
2811 Text_IO
.Put
(Image
(Item
, Pic
,
2812 Currency
, Fill
, Separator
, Radix_Mark
));
2819 Currency
: String := Default_Currency
;
2820 Fill
: Character := Default_Fill
;
2821 Separator
: Character := Default_Separator
;
2822 Radix_Mark
: Character := Default_Radix_Mark
)
2824 Result
: constant String :=
2825 Image
(Item
, Pic
, Currency
, Fill
, Separator
, Radix_Mark
);
2828 if Result
'Length > To
'Length then
2829 raise Ada
.Text_IO
.Layout_Error
;
2831 Strings_Fixed
.Move
(Source
=> Result
, Target
=> To
,
2832 Justify
=> Strings
.Right
);
2843 Currency
: String := Default_Currency
) return Boolean
2847 Temp
: constant String := Image
(Item
, Pic
, Currency
);
2848 pragma Warnings
(Off
, Temp
);
2854 when Ada
.Text_IO
.Layout_Error
=> return False;
2859 end Ada
.Text_IO
.Editing
;