1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . W I D E _ T E X T _ I O . E D I T I N G --
9 -- Copyright (C) 1992-2009, 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 with Ada
.Strings
.Wide_Fixed
;
35 package body Ada
.Wide_Text_IO
.Editing
is
37 package Strings
renames Ada
.Strings
;
38 package Strings_Fixed
renames Ada
.Strings
.Fixed
;
39 package Strings_Wide_Fixed
renames Ada
.Strings
.Wide_Fixed
;
40 package Wide_Text_IO
renames Ada
.Wide_Text_IO
;
42 -----------------------
43 -- Local_Subprograms --
44 -----------------------
46 function To_Wide
(C
: Character) return Wide_Character;
47 pragma Inline
(To_Wide
);
48 -- Convert Character to corresponding Wide_Character
54 function Blank_When_Zero
(Pic
: Picture
) return Boolean is
56 return Pic
.Contents
.Original_BWZ
;
63 package body Decimal_Output
is
72 Currency
: Wide_String := Default_Currency
;
73 Fill
: Wide_Character := Default_Fill
;
74 Separator
: Wide_Character := Default_Separator
;
75 Radix_Mark
: Wide_Character := Default_Radix_Mark
) return Wide_String
79 (Pic
.Contents
, Num
'Image (Item
),
80 Currency
, Fill
, Separator
, Radix_Mark
);
89 Currency
: Wide_String := Default_Currency
) return Natural
91 Picstr
: constant String := Pic_String
(Pic
);
92 V_Adjust
: Integer := 0;
93 Cur_Adjust
: Integer := 0;
96 -- Check if Picstr has 'V' or '$'
98 -- If 'V', then length is 1 less than otherwise
100 -- If '$', then length is Currency'Length-1 more than otherwise
102 -- This should use the string handling package ???
104 for J
in Picstr
'Range loop
105 if Picstr
(J
) = 'V' then
108 elsif Picstr
(J
) = '$' then
109 Cur_Adjust
:= Currency
'Length - 1;
113 return Picstr
'Length - V_Adjust
+ Cur_Adjust
;
121 (File
: Wide_Text_IO
.File_Type
;
124 Currency
: Wide_String := Default_Currency
;
125 Fill
: Wide_Character := Default_Fill
;
126 Separator
: Wide_Character := Default_Separator
;
127 Radix_Mark
: Wide_Character := Default_Radix_Mark
)
130 Wide_Text_IO
.Put
(File
, Image
(Item
, Pic
,
131 Currency
, Fill
, Separator
, Radix_Mark
));
137 Currency
: Wide_String := Default_Currency
;
138 Fill
: Wide_Character := Default_Fill
;
139 Separator
: Wide_Character := Default_Separator
;
140 Radix_Mark
: Wide_Character := Default_Radix_Mark
)
143 Wide_Text_IO
.Put
(Image
(Item
, Pic
,
144 Currency
, Fill
, Separator
, Radix_Mark
));
148 (To
: out Wide_String;
151 Currency
: Wide_String := Default_Currency
;
152 Fill
: Wide_Character := Default_Fill
;
153 Separator
: Wide_Character := Default_Separator
;
154 Radix_Mark
: Wide_Character := Default_Radix_Mark
)
156 Result
: constant Wide_String :=
157 Image
(Item
, Pic
, Currency
, Fill
, Separator
, Radix_Mark
);
160 if Result
'Length > To
'Length then
161 raise Wide_Text_IO
.Layout_Error
;
163 Strings_Wide_Fixed
.Move
(Source
=> Result
, Target
=> To
,
164 Justify
=> Strings
.Right
);
175 Currency
: Wide_String := Default_Currency
) return Boolean
179 Temp
: constant Wide_String := Image
(Item
, Pic
, Currency
);
180 pragma Warnings
(Off
, Temp
);
186 when Layout_Error
=> return False;
195 function Expand
(Picture
: String) return String is
196 Result
: String (1 .. MAX_PICSIZE
);
197 Picture_Index
: Integer := Picture
'First;
198 Result_Index
: Integer := Result
'First;
203 if Picture
'Length < 1 then
207 if Picture
(Picture
'First) = '(' then
212 case Picture
(Picture_Index
) is
216 -- We now need to scan out the count after a left paren. In
217 -- the non-wide version we used Integer_IO.Get, but that is
218 -- not convenient here, since we don't want to drag in normal
219 -- Text_IO just for this purpose. So we do the scan ourselves,
220 -- with the normal validity checks.
222 Last
:= Picture_Index
+ 1;
225 if Picture
(Last
) not in '0' .. '9' then
229 Count
:= Character'Pos (Picture
(Last
)) - Character'Pos ('0');
233 if Last
> Picture
'Last then
237 if Picture
(Last
) = '_' then
238 if Picture
(Last
- 1) = '_' then
242 elsif Picture
(Last
) = ')' then
245 elsif Picture
(Last
) not in '0' .. '9' then
250 + Character'Pos (Picture
(Last
)) -
257 -- In what follows note that one copy of the repeated
258 -- character has already been made, so a count of one is
259 -- no-op, and a count of zero erases a character.
261 for J
in 2 .. Count
loop
262 Result
(Result_Index
+ J
- 2) := Picture
(Picture_Index
- 1);
265 Result_Index
:= Result_Index
+ Count
- 1;
267 -- Last was a ')' throw it away too
269 Picture_Index
:= Last
+ 1;
275 Result
(Result_Index
) := Picture
(Picture_Index
);
276 Picture_Index
:= Picture_Index
+ 1;
277 Result_Index
:= Result_Index
+ 1;
281 exit when Picture_Index
> Picture
'Last;
284 return Result
(1 .. Result_Index
- 1);
295 function Format_Number
296 (Pic
: Format_Record
;
298 Currency_Symbol
: Wide_String;
299 Fill_Character
: Wide_Character;
300 Separator_Character
: Wide_Character;
301 Radix_Point
: Wide_Character) return Wide_String
303 Attrs
: Number_Attributes
:= Parse_Number_String
(Number
);
305 Rounded
: String := Number
;
307 Sign_Position
: Integer := Pic
.Sign_Position
; -- may float.
309 Answer
: Wide_String (1 .. Pic
.Picture
.Length
);
311 Currency_Pos
: Integer := Pic
.Start_Currency
;
313 Dollar
: Boolean := False;
314 -- Overridden immediately if necessary
316 Zero
: Boolean := True;
317 -- Set to False when a non-zero digit is output
321 -- If the picture has fewer decimal places than the number, the image
322 -- must be rounded according to the usual rules.
324 if Attrs
.Has_Fraction
then
326 R
: constant Integer :=
327 (Attrs
.End_Of_Fraction
- Attrs
.Start_Of_Fraction
+ 1)
328 - Pic
.Max_Trailing_Digits
;
333 R_Pos
:= Rounded
'Length - R
;
335 if Rounded
(R_Pos
+ 1) > '4' then
337 if Rounded
(R_Pos
) = '.' then
341 if Rounded
(R_Pos
) /= '9' then
342 Rounded
(R_Pos
) := Character'Succ (Rounded
(R_Pos
));
344 Rounded
(R_Pos
) := '0';
348 if Rounded
(R_Pos
) = '.' then
352 if Rounded
(R_Pos
) /= '9' then
353 Rounded
(R_Pos
) := Character'Succ (Rounded
(R_Pos
));
356 Rounded
(R_Pos
) := '0';
361 -- The rounding may add a digit in front. Either the
362 -- leading blank or the sign (already captured) can be
366 Rounded
(R_Pos
) := '1';
367 Attrs
.Start_Of_Int
:= Attrs
.Start_Of_Int
- 1;
375 for J
in Answer
'Range loop
376 Answer
(J
) := To_Wide
(Pic
.Picture
.Expanded
(J
));
379 if Pic
.Start_Currency
/= Invalid_Position
then
380 Dollar
:= Answer
(Pic
.Start_Currency
) = '$';
383 -- Fix up "direct inserts" outside the playing field. Set up as one
384 -- loop to do the beginning, one (reverse) loop to do the end.
388 exit when Last
= Pic
.Start_Float
;
389 exit when Last
= Pic
.Radix_Position
;
390 exit when Answer
(Last
) = '9';
392 case Answer
(Last
) is
395 Answer
(Last
) := Separator_Character
;
398 Answer
(Last
) := ' ';
405 exit when Last
= Answer
'Last;
410 -- Now for the end...
412 for J
in reverse Last
.. Answer
'Last loop
413 exit when J
= Pic
.Radix_Position
;
415 -- Do this test First, Separator_Character can equal Pic.Floater
417 if Answer
(J
) = Pic
.Floater
then
424 Answer
(J
) := Separator_Character
;
440 if Pic
.Start_Currency
/= -1
441 and then Answer
(Pic
.Start_Currency
) = '#'
442 and then Pic
.Floater
/= '#'
444 if Currency_Symbol
'Length >
445 Pic
.End_Currency
- Pic
.Start_Currency
+ 1
449 elsif Currency_Symbol
'Length =
450 Pic
.End_Currency
- Pic
.Start_Currency
+ 1
452 Answer
(Pic
.Start_Currency
.. Pic
.End_Currency
) :=
455 elsif Pic
.Radix_Position
= Invalid_Position
456 or else Pic
.Start_Currency
< Pic
.Radix_Position
458 Answer
(Pic
.Start_Currency
.. Pic
.End_Currency
) :=
460 Answer
(Pic
.End_Currency
- Currency_Symbol
'Length + 1 ..
461 Pic
.End_Currency
) := Currency_Symbol
;
464 Answer
(Pic
.Start_Currency
.. Pic
.End_Currency
) :=
466 Answer
(Pic
.Start_Currency
..
467 Pic
.Start_Currency
+ Currency_Symbol
'Length - 1) :=
472 -- Fill in leading digits
474 if Attrs
.End_Of_Int
- Attrs
.Start_Of_Int
+ 1 >
475 Pic
.Max_Leading_Digits
480 if Pic
.Radix_Position
= Invalid_Position
then
481 Position
:= Answer
'Last;
483 Position
:= Pic
.Radix_Position
- 1;
486 for J
in reverse Attrs
.Start_Of_Int
.. Attrs
.End_Of_Int
loop
488 while Answer
(Position
) /= '9'
490 Answer
(Position
) /= Pic
.Floater
492 if Answer
(Position
) = '_' then
493 Answer
(Position
) := Separator_Character
;
495 elsif Answer
(Position
) = 'b' then
496 Answer
(Position
) := ' ';
499 Position
:= Position
- 1;
502 Answer
(Position
) := To_Wide
(Rounded
(J
));
504 if Rounded
(J
) /= '0' then
508 Position
:= Position
- 1;
513 if Pic
.Start_Float
= Invalid_Position
then
515 -- No leading floats, but need to change '9' to '0', '_' to
516 -- Separator_Character and 'b' to ' '.
518 for J
in Last
.. Position
loop
520 -- Last set when fixing the "uninteresting" leaders above.
521 -- Don't duplicate the work.
523 if Answer
(J
) = '9' then
526 elsif Answer
(J
) = '_' then
527 Answer
(J
) := Separator_Character
;
529 elsif Answer
(J
) = 'b' then
536 elsif Pic
.Floater
= '<'
542 for J
in Pic
.End_Float
.. Position
loop -- May be null range
543 if Answer
(J
) = '9' then
546 elsif Answer
(J
) = '_' then
547 Answer
(J
) := Separator_Character
;
549 elsif Answer
(J
) = 'b' then
555 if Position
> Pic
.End_Float
then
556 Position
:= Pic
.End_Float
;
559 for J
in Pic
.Start_Float
.. Position
- 1 loop
563 Answer
(Position
) := Pic
.Floater
;
564 Sign_Position
:= Position
;
566 elsif Pic
.Floater
= '$' then
568 for J
in Pic
.End_Float
.. Position
loop -- May be null range
569 if Answer
(J
) = '9' then
572 elsif Answer
(J
) = '_' then
573 Answer
(J
) := ' '; -- no separator before leftmost digit
575 elsif Answer
(J
) = 'b' then
580 if Position
> Pic
.End_Float
then
581 Position
:= Pic
.End_Float
;
584 for J
in Pic
.Start_Float
.. Position
- 1 loop
588 Answer
(Position
) := Pic
.Floater
;
589 Currency_Pos
:= Position
;
591 elsif Pic
.Floater
= '*' then
593 for J
in Pic
.End_Float
.. Position
loop -- May be null range
594 if Answer
(J
) = '9' then
597 elsif Answer
(J
) = '_' then
598 Answer
(J
) := Separator_Character
;
600 elsif Answer
(J
) = 'b' then
605 if Position
> Pic
.End_Float
then
606 Position
:= Pic
.End_Float
;
609 for J
in Pic
.Start_Float
.. Position
loop
614 if Pic
.Floater
= '#' then
615 Currency_Pos
:= Currency_Symbol
'Length;
618 for J
in reverse Pic
.Start_Float
.. Position
loop
622 Answer
(J
) := Fill_Character
;
624 when 'Z' |
'b' |
'/' |
'0' =>
630 when '.' |
'V' |
'v' |
'<' |
'$' |
'+' |
'-' =>
634 if Currency_Pos
= 0 then
637 Answer
(J
) := Currency_Symbol
(Currency_Pos
);
638 Currency_Pos
:= Currency_Pos
- 1;
646 Answer
(J
) := Fill_Character
;
652 if Currency_Pos
= 0 then
656 Answer
(J
) := Currency_Symbol
(Currency_Pos
);
657 Currency_Pos
:= Currency_Pos
- 1;
671 if Pic
.Floater
= '#' and then Currency_Pos
/= 0 then
678 if Sign_Position
= Invalid_Position
then
679 if Attrs
.Negative
then
684 if Attrs
.Negative
then
685 case Answer
(Sign_Position
) is
686 when 'C' |
'D' |
'-' =>
690 Answer
(Sign_Position
) := '-';
693 Answer
(Sign_Position
) := '(';
694 Answer
(Pic
.Second_Sign
) := ')';
703 case Answer
(Sign_Position
) is
706 Answer
(Sign_Position
) := ' ';
708 when '<' |
'C' |
'D' =>
709 Answer
(Sign_Position
) := ' ';
710 Answer
(Pic
.Second_Sign
) := ' ';
722 -- Fill in trailing digits
724 if Pic
.Max_Trailing_Digits
> 0 then
726 if Attrs
.Has_Fraction
then
727 Position
:= Attrs
.Start_Of_Fraction
;
728 Last
:= Pic
.Radix_Position
+ 1;
730 for J
in Last
.. Answer
'Last loop
732 if Answer
(J
) = '9' or else Answer
(J
) = Pic
.Floater
then
733 Answer
(J
) := To_Wide
(Rounded
(Position
));
735 if Rounded
(Position
) /= '0' then
739 Position
:= Position
+ 1;
742 -- Used up fraction but remember place in Answer
744 exit when Position
> Attrs
.End_Of_Fraction
;
746 elsif Answer
(J
) = 'b' then
749 elsif Answer
(J
) = '_' then
750 Answer
(J
) := Separator_Character
;
760 Position
:= Pic
.Radix_Position
+ 1;
763 -- Now fill remaining 9's with zeros and _ with separators
767 for J
in Position
.. Last
loop
768 if Answer
(J
) = '9' then
771 elsif Answer
(J
) = Pic
.Floater
then
774 elsif Answer
(J
) = '_' then
775 Answer
(J
) := Separator_Character
;
777 elsif Answer
(J
) = 'b' then
783 Position
:= Last
+ 1;
786 if Pic
.Floater
= '#' and then Currency_Pos
/= 0 then
790 -- No trailing digits, but now J may need to stick in a currency
793 if Pic
.Start_Currency
= Invalid_Position
then
794 Position
:= Answer
'Last + 1;
796 Position
:= Pic
.Start_Currency
;
800 for J
in Position
.. Answer
'Last loop
802 if Pic
.Start_Currency
/= Invalid_Position
and then
803 Answer
(Pic
.Start_Currency
) = '#' then
807 -- Note: There are some weird cases J can imagine with 'b' or '#'
808 -- in currency strings where the following code will cause
809 -- glitches. The trick is to tell when the character in the
810 -- answer should be checked, and when to look at the original
811 -- string. Some other time. RIE 11/26/96 ???
815 Answer
(J
) := Fill_Character
;
821 if Currency_Pos
> Currency_Symbol
'Length then
825 Answer
(J
) := Currency_Symbol
(Currency_Pos
);
826 Currency_Pos
:= Currency_Pos
+ 1;
834 Answer
(J
) := Fill_Character
;
840 if Currency_Pos
> Currency_Symbol
'Length then
843 Answer
(J
) := Currency_Symbol
(Currency_Pos
);
844 Currency_Pos
:= Currency_Pos
+ 1;
858 -- Now get rid of Blank_when_Zero and complete Star fill
860 if Zero
and then Pic
.Blank_When_Zero
then
862 -- Value is zero, and blank it
867 Last
:= Last
- 1 + Currency_Symbol
'Length;
870 if Pic
.Radix_Position
/= Invalid_Position
and then
871 Answer
(Pic
.Radix_Position
) = 'V' then
875 return Wide_String'(1 .. Last => ' ');
877 elsif Zero and then Pic.Star_Fill then
881 Last := Last - 1 + Currency_Symbol'Length;
884 if Pic.Radix_Position /= Invalid_Position then
886 if Answer (Pic.Radix_Position) = 'V
' then
890 if Pic.Radix_Position > Pic.Start_Currency then
891 return Wide_String'(1 .. Pic
.Radix_Position
- 1 => '*') &
893 Wide_String'(Pic.Radix_Position + 1 .. Last => '*');
899 Pic
.Radix_Position
+ Currency_Symbol
'Length - 2
903 (Pic.Radix_Position + Currency_Symbol'Length .. Last
909 Wide_String'(1 .. Pic
.Radix_Position
- 1 => '*') &
911 Wide_String'(Pic.Radix_Position + 1 .. Last => '*');
915 return Wide_String'(1 .. Last
=> '*');
918 -- This was once a simple return statement, now there are nine
919 -- different return cases. Not to mention the five above to deal
920 -- with zeros. Why not split things out?
922 -- Processing the radix and sign expansion separately
923 -- would require lots of copying--the string and some of its
924 -- indicies--without really simplifying the logic. The cases are:
926 -- 1) Expand $, replace '.' with Radix_Point
927 -- 2) No currency expansion, replace '.' with Radix_Point
928 -- 3) Expand $, radix blanked
929 -- 4) No currency expansion, radix blanked
931 -- 6) Expand $, Elide V
932 -- 7) Elide V, Expand $ (Two cases depending on order.)
933 -- 8) No radix, expand $
934 -- 9) No radix, no currency expansion
936 if Pic
.Radix_Position
/= Invalid_Position
then
938 if Answer
(Pic
.Radix_Position
) = '.' then
939 Answer
(Pic
.Radix_Position
) := Radix_Point
;
943 -- 1) Expand $, replace '.' with Radix_Point
945 return Answer
(1 .. Currency_Pos
- 1) & Currency_Symbol
&
946 Answer
(Currency_Pos
+ 1 .. Answer
'Last);
949 -- 2) No currency expansion, replace '.' with Radix_Point
954 elsif Answer
(Pic
.Radix_Position
) = ' ' then -- blanked radix.
957 -- 3) Expand $, radix blanked
959 return Answer
(1 .. Currency_Pos
- 1) & Currency_Symbol
&
960 Answer
(Currency_Pos
+ 1 .. Answer
'Last);
963 -- 4) No expansion, radix blanked
975 return Answer
(1 .. Pic
.Radix_Position
- 1) &
976 Answer
(Pic
.Radix_Position
+ 1 .. Answer
'Last);
978 elsif Currency_Pos
< Pic
.Radix_Position
then
980 -- 6) Expand $, Elide V
982 return Answer
(1 .. Currency_Pos
- 1) & Currency_Symbol
&
983 Answer
(Currency_Pos
+ 1 .. Pic
.Radix_Position
- 1) &
984 Answer
(Pic
.Radix_Position
+ 1 .. Answer
'Last);
987 -- 7) Elide V, Expand $
989 return Answer
(1 .. Pic
.Radix_Position
- 1) &
990 Answer
(Pic
.Radix_Position
+ 1 .. Currency_Pos
- 1) &
992 Answer
(Currency_Pos
+ 1 .. Answer
'Last);
998 -- 8) No radix, expand $
1000 return Answer
(1 .. Currency_Pos
- 1) & Currency_Symbol
&
1001 Answer
(Currency_Pos
+ 1 .. Answer
'Last);
1004 -- 9) No radix, no currency expansion
1010 -------------------------
1011 -- Parse_Number_String --
1012 -------------------------
1014 function Parse_Number_String
(Str
: String) return Number_Attributes
is
1015 Answer
: Number_Attributes
;
1018 for J
in Str
'Range loop
1026 -- Decide if this is the start of a number.
1027 -- If so, figure out which one...
1029 if Answer
.Has_Fraction
then
1030 Answer
.End_Of_Fraction
:= J
;
1032 if Answer
.Start_Of_Int
= Invalid_Position
then
1034 Answer
.Start_Of_Int
:= J
;
1036 Answer
.End_Of_Int
:= J
;
1041 -- Only count a zero before the decimal point if it follows a
1042 -- non-zero digit. After the decimal point, zeros will be
1043 -- counted if followed by a non-zero digit.
1045 if not Answer
.Has_Fraction
then
1046 if Answer
.Start_Of_Int
/= Invalid_Position
then
1047 Answer
.End_Of_Int
:= J
;
1055 Answer
.Negative
:= True;
1059 -- Close integer, start fraction
1061 if Answer
.Has_Fraction
then
1062 raise Picture_Error
;
1065 -- Two decimal points is a no-no
1067 Answer
.Has_Fraction
:= True;
1068 Answer
.End_Of_Fraction
:= J
;
1070 -- Could leave this at Invalid_Position, but this seems the
1071 -- right way to indicate a null range...
1073 Answer
.Start_Of_Fraction
:= J
+ 1;
1074 Answer
.End_Of_Int
:= J
- 1;
1077 raise Picture_Error
; -- can this happen? probably not!
1081 if Answer
.Start_Of_Int
= Invalid_Position
then
1082 Answer
.Start_Of_Int
:= Answer
.End_Of_Int
+ 1;
1085 -- No significant (intger) digits needs a null range
1088 end Parse_Number_String
;
1094 -- The following ensures that we return B and not b being careful not
1095 -- to break things which expect lower case b for blank. See CXF3A02.
1097 function Pic_String
(Pic
: Picture
) return String is
1098 Temp
: String (1 .. Pic
.Contents
.Picture
.Length
) :=
1099 Pic
.Contents
.Picture
.Expanded
;
1101 for J
in Temp
'Range loop
1102 if Temp
(J
) = 'b' then
1114 procedure Precalculate
(Pic
: in out Format_Record
) is
1116 Computed_BWZ
: Boolean := True;
1118 type Legality
is (Okay
, Reject
);
1119 State
: Legality
:= Reject
;
1120 -- Start in reject, which will reject null strings
1122 Index
: Pic_Index
:= Pic
.Picture
.Expanded
'First;
1124 function At_End
return Boolean;
1125 pragma Inline
(At_End
);
1127 procedure Set_State
(L
: Legality
);
1128 pragma Inline
(Set_State
);
1130 function Look
return Character;
1131 pragma Inline
(Look
);
1133 function Is_Insert
return Boolean;
1134 pragma Inline
(Is_Insert
);
1137 pragma Inline
(Skip
);
1139 procedure Trailing_Currency
;
1140 procedure Trailing_Bracket
;
1141 procedure Number_Fraction
;
1142 procedure Number_Completion
;
1143 procedure Number_Fraction_Or_Bracket
;
1144 procedure Number_Fraction_Or_Z_Fill
;
1145 procedure Zero_Suppression
;
1146 procedure Floating_Bracket
;
1147 procedure Number_Fraction_Or_Star_Fill
;
1148 procedure Star_Suppression
;
1149 procedure Number_Fraction_Or_Dollar
;
1150 procedure Leading_Dollar
;
1151 procedure Number_Fraction_Or_Pound
;
1152 procedure Leading_Pound
;
1154 procedure Floating_Plus
;
1155 procedure Floating_Minus
;
1156 procedure Picture_Plus
;
1157 procedure Picture_Minus
;
1158 procedure Picture_Bracket
;
1160 procedure Optional_RHS_Sign
;
1161 procedure Picture_String
;
1167 function At_End
return Boolean is
1169 return Index
> Pic
.Picture
.Length
;
1172 ----------------------
1173 -- Floating_Bracket --
1174 ----------------------
1176 -- Note that Floating_Bracket is only called with an acceptable
1177 -- prefix. But we don't set Okay, because we must end with a '>'.
1179 procedure Floating_Bracket
is
1182 Pic
.End_Float
:= Index
;
1183 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1185 -- First bracket wasn't counted...
1196 when '_' |
'0' |
'/' =>
1197 Pic
.End_Float
:= Index
;
1201 Pic
.End_Float
:= Index
;
1202 Pic
.Picture
.Expanded
(Index
) := 'b';
1206 Pic
.End_Float
:= Index
;
1207 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1219 when 'V' |
'v' |
'.' =>
1220 Pic
.Radix_Position
:= Index
;
1222 Number_Fraction_Or_Bracket
;
1229 end Floating_Bracket
;
1231 --------------------
1232 -- Floating_Minus --
1233 --------------------
1235 procedure Floating_Minus
is
1243 when '_' |
'0' |
'/' =>
1244 Pic
.End_Float
:= Index
;
1248 Pic
.End_Float
:= Index
;
1249 Pic
.Picture
.Expanded
(Index
) := 'b';
1253 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1254 Pic
.End_Float
:= Index
;
1261 when '.' |
'V' |
'v' =>
1262 Pic
.Radix_Position
:= Index
;
1265 while Is_Insert
loop
1282 Pic
.Max_Trailing_Digits
:=
1283 Pic
.Max_Trailing_Digits
+ 1;
1284 Pic
.End_Float
:= Index
;
1287 when '_' |
'0' |
'/' =>
1291 Pic
.Picture
.Expanded
(Index
) := 'b';
1316 procedure Floating_Plus
is
1324 when '_' |
'0' |
'/' =>
1325 Pic
.End_Float
:= Index
;
1329 Pic
.End_Float
:= Index
;
1330 Pic
.Picture
.Expanded
(Index
) := 'b';
1334 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1335 Pic
.End_Float
:= Index
;
1342 when '.' |
'V' |
'v' =>
1343 Pic
.Radix_Position
:= Index
;
1346 while Is_Insert
loop
1363 Pic
.Max_Trailing_Digits
:=
1364 Pic
.Max_Trailing_Digits
+ 1;
1365 Pic
.End_Float
:= Index
;
1368 when '_' |
'0' |
'/' =>
1372 Pic
.Picture
.Expanded
(Index
) := 'b';
1398 function Is_Insert
return Boolean is
1404 case Pic
.Picture
.Expanded
(Index
) is
1406 when '_' |
'0' |
'/' => return True;
1409 Pic
.Picture
.Expanded
(Index
) := 'b'; -- canonical
1412 when others => return False;
1416 --------------------
1417 -- Leading_Dollar --
1418 --------------------
1420 -- Note that Leading_Dollar can be called in either State.
1421 -- It will set state to Okay only if a 9 or (second) $
1424 -- Also notice the tricky bit with State and Zero_Suppression.
1425 -- Zero_Suppression is Picture_Error if a '$' or a '9' has been
1426 -- encountered, exactly the cases where State has been set.
1428 procedure Leading_Dollar
is
1430 -- Treat as a floating dollar, and unwind otherwise
1433 Pic
.Start_Currency
:= Index
;
1434 Pic
.End_Currency
:= Index
;
1435 Pic
.Start_Float
:= Index
;
1436 Pic
.End_Float
:= Index
;
1438 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1450 when '_' |
'0' |
'/' =>
1451 Pic
.End_Float
:= Index
;
1454 -- A trailing insertion character is not part of the
1455 -- floating currency, so need to look ahead.
1458 Pic
.End_Float
:= Pic
.End_Float
- 1;
1462 Pic
.End_Float
:= Index
;
1463 Pic
.Picture
.Expanded
(Index
) := 'b';
1467 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
1469 if State
= Okay
then
1470 raise Picture_Error
;
1472 -- Will overwrite Floater and Start_Float
1478 if State
= Okay
then
1479 raise Picture_Error
;
1481 -- Will overwrite Floater and Start_Float
1487 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1488 Pic
.End_Float
:= Index
;
1489 Pic
.End_Currency
:= Index
;
1490 Set_State
(Okay
); Skip
;
1493 if State
/= Okay
then
1495 Pic
.Start_Float
:= Invalid_Position
;
1496 Pic
.End_Float
:= Invalid_Position
;
1499 -- A single dollar does not a floating make
1504 when 'V' |
'v' |
'.' =>
1505 if State
/= Okay
then
1507 Pic
.Start_Float
:= Invalid_Position
;
1508 Pic
.End_Float
:= Invalid_Position
;
1511 -- Only one dollar before the sign is okay, but doesn't
1514 Pic
.Radix_Position
:= Index
;
1516 Number_Fraction_Or_Dollar
;
1530 -- This one is complex! A Leading_Pound can be fixed or floating,
1531 -- but in some cases the decision has to be deferred until we leave
1532 -- this procedure. Also note that Leading_Pound can be called in
1535 -- It will set state to Okay only if a 9 or (second) # is
1538 -- One Last note: In ambiguous cases, the currency is treated as
1539 -- floating unless there is only one '#'.
1541 procedure Leading_Pound
is
1543 Inserts
: Boolean := False;
1544 -- Set to True if a '_', '0', '/', 'B', or 'b' is encountered
1546 Must_Float
: Boolean := False;
1547 -- Set to true if a '#' occurs after an insert
1550 -- Treat as a floating currency. If it isn't, this will be
1551 -- overwritten later.
1555 Pic
.Start_Currency
:= Index
;
1556 Pic
.End_Currency
:= Index
;
1557 Pic
.Start_Float
:= Index
;
1558 Pic
.End_Float
:= Index
;
1560 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1563 Pic
.Max_Currency_Digits
:= 1; -- we've seen one.
1574 when '_' |
'0' |
'/' =>
1575 Pic
.End_Float
:= Index
;
1580 Pic
.Picture
.Expanded
(Index
) := 'b';
1581 Pic
.End_Float
:= Index
;
1586 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
1589 raise Picture_Error
;
1591 Pic
.Max_Leading_Digits
:= 0;
1593 -- Will overwrite Floater and Start_Float
1600 raise Picture_Error
;
1602 Pic
.Max_Leading_Digits
:= 0;
1604 -- Will overwrite Floater and Start_Float
1614 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1615 Pic
.End_Float
:= Index
;
1616 Pic
.End_Currency
:= Index
;
1621 if State
/= Okay
then
1623 -- A single '#' doesn't float
1626 Pic
.Start_Float
:= Invalid_Position
;
1627 Pic
.End_Float
:= Invalid_Position
;
1633 when 'V' |
'v' |
'.' =>
1634 if State
/= Okay
then
1636 Pic
.Start_Float
:= Invalid_Position
;
1637 Pic
.End_Float
:= Invalid_Position
;
1640 -- Only one pound before the sign is okay, but doesn't
1643 Pic
.Radix_Position
:= Index
;
1645 Number_Fraction_Or_Pound
;
1658 function Look
return Character is
1661 raise Picture_Error
;
1664 return Pic
.Picture
.Expanded
(Index
);
1676 when '_' |
'0' |
'/' =>
1680 Pic
.Picture
.Expanded
(Index
) := 'b';
1684 Computed_BWZ
:= False;
1685 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1689 when '.' |
'V' |
'v' =>
1690 Pic
.Radix_Position
:= Index
;
1704 -- Will return in Okay state if a '9' was seen
1709 -----------------------
1710 -- Number_Completion --
1711 -----------------------
1713 procedure Number_Completion
is
1715 while not At_End
loop
1718 when '_' |
'0' |
'/' =>
1722 Pic
.Picture
.Expanded
(Index
) := 'b';
1726 Computed_BWZ
:= False;
1727 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1731 when 'V' |
'v' |
'.' =>
1732 Pic
.Radix_Position
:= Index
;
1741 end Number_Completion
;
1743 ---------------------
1744 -- Number_Fraction --
1745 ---------------------
1747 procedure Number_Fraction
is
1749 -- Note that number fraction can be called in either State.
1750 -- It will set state to Valid only if a 9 is encountered.
1758 when '_' |
'0' |
'/' =>
1762 Pic
.Picture
.Expanded
(Index
) := 'b';
1766 Computed_BWZ
:= False;
1767 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1768 Set_State
(Okay
); Skip
;
1774 end Number_Fraction
;
1776 --------------------------------
1777 -- Number_Fraction_Or_Bracket --
1778 --------------------------------
1780 procedure Number_Fraction_Or_Bracket
is
1789 when '_' |
'0' |
'/' => Skip
;
1792 Pic
.Picture
.Expanded
(Index
) := 'b';
1796 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1797 Pic
.End_Float
:= Index
;
1806 when '_' |
'0' |
'/' =>
1810 Pic
.Picture
.Expanded
(Index
) := 'b';
1814 Pic
.Max_Trailing_Digits
:=
1815 Pic
.Max_Trailing_Digits
+ 1;
1816 Pic
.End_Float
:= Index
;
1829 end Number_Fraction_Or_Bracket
;
1831 -------------------------------
1832 -- Number_Fraction_Or_Dollar --
1833 -------------------------------
1835 procedure Number_Fraction_Or_Dollar
is
1843 when '_' |
'0' |
'/' =>
1847 Pic
.Picture
.Expanded
(Index
) := 'b';
1851 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1852 Pic
.End_Float
:= Index
;
1861 when '_' |
'0' |
'/' =>
1865 Pic
.Picture
.Expanded
(Index
) := 'b';
1869 Pic
.Max_Trailing_Digits
:=
1870 Pic
.Max_Trailing_Digits
+ 1;
1871 Pic
.End_Float
:= Index
;
1884 end Number_Fraction_Or_Dollar
;
1886 ------------------------------
1887 -- Number_Fraction_Or_Pound --
1888 ------------------------------
1890 procedure Number_Fraction_Or_Pound
is
1899 when '_' |
'0' |
'/' =>
1903 Pic
.Picture
.Expanded
(Index
) := 'b';
1907 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1908 Pic
.End_Float
:= Index
;
1918 when '_' |
'0' |
'/' =>
1922 Pic
.Picture
.Expanded
(Index
) := 'b';
1926 Pic
.Max_Trailing_Digits
:=
1927 Pic
.Max_Trailing_Digits
+ 1;
1928 Pic
.End_Float
:= Index
;
1943 end Number_Fraction_Or_Pound
;
1945 ----------------------------------
1946 -- Number_Fraction_Or_Star_Fill --
1947 ----------------------------------
1949 procedure Number_Fraction_Or_Star_Fill
is
1958 when '_' |
'0' |
'/' =>
1962 Pic
.Picture
.Expanded
(Index
) := 'b';
1966 Pic
.Star_Fill
:= True;
1967 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1968 Pic
.End_Float
:= Index
;
1978 when '_' |
'0' |
'/' =>
1982 Pic
.Picture
.Expanded
(Index
) := 'b';
1986 Pic
.Star_Fill
:= True;
1987 Pic
.Max_Trailing_Digits
:=
1988 Pic
.Max_Trailing_Digits
+ 1;
1989 Pic
.End_Float
:= Index
;
2003 end Number_Fraction_Or_Star_Fill
;
2005 -------------------------------
2006 -- Number_Fraction_Or_Z_Fill --
2007 -------------------------------
2009 procedure Number_Fraction_Or_Z_Fill
is
2018 when '_' |
'0' |
'/' =>
2022 Pic
.Picture
.Expanded
(Index
) := 'b';
2026 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
2027 Pic
.End_Float
:= Index
;
2028 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2039 when '_' |
'0' |
'/' =>
2043 Pic
.Picture
.Expanded
(Index
) := 'b';
2047 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2049 Pic
.Max_Trailing_Digits
:=
2050 Pic
.Max_Trailing_Digits
+ 1;
2051 Pic
.End_Float
:= Index
;
2064 end Number_Fraction_Or_Z_Fill
;
2066 -----------------------
2067 -- Optional_RHS_Sign --
2068 -----------------------
2070 procedure Optional_RHS_Sign
is
2079 Pic
.Sign_Position
:= Index
;
2084 Pic
.Sign_Position
:= Index
;
2085 Pic
.Picture
.Expanded
(Index
) := 'C';
2088 if Look
= 'R' or else Look
= 'r' then
2089 Pic
.Second_Sign
:= Index
;
2090 Pic
.Picture
.Expanded
(Index
) := 'R';
2094 raise Picture_Error
;
2100 Pic
.Sign_Position
:= Index
;
2101 Pic
.Picture
.Expanded
(Index
) := 'D';
2104 if Look
= 'B' or else Look
= 'b' then
2105 Pic
.Second_Sign
:= Index
;
2106 Pic
.Picture
.Expanded
(Index
) := 'B';
2110 raise Picture_Error
;
2116 if Pic
.Picture
.Expanded
(Pic
.Sign_Position
) = '<' then
2117 Pic
.Second_Sign
:= Index
;
2121 raise Picture_Error
;
2128 end Optional_RHS_Sign
;
2134 -- Note that Picture can be called in either State
2136 -- It will set state to Valid only if a 9 is encountered or floating
2137 -- currency is called.
2139 procedure Picture
is
2148 when '_' |
'0' |
'/' =>
2152 Pic
.Picture
.Expanded
(Index
) := 'b';
2164 Computed_BWZ
:= False;
2166 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2169 when 'V' |
'v' |
'.' =>
2170 Pic
.Radix_Position
:= Index
;
2183 ---------------------
2184 -- Picture_Bracket --
2185 ---------------------
2187 procedure Picture_Bracket
is
2189 Pic
.Sign_Position
:= Index
;
2190 Pic
.Sign_Position
:= Index
;
2192 -- Treat as a floating sign, and unwind otherwise
2195 Pic
.Start_Float
:= Index
;
2196 Pic
.End_Float
:= Index
;
2198 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2201 Skip
; -- Known Bracket
2206 when '_' |
'0' |
'/' =>
2207 Pic
.End_Float
:= Index
;
2211 Pic
.End_Float
:= Index
;
2212 Pic
.Picture
.Expanded
(Index
) := 'b';
2216 Set_State
(Okay
); -- "<<>" is enough.
2222 when '$' |
'#' |
'9' |
'*' =>
2223 if State
/= Okay
then
2225 Pic
.Start_Float
:= Invalid_Position
;
2226 Pic
.End_Float
:= Invalid_Position
;
2234 when '.' |
'V' |
'v' =>
2235 if State
/= Okay
then
2237 Pic
.Start_Float
:= Invalid_Position
;
2238 Pic
.End_Float
:= Invalid_Position
;
2241 -- Don't assume that state is okay, haven't seen a digit
2248 raise Picture_Error
;
2252 end Picture_Bracket
;
2258 procedure Picture_Minus
is
2260 Pic
.Sign_Position
:= Index
;
2262 -- Treat as a floating sign, and unwind otherwise
2265 Pic
.Start_Float
:= Index
;
2266 Pic
.End_Float
:= Index
;
2268 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2271 Skip
; -- Known Minus
2276 when '_' |
'0' |
'/' =>
2277 Pic
.End_Float
:= Index
;
2281 Pic
.End_Float
:= Index
;
2282 Pic
.Picture
.Expanded
(Index
) := 'b';
2286 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2287 Pic
.End_Float
:= Index
;
2289 Set_State
(Okay
); -- "-- " is enough
2294 when '$' |
'#' |
'9' |
'*' =>
2295 if State
/= Okay
then
2297 Pic
.Start_Float
:= Invalid_Position
;
2298 Pic
.End_Float
:= Invalid_Position
;
2307 -- Can't have Z and a floating sign
2309 if State
= Okay
then
2313 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2319 when '.' |
'V' |
'v' =>
2320 if State
/= Okay
then
2322 Pic
.Start_Float
:= Invalid_Position
;
2323 Pic
.End_Float
:= Invalid_Position
;
2326 -- Don't assume that state is okay, haven't seen a digit
2342 procedure Picture_Plus
is
2344 Pic
.Sign_Position
:= Index
;
2346 -- Treat as a floating sign, and unwind otherwise
2349 Pic
.Start_Float
:= Index
;
2350 Pic
.End_Float
:= Index
;
2352 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2360 when '_' |
'0' |
'/' =>
2361 Pic
.End_Float
:= Index
;
2365 Pic
.End_Float
:= Index
;
2366 Pic
.Picture
.Expanded
(Index
) := 'b';
2370 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2371 Pic
.End_Float
:= Index
;
2373 Set_State
(Okay
); -- "++" is enough
2378 when '$' |
'#' |
'9' |
'*' =>
2379 if State
/= Okay
then
2381 Pic
.Start_Float
:= Invalid_Position
;
2382 Pic
.End_Float
:= Invalid_Position
;
2390 if State
= Okay
then
2394 -- Can't have Z and a floating sign
2396 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2398 -- '+Z' is acceptable
2407 when '.' |
'V' |
'v' =>
2408 if State
/= Okay
then
2410 Pic
.Start_Float
:= Invalid_Position
;
2411 Pic
.End_Float
:= Invalid_Position
;
2414 -- Don't assume that state is okay, haven't seen a digit
2426 --------------------
2427 -- Picture_String --
2428 --------------------
2430 procedure Picture_String
is
2432 while Is_Insert
loop
2452 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2462 when '9' |
'.' |
'V' |
'v' =>
2468 raise Picture_Error
;
2472 -- Blank when zero either if the PIC does not contain a '9' or if
2473 -- requested by the user and no '*'.
2475 Pic
.Blank_When_Zero
:=
2476 (Computed_BWZ
or else Pic
.Blank_When_Zero
)
2477 and then not Pic
.Star_Fill
;
2479 -- Star fill if '*' and no '9'
2481 Pic
.Star_Fill
:= Pic
.Star_Fill
and then Computed_BWZ
;
2493 procedure Set_State
(L
: Legality
) is
2507 ----------------------
2508 -- Star_Suppression --
2509 ----------------------
2511 procedure Star_Suppression
is
2514 Pic
.Start_Float
:= Index
;
2515 Pic
.End_Float
:= Index
;
2516 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2519 -- Even a single * is a valid picture
2521 Pic
.Star_Fill
:= True;
2531 when '_' |
'0' |
'/' =>
2532 Pic
.End_Float
:= Index
;
2536 Pic
.End_Float
:= Index
;
2537 Pic
.Picture
.Expanded
(Index
) := 'b';
2541 Pic
.End_Float
:= Index
;
2542 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2543 Set_State
(Okay
); Skip
;
2550 when '.' |
'V' |
'v' =>
2551 Pic
.Radix_Position
:= Index
;
2553 Number_Fraction_Or_Star_Fill
;
2561 when others => raise Picture_Error
;
2564 end Star_Suppression
;
2566 ----------------------
2567 -- Trailing_Bracket --
2568 ----------------------
2570 procedure Trailing_Bracket
is
2573 Pic
.Second_Sign
:= Index
;
2576 raise Picture_Error
;
2578 end Trailing_Bracket
;
2580 -----------------------
2581 -- Trailing_Currency --
2582 -----------------------
2584 procedure Trailing_Currency
is
2591 Pic
.Start_Currency
:= Index
;
2592 Pic
.End_Currency
:= Index
;
2596 while not At_End
and then Look
= '#' loop
2597 if Pic
.Start_Currency
= Invalid_Position
then
2598 Pic
.Start_Currency
:= Index
;
2601 Pic
.End_Currency
:= Index
;
2612 when '_' |
'0' |
'/' => Skip
;
2615 Pic
.Picture
.Expanded
(Index
) := 'b';
2618 when others => return;
2621 end Trailing_Currency
;
2623 ----------------------
2624 -- Zero_Suppression --
2625 ----------------------
2627 procedure Zero_Suppression
is
2630 Pic
.Start_Float
:= Index
;
2631 Pic
.End_Float
:= Index
;
2632 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2633 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2638 -- Even a single Z is a valid picture
2646 when '_' |
'0' |
'/' =>
2647 Pic
.End_Float
:= Index
;
2651 Pic
.End_Float
:= Index
;
2652 Pic
.Picture
.Expanded
(Index
) := 'b';
2656 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2658 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2659 Pic
.End_Float
:= Index
;
2668 when '.' |
'V' |
'v' =>
2669 Pic
.Radix_Position
:= Index
;
2671 Number_Fraction_Or_Z_Fill
;
2683 end Zero_Suppression
;
2685 -- Start of processing for Precalculate
2690 if State
= Reject
then
2691 raise Picture_Error
;
2696 when Constraint_Error
=>
2698 -- To deal with special cases like null strings
2700 raise Picture_Error
;
2709 (Pic_String
: String;
2710 Blank_When_Zero
: Boolean := False) return Picture
2716 Item
: constant String := Expand
(Pic_String
);
2719 Result
.Contents
.Picture
:= (Item
'Length, Item
);
2720 Result
.Contents
.Original_BWZ
:= Blank_When_Zero
;
2721 Result
.Contents
.Blank_When_Zero
:= Blank_When_Zero
;
2722 Precalculate
(Result
.Contents
);
2728 raise Picture_Error
;
2736 function To_Wide
(C
: Character) return Wide_Character is
2738 return Wide_Character'Val (Character'Pos (C
));
2746 (Pic_String
: String;
2747 Blank_When_Zero
: Boolean := False) return Boolean
2751 Expanded_Pic
: constant String := Expand
(Pic_String
);
2752 -- Raises Picture_Error if Item not well-formed
2754 Format_Rec
: Format_Record
;
2757 Format_Rec
.Picture
:= (Expanded_Pic
'Length, Expanded_Pic
);
2758 Format_Rec
.Blank_When_Zero
:= Blank_When_Zero
;
2759 Format_Rec
.Original_BWZ
:= Blank_When_Zero
;
2760 Precalculate
(Format_Rec
);
2762 -- False only if Blank_When_0 is True but the pic string has a '*'
2764 return not Blank_When_Zero
2765 or else Strings_Fixed
.Index
(Expanded_Pic
, "*") = 0;
2769 when others => return False;
2772 end Ada
.Wide_Text_IO
.Editing
;