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 --
11 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
26 -- this unit does not by itself cause the resulting executable to be --
27 -- covered by the GNU General Public License. This exception does not --
28 -- however invalidate any other reasons why the executable file might be --
29 -- covered by the GNU Public License. --
31 -- GNAT was originally developed by the GNAT team at New York University. --
32 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
34 ------------------------------------------------------------------------------
36 with Ada
.Strings
.Fixed
;
37 with Ada
.Strings
.Wide_Fixed
;
39 package body Ada
.Wide_Text_IO
.Editing
is
41 package Strings
renames Ada
.Strings
;
42 package Strings_Fixed
renames Ada
.Strings
.Fixed
;
43 package Strings_Wide_Fixed
renames Ada
.Strings
.Wide_Fixed
;
44 package Wide_Text_IO
renames Ada
.Wide_Text_IO
;
46 -----------------------
47 -- Local_Subprograms --
48 -----------------------
50 function To_Wide
(C
: Character) return Wide_Character;
51 pragma Inline
(To_Wide
);
52 -- Convert Character to corresponding Wide_Character
58 function Blank_When_Zero
(Pic
: in Picture
) return Boolean is
60 return Pic
.Contents
.Original_BWZ
;
67 package body Decimal_Output
is
76 Currency
: in Wide_String := Default_Currency
;
77 Fill
: in Wide_Character := Default_Fill
;
78 Separator
: in Wide_Character := Default_Separator
;
79 Radix_Mark
: in Wide_Character := Default_Radix_Mark
)
84 (Pic
.Contents
, Num
'Image (Item
),
85 Currency
, Fill
, Separator
, Radix_Mark
);
94 Currency
: in Wide_String := Default_Currency
)
97 Picstr
: constant String := Pic_String
(Pic
);
98 V_Adjust
: Integer := 0;
99 Cur_Adjust
: Integer := 0;
102 -- Check if Picstr has 'V' or '$'
104 -- If 'V', then length is 1 less than otherwise
106 -- If '$', then length is Currency'Length-1 more than otherwise
108 -- This should use the string handling package ???
110 for J
in Picstr
'Range loop
111 if Picstr
(J
) = 'V' then
114 elsif Picstr
(J
) = '$' then
115 Cur_Adjust
:= Currency
'Length - 1;
119 return Picstr
'Length - V_Adjust
+ Cur_Adjust
;
127 (File
: in Wide_Text_IO
.File_Type
;
130 Currency
: in Wide_String := Default_Currency
;
131 Fill
: in Wide_Character := Default_Fill
;
132 Separator
: in Wide_Character := Default_Separator
;
133 Radix_Mark
: in Wide_Character := Default_Radix_Mark
)
136 Wide_Text_IO
.Put
(File
, Image
(Item
, Pic
,
137 Currency
, Fill
, Separator
, Radix_Mark
));
143 Currency
: in Wide_String := Default_Currency
;
144 Fill
: in Wide_Character := Default_Fill
;
145 Separator
: in Wide_Character := Default_Separator
;
146 Radix_Mark
: in Wide_Character := Default_Radix_Mark
)
149 Wide_Text_IO
.Put
(Image
(Item
, Pic
,
150 Currency
, Fill
, Separator
, Radix_Mark
));
154 (To
: out Wide_String;
157 Currency
: in Wide_String := Default_Currency
;
158 Fill
: in Wide_Character := Default_Fill
;
159 Separator
: in Wide_Character := Default_Separator
;
160 Radix_Mark
: in Wide_Character := Default_Radix_Mark
)
162 Result
: constant Wide_String :=
163 Image
(Item
, Pic
, Currency
, Fill
, Separator
, Radix_Mark
);
166 if Result
'Length > To
'Length then
167 raise Wide_Text_IO
.Layout_Error
;
169 Strings_Wide_Fixed
.Move
(Source
=> Result
, Target
=> To
,
170 Justify
=> Strings
.Right
);
181 Currency
: in Wide_String := Default_Currency
)
186 Temp
: constant Wide_String := Image
(Item
, Pic
, Currency
);
187 pragma Warnings
(Off
, Temp
);
194 when Layout_Error
=> return False;
204 function Expand
(Picture
: in String) return String is
205 Result
: String (1 .. MAX_PICSIZE
);
206 Picture_Index
: Integer := Picture
'First;
207 Result_Index
: Integer := Result
'First;
212 if Picture
'Length < 1 then
216 if Picture
(Picture
'First) = '(' then
221 case Picture
(Picture_Index
) is
225 -- We now need to scan out the count after a left paren.
226 -- In the non-wide version we used Integer_IO.Get, but
227 -- that is not convenient here, since we don't want to
228 -- drag in normal Text_IO just for this purpose. So we
229 -- do the scan ourselves, with the normal validity checks.
231 Last
:= Picture_Index
+ 1;
234 if Picture
(Last
) not in '0' .. '9' then
238 Count
:= Character'Pos (Picture
(Last
)) - Character'Pos ('0');
242 if Last
> Picture
'Last then
246 if Picture
(Last
) = '_' then
247 if Picture
(Last
- 1) = '_' then
251 elsif Picture
(Last
) = ')' then
254 elsif Picture
(Last
) not in '0' .. '9' then
259 + Character'Pos (Picture
(Last
)) -
266 -- In what follows note that one copy of the repeated
267 -- character has already been made, so a count of one is a
268 -- no-op, and a count of zero erases a character.
270 for J
in 2 .. Count
loop
271 Result
(Result_Index
+ J
- 2) := Picture
(Picture_Index
- 1);
274 Result_Index
:= Result_Index
+ Count
- 1;
276 -- Last was a ')' throw it away too.
278 Picture_Index
:= Last
+ 1;
284 Result
(Result_Index
) := Picture
(Picture_Index
);
285 Picture_Index
:= Picture_Index
+ 1;
286 Result_Index
:= Result_Index
+ 1;
290 exit when Picture_Index
> Picture
'Last;
293 return Result
(1 .. Result_Index
- 1);
305 function Format_Number
306 (Pic
: Format_Record
;
308 Currency_Symbol
: Wide_String;
309 Fill_Character
: Wide_Character;
310 Separator_Character
: Wide_Character;
311 Radix_Point
: Wide_Character)
314 Attrs
: Number_Attributes
:= Parse_Number_String
(Number
);
316 Rounded
: String := Number
;
318 Sign_Position
: Integer := Pic
.Sign_Position
; -- may float.
320 Answer
: Wide_String (1 .. Pic
.Picture
.Length
);
322 Currency_Pos
: Integer := Pic
.Start_Currency
;
324 Dollar
: Boolean := False;
325 -- Overridden immediately if necessary.
327 Zero
: Boolean := True;
328 -- Set to False when a non-zero digit is output.
332 -- If the picture has fewer decimal places than the number, the image
333 -- must be rounded according to the usual rules.
335 if Attrs
.Has_Fraction
then
337 R
: constant Integer :=
338 (Attrs
.End_Of_Fraction
- Attrs
.Start_Of_Fraction
+ 1)
339 - Pic
.Max_Trailing_Digits
;
344 R_Pos
:= Rounded
'Length - R
;
346 if Rounded
(R_Pos
+ 1) > '4' then
348 if Rounded
(R_Pos
) = '.' then
352 if Rounded
(R_Pos
) /= '9' then
353 Rounded
(R_Pos
) := Character'Succ (Rounded
(R_Pos
));
355 Rounded
(R_Pos
) := '0';
359 if Rounded
(R_Pos
) = '.' then
363 if Rounded
(R_Pos
) /= '9' then
364 Rounded
(R_Pos
) := Character'Succ (Rounded
(R_Pos
));
367 Rounded
(R_Pos
) := '0';
372 -- The rounding may add a digit in front. Either the
373 -- leading blank or the sign (already captured) can
377 Rounded
(R_Pos
) := '1';
378 Attrs
.Start_Of_Int
:= Attrs
.Start_Of_Int
- 1;
386 for J
in Answer
'Range loop
387 Answer
(J
) := To_Wide
(Pic
.Picture
.Expanded
(J
));
390 if Pic
.Start_Currency
/= Invalid_Position
then
391 Dollar
:= Answer
(Pic
.Start_Currency
) = '$';
394 -- Fix up "direct inserts" outside the playing field. Set up as one
395 -- loop to do the beginning, one (reverse) loop to do the end.
399 exit when Last
= Pic
.Start_Float
;
400 exit when Last
= Pic
.Radix_Position
;
401 exit when Answer
(Last
) = '9';
403 case Answer
(Last
) is
406 Answer
(Last
) := Separator_Character
;
409 Answer
(Last
) := ' ';
416 exit when Last
= Answer
'Last;
421 -- Now for the end...
423 for J
in reverse Last
.. Answer
'Last loop
424 exit when J
= Pic
.Radix_Position
;
426 -- Do this test First, Separator_Character can equal Pic.Floater.
428 if Answer
(J
) = Pic
.Floater
then
435 Answer
(J
) := Separator_Character
;
451 if Pic
.Start_Currency
/= -1
452 and then Answer
(Pic
.Start_Currency
) = '#'
453 and then Pic
.Floater
/= '#'
455 if Currency_Symbol
'Length >
456 Pic
.End_Currency
- Pic
.Start_Currency
+ 1
460 elsif Currency_Symbol
'Length =
461 Pic
.End_Currency
- Pic
.Start_Currency
+ 1
463 Answer
(Pic
.Start_Currency
.. Pic
.End_Currency
) :=
466 elsif Pic
.Radix_Position
= Invalid_Position
467 or else Pic
.Start_Currency
< Pic
.Radix_Position
469 Answer
(Pic
.Start_Currency
.. Pic
.End_Currency
) :=
471 Answer
(Pic
.End_Currency
- Currency_Symbol
'Length + 1 ..
472 Pic
.End_Currency
) := Currency_Symbol
;
475 Answer
(Pic
.Start_Currency
.. Pic
.End_Currency
) :=
477 Answer
(Pic
.Start_Currency
..
478 Pic
.Start_Currency
+ Currency_Symbol
'Length - 1) :=
483 -- Fill in leading digits
485 if Attrs
.End_Of_Int
- Attrs
.Start_Of_Int
+ 1 >
486 Pic
.Max_Leading_Digits
491 if Pic
.Radix_Position
= Invalid_Position
then
492 Position
:= Answer
'Last;
494 Position
:= Pic
.Radix_Position
- 1;
497 for J
in reverse Attrs
.Start_Of_Int
.. Attrs
.End_Of_Int
loop
499 while Answer
(Position
) /= '9'
500 and Answer
(Position
) /= Pic
.Floater
502 if Answer
(Position
) = '_' then
503 Answer
(Position
) := Separator_Character
;
505 elsif Answer
(Position
) = 'b' then
506 Answer
(Position
) := ' ';
509 Position
:= Position
- 1;
512 Answer
(Position
) := To_Wide
(Rounded
(J
));
514 if Rounded
(J
) /= '0' then
518 Position
:= Position
- 1;
523 if Pic
.Start_Float
= Invalid_Position
then
525 -- No leading floats, but need to change '9' to '0', '_' to
526 -- Separator_Character and 'b' to ' '.
528 for J
in Last
.. Position
loop
530 -- Last set when fixing the "uninteresting" leaders above.
531 -- Don't duplicate the work.
533 if Answer
(J
) = '9' then
536 elsif Answer
(J
) = '_' then
537 Answer
(J
) := Separator_Character
;
539 elsif Answer
(J
) = 'b' then
546 elsif Pic
.Floater
= '<'
552 for J
in Pic
.End_Float
.. Position
loop -- May be null range.
553 if Answer
(J
) = '9' then
556 elsif Answer
(J
) = '_' then
557 Answer
(J
) := Separator_Character
;
559 elsif Answer
(J
) = 'b' then
565 if Position
> Pic
.End_Float
then
566 Position
:= Pic
.End_Float
;
569 for J
in Pic
.Start_Float
.. Position
- 1 loop
573 Answer
(Position
) := Pic
.Floater
;
574 Sign_Position
:= Position
;
576 elsif Pic
.Floater
= '$' then
578 for J
in Pic
.End_Float
.. Position
loop -- May be null range.
579 if Answer
(J
) = '9' then
582 elsif Answer
(J
) = '_' then
583 Answer
(J
) := ' '; -- no separator before leftmost digit.
585 elsif Answer
(J
) = 'b' then
590 if Position
> Pic
.End_Float
then
591 Position
:= Pic
.End_Float
;
594 for J
in Pic
.Start_Float
.. Position
- 1 loop
598 Answer
(Position
) := Pic
.Floater
;
599 Currency_Pos
:= Position
;
601 elsif Pic
.Floater
= '*' then
603 for J
in Pic
.End_Float
.. Position
loop -- May be null range.
604 if Answer
(J
) = '9' then
607 elsif Answer
(J
) = '_' then
608 Answer
(J
) := Separator_Character
;
610 elsif Answer
(J
) = 'b' then
615 if Position
> Pic
.End_Float
then
616 Position
:= Pic
.End_Float
;
619 for J
in Pic
.Start_Float
.. Position
loop
624 if Pic
.Floater
= '#' then
625 Currency_Pos
:= Currency_Symbol
'Length;
628 for J
in reverse Pic
.Start_Float
.. Position
loop
632 Answer
(J
) := Fill_Character
;
634 when 'Z' |
'b' |
'/' |
'0' =>
640 when '.' |
'V' |
'v' |
'<' |
'$' |
'+' |
'-' =>
644 if Currency_Pos
= 0 then
647 Answer
(J
) := Currency_Symbol
(Currency_Pos
);
648 Currency_Pos
:= Currency_Pos
- 1;
656 Answer
(J
) := Fill_Character
;
662 if Currency_Pos
= 0 then
666 Answer
(J
) := Currency_Symbol
(Currency_Pos
);
667 Currency_Pos
:= Currency_Pos
- 1;
681 if Pic
.Floater
= '#' and then Currency_Pos
/= 0 then
688 if Sign_Position
= Invalid_Position
then
689 if Attrs
.Negative
then
694 if Attrs
.Negative
then
695 case Answer
(Sign_Position
) is
696 when 'C' |
'D' |
'-' =>
700 Answer
(Sign_Position
) := '-';
703 Answer
(Sign_Position
) := '(';
704 Answer
(Pic
.Second_Sign
) := ')';
713 case Answer
(Sign_Position
) is
716 Answer
(Sign_Position
) := ' ';
718 when '<' |
'C' |
'D' =>
719 Answer
(Sign_Position
) := ' ';
720 Answer
(Pic
.Second_Sign
) := ' ';
732 -- Fill in trailing digits
734 if Pic
.Max_Trailing_Digits
> 0 then
736 if Attrs
.Has_Fraction
then
737 Position
:= Attrs
.Start_Of_Fraction
;
738 Last
:= Pic
.Radix_Position
+ 1;
740 for J
in Last
.. Answer
'Last loop
742 if Answer
(J
) = '9' or Answer
(J
) = Pic
.Floater
then
743 Answer
(J
) := To_Wide
(Rounded
(Position
));
745 if Rounded
(Position
) /= '0' then
749 Position
:= Position
+ 1;
752 -- Used up fraction but remember place in Answer
754 exit when Position
> Attrs
.End_Of_Fraction
;
756 elsif Answer
(J
) = 'b' then
759 elsif Answer
(J
) = '_' then
760 Answer
(J
) := Separator_Character
;
770 Position
:= Pic
.Radix_Position
+ 1;
773 -- Now fill remaining 9's with zeros and _ with separators
777 for J
in Position
.. Last
loop
778 if Answer
(J
) = '9' then
781 elsif Answer
(J
) = Pic
.Floater
then
784 elsif Answer
(J
) = '_' then
785 Answer
(J
) := Separator_Character
;
787 elsif Answer
(J
) = 'b' then
793 Position
:= Last
+ 1;
796 if Pic
.Floater
= '#' and then Currency_Pos
/= 0 then
800 -- No trailing digits, but now J may need to stick in a currency
803 if Pic
.Start_Currency
= Invalid_Position
then
804 Position
:= Answer
'Last + 1;
806 Position
:= Pic
.Start_Currency
;
810 for J
in Position
.. Answer
'Last loop
812 if Pic
.Start_Currency
/= Invalid_Position
and then
813 Answer
(Pic
.Start_Currency
) = '#' then
817 -- Note: There are some weird cases J can imagine with 'b' or '#'
818 -- in currency strings where the following code will cause
819 -- glitches. The trick is to tell when the character in the
820 -- answer should be checked, and when to look at the original
821 -- string. Some other time. RIE 11/26/96 ???
825 Answer
(J
) := Fill_Character
;
831 if Currency_Pos
> Currency_Symbol
'Length then
835 Answer
(J
) := Currency_Symbol
(Currency_Pos
);
836 Currency_Pos
:= Currency_Pos
+ 1;
844 Answer
(J
) := Fill_Character
;
850 if Currency_Pos
> Currency_Symbol
'Length then
853 Answer
(J
) := Currency_Symbol
(Currency_Pos
);
854 Currency_Pos
:= Currency_Pos
+ 1;
868 -- Now get rid of Blank_when_Zero and complete Star fill.
870 if Zero
and Pic
.Blank_When_Zero
then
872 -- Value is zero, and blank it.
877 Last
:= Last
- 1 + Currency_Symbol
'Length;
880 if Pic
.Radix_Position
/= Invalid_Position
and then
881 Answer
(Pic
.Radix_Position
) = 'V' then
885 return Wide_String'(1 .. Last => ' ');
887 elsif Zero and Pic.Star_Fill then
891 Last := Last - 1 + Currency_Symbol'Length;
894 if Pic.Radix_Position /= Invalid_Position then
896 if Answer (Pic.Radix_Position) = 'V
' then
900 if Pic.Radix_Position > Pic.Start_Currency then
901 return Wide_String' (1 .. Pic
.Radix_Position
- 1 => '*') &
903 Wide_String' (Pic.Radix_Position + 1 .. Last => '*');
909 Pic
.Radix_Position
+ Currency_Symbol
'Length - 2
913 (Pic.Radix_Position + Currency_Symbol'Length .. Last
919 Wide_String'(1 .. Pic
.Radix_Position
- 1 => '*') &
921 Wide_String'(Pic.Radix_Position + 1 .. Last => '*');
925 return Wide_String' (1 .. Last
=> '*');
928 -- This was once a simple return statement, now there are nine
929 -- different return cases. Not to mention the five above to deal
930 -- with zeros. Why not split things out?
932 -- Processing the radix and sign expansion separately
933 -- would require lots of copying--the string and some of its
934 -- indices--without really simplifying the logic. The cases are:
936 -- 1) Expand $, replace '.' with Radix_Point
937 -- 2) No currency expansion, replace '.' with Radix_Point
938 -- 3) Expand $, radix blanked
939 -- 4) No currency expansion, radix blanked
941 -- 6) Expand $, Elide V
942 -- 7) Elide V, Expand $ (Two cases depending on order.)
943 -- 8) No radix, expand $
944 -- 9) No radix, no currency expansion
946 if Pic
.Radix_Position
/= Invalid_Position
then
948 if Answer
(Pic
.Radix_Position
) = '.' then
949 Answer
(Pic
.Radix_Position
) := Radix_Point
;
953 -- 1) Expand $, replace '.' with Radix_Point
955 return Answer
(1 .. Currency_Pos
- 1) & Currency_Symbol
&
956 Answer
(Currency_Pos
+ 1 .. Answer
'Last);
959 -- 2) No currency expansion, replace '.' with Radix_Point
964 elsif Answer
(Pic
.Radix_Position
) = ' ' then -- blanked radix.
967 -- 3) Expand $, radix blanked
969 return Answer
(1 .. Currency_Pos
- 1) & Currency_Symbol
&
970 Answer
(Currency_Pos
+ 1 .. Answer
'Last);
973 -- 4) No expansion, radix blanked
985 return Answer
(1 .. Pic
.Radix_Position
- 1) &
986 Answer
(Pic
.Radix_Position
+ 1 .. Answer
'Last);
988 elsif Currency_Pos
< Pic
.Radix_Position
then
990 -- 6) Expand $, Elide V
992 return Answer
(1 .. Currency_Pos
- 1) & Currency_Symbol
&
993 Answer
(Currency_Pos
+ 1 .. Pic
.Radix_Position
- 1) &
994 Answer
(Pic
.Radix_Position
+ 1 .. Answer
'Last);
997 -- 7) Elide V, Expand $
999 return Answer
(1 .. Pic
.Radix_Position
- 1) &
1000 Answer
(Pic
.Radix_Position
+ 1 .. Currency_Pos
- 1) &
1002 Answer
(Currency_Pos
+ 1 .. Answer
'Last);
1008 -- 8) No radix, expand $
1010 return Answer
(1 .. Currency_Pos
- 1) & Currency_Symbol
&
1011 Answer
(Currency_Pos
+ 1 .. Answer
'Last);
1014 -- 9) No radix, no currency expansion
1021 -------------------------
1022 -- Parse_Number_String --
1023 -------------------------
1025 function Parse_Number_String
(Str
: String) return Number_Attributes
is
1026 Answer
: Number_Attributes
;
1029 for J
in Str
'Range loop
1037 -- Decide if this is the start of a number.
1038 -- If so, figure out which one...
1040 if Answer
.Has_Fraction
then
1041 Answer
.End_Of_Fraction
:= J
;
1043 if Answer
.Start_Of_Int
= Invalid_Position
then
1045 Answer
.Start_Of_Int
:= J
;
1047 Answer
.End_Of_Int
:= J
;
1052 -- Only count a zero before the decimal point if it follows a
1053 -- non-zero digit. After the decimal point, zeros will be
1054 -- counted if followed by a non-zero digit.
1056 if not Answer
.Has_Fraction
then
1057 if Answer
.Start_Of_Int
/= Invalid_Position
then
1058 Answer
.End_Of_Int
:= J
;
1066 Answer
.Negative
:= True;
1070 -- Close integer, start fraction
1072 if Answer
.Has_Fraction
then
1073 raise Picture_Error
;
1076 -- Two decimal points is a no-no.
1078 Answer
.Has_Fraction
:= True;
1079 Answer
.End_Of_Fraction
:= J
;
1081 -- Could leave this at Invalid_Position, but this seems the
1082 -- right way to indicate a null range...
1084 Answer
.Start_Of_Fraction
:= J
+ 1;
1085 Answer
.End_Of_Int
:= J
- 1;
1088 raise Picture_Error
; -- can this happen? probably not!
1092 if Answer
.Start_Of_Int
= Invalid_Position
then
1093 Answer
.Start_Of_Int
:= Answer
.End_Of_Int
+ 1;
1096 -- No significant (intger) digits needs a null range.
1100 end Parse_Number_String
;
1106 -- The following ensures that we return B and not b being careful not
1107 -- to break things which expect lower case b for blank. See CXF3A02.
1109 function Pic_String
(Pic
: in Picture
) return String is
1110 Temp
: String (1 .. Pic
.Contents
.Picture
.Length
) :=
1111 Pic
.Contents
.Picture
.Expanded
;
1113 for J
in Temp
'Range loop
1114 if Temp
(J
) = 'b' then Temp
(J
) := 'B'; end if;
1124 procedure Precalculate
(Pic
: in out Format_Record
) is
1126 Computed_BWZ
: Boolean := True;
1128 type Legality
is (Okay
, Reject
);
1129 State
: Legality
:= Reject
;
1130 -- Start in reject, which will reject null strings.
1132 Index
: Pic_Index
:= Pic
.Picture
.Expanded
'First;
1134 function At_End
return Boolean;
1135 pragma Inline
(At_End
);
1137 procedure Set_State
(L
: Legality
);
1138 pragma Inline
(Set_State
);
1140 function Look
return Character;
1141 pragma Inline
(Look
);
1143 function Is_Insert
return Boolean;
1144 pragma Inline
(Is_Insert
);
1147 pragma Inline
(Skip
);
1149 procedure Trailing_Currency
;
1150 procedure Trailing_Bracket
;
1151 procedure Number_Fraction
;
1152 procedure Number_Completion
;
1153 procedure Number_Fraction_Or_Bracket
;
1154 procedure Number_Fraction_Or_Z_Fill
;
1155 procedure Zero_Suppression
;
1156 procedure Floating_Bracket
;
1157 procedure Number_Fraction_Or_Star_Fill
;
1158 procedure Star_Suppression
;
1159 procedure Number_Fraction_Or_Dollar
;
1160 procedure Leading_Dollar
;
1161 procedure Number_Fraction_Or_Pound
;
1162 procedure Leading_Pound
;
1164 procedure Floating_Plus
;
1165 procedure Floating_Minus
;
1166 procedure Picture_Plus
;
1167 procedure Picture_Minus
;
1168 procedure Picture_Bracket
;
1170 procedure Optional_RHS_Sign
;
1171 procedure Picture_String
;
1177 function At_End
return Boolean is
1179 return Index
> Pic
.Picture
.Length
;
1182 ----------------------
1183 -- Floating_Bracket --
1184 ----------------------
1186 -- Note that Floating_Bracket is only called with an acceptable
1187 -- prefix. But we don't set Okay, because we must end with a '>'.
1189 procedure Floating_Bracket
is
1192 Pic
.End_Float
:= Index
;
1193 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1195 -- First bracket wasn't counted...
1206 when '_' |
'0' |
'/' =>
1207 Pic
.End_Float
:= Index
;
1211 Pic
.End_Float
:= Index
;
1212 Pic
.Picture
.Expanded
(Index
) := 'b';
1216 Pic
.End_Float
:= Index
;
1217 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1229 when 'V' |
'v' |
'.' =>
1230 Pic
.Radix_Position
:= Index
;
1232 Number_Fraction_Or_Bracket
;
1239 end Floating_Bracket
;
1241 --------------------
1242 -- Floating_Minus --
1243 --------------------
1245 procedure Floating_Minus
is
1253 when '_' |
'0' |
'/' =>
1254 Pic
.End_Float
:= Index
;
1258 Pic
.End_Float
:= Index
;
1259 Pic
.Picture
.Expanded
(Index
) := 'b';
1263 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1264 Pic
.End_Float
:= Index
;
1271 when '.' |
'V' |
'v' =>
1272 Pic
.Radix_Position
:= Index
;
1275 while Is_Insert
loop
1292 Pic
.Max_Trailing_Digits
:=
1293 Pic
.Max_Trailing_Digits
+ 1;
1294 Pic
.End_Float
:= Index
;
1297 when '_' |
'0' |
'/' =>
1301 Pic
.Picture
.Expanded
(Index
) := 'b';
1326 procedure Floating_Plus
is
1334 when '_' |
'0' |
'/' =>
1335 Pic
.End_Float
:= Index
;
1339 Pic
.End_Float
:= Index
;
1340 Pic
.Picture
.Expanded
(Index
) := 'b';
1344 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1345 Pic
.End_Float
:= Index
;
1352 when '.' |
'V' |
'v' =>
1353 Pic
.Radix_Position
:= Index
;
1356 while Is_Insert
loop
1373 Pic
.Max_Trailing_Digits
:=
1374 Pic
.Max_Trailing_Digits
+ 1;
1375 Pic
.End_Float
:= Index
;
1378 when '_' |
'0' |
'/' =>
1382 Pic
.Picture
.Expanded
(Index
) := 'b';
1408 function Is_Insert
return Boolean is
1414 case Pic
.Picture
.Expanded
(Index
) is
1416 when '_' |
'0' |
'/' => return True;
1419 Pic
.Picture
.Expanded
(Index
) := 'b'; -- canonical
1422 when others => return False;
1426 --------------------
1427 -- Leading_Dollar --
1428 --------------------
1430 -- Note that Leading_Dollar can be called in either State.
1431 -- It will set state to Okay only if a 9 or (second) $
1434 -- Also notice the tricky bit with State and Zero_Suppression.
1435 -- Zero_Suppression is Picture_Error if a '$' or a '9' has been
1436 -- encountered, exactly the cases where State has been set.
1438 procedure Leading_Dollar
is
1440 -- Treat as a floating dollar, and unwind otherwise.
1443 Pic
.Start_Currency
:= Index
;
1444 Pic
.End_Currency
:= Index
;
1445 Pic
.Start_Float
:= Index
;
1446 Pic
.End_Float
:= Index
;
1448 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1460 when '_' |
'0' |
'/' =>
1461 Pic
.End_Float
:= Index
;
1464 -- A trailing insertion character is not part of the
1465 -- floating currency, so need to look ahead.
1468 Pic
.End_Float
:= Pic
.End_Float
- 1;
1472 Pic
.End_Float
:= Index
;
1473 Pic
.Picture
.Expanded
(Index
) := 'b';
1477 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
1479 if State
= Okay
then
1480 raise Picture_Error
;
1482 -- Will overwrite Floater and Start_Float
1488 if State
= Okay
then
1489 raise Picture_Error
;
1491 -- Will overwrite Floater and Start_Float
1497 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1498 Pic
.End_Float
:= Index
;
1499 Pic
.End_Currency
:= Index
;
1500 Set_State
(Okay
); Skip
;
1503 if State
/= Okay
then
1505 Pic
.Start_Float
:= Invalid_Position
;
1506 Pic
.End_Float
:= Invalid_Position
;
1509 -- A single dollar does not a floating make.
1514 when 'V' |
'v' |
'.' =>
1515 if State
/= Okay
then
1517 Pic
.Start_Float
:= Invalid_Position
;
1518 Pic
.End_Float
:= Invalid_Position
;
1521 -- Only one dollar before the sign is okay,
1522 -- but doesn't float.
1524 Pic
.Radix_Position
:= Index
;
1526 Number_Fraction_Or_Dollar
;
1540 -- This one is complex! A Leading_Pound can be fixed or floating,
1541 -- but in some cases the decision has to be deferred until we leave
1542 -- this procedure. Also note that Leading_Pound can be called in
1545 -- It will set state to Okay only if a 9 or (second) # is
1548 -- One Last note: In ambiguous cases, the currency is treated as
1549 -- floating unless there is only one '#'.
1551 procedure Leading_Pound
is
1553 Inserts
: Boolean := False;
1554 -- Set to True if a '_', '0', '/', 'B', or 'b' is encountered
1556 Must_Float
: Boolean := False;
1557 -- Set to true if a '#' occurs after an insert.
1560 -- Treat as a floating currency. If it isn't, this will be
1561 -- overwritten later.
1565 Pic
.Start_Currency
:= Index
;
1566 Pic
.End_Currency
:= Index
;
1567 Pic
.Start_Float
:= Index
;
1568 Pic
.End_Float
:= Index
;
1570 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1573 Pic
.Max_Currency_Digits
:= 1; -- we've seen one.
1584 when '_' |
'0' |
'/' =>
1585 Pic
.End_Float
:= Index
;
1590 Pic
.Picture
.Expanded
(Index
) := 'b';
1591 Pic
.End_Float
:= Index
;
1596 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
1599 raise Picture_Error
;
1601 Pic
.Max_Leading_Digits
:= 0;
1603 -- Will overwrite Floater and Start_Float
1610 raise Picture_Error
;
1612 Pic
.Max_Leading_Digits
:= 0;
1614 -- Will overwrite Floater and Start_Float
1624 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1625 Pic
.End_Float
:= Index
;
1626 Pic
.End_Currency
:= Index
;
1631 if State
/= Okay
then
1633 -- A single '#' doesn't float.
1636 Pic
.Start_Float
:= Invalid_Position
;
1637 Pic
.End_Float
:= Invalid_Position
;
1643 when 'V' |
'v' |
'.' =>
1644 if State
/= Okay
then
1646 Pic
.Start_Float
:= Invalid_Position
;
1647 Pic
.End_Float
:= Invalid_Position
;
1650 -- Only one pound before the sign is okay,
1651 -- but doesn't float.
1653 Pic
.Radix_Position
:= Index
;
1655 Number_Fraction_Or_Pound
;
1668 function Look
return Character is
1671 raise Picture_Error
;
1674 return Pic
.Picture
.Expanded
(Index
);
1686 when '_' |
'0' |
'/' =>
1690 Pic
.Picture
.Expanded
(Index
) := 'b';
1694 Computed_BWZ
:= False;
1695 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1699 when '.' |
'V' |
'v' =>
1700 Pic
.Radix_Position
:= Index
;
1714 -- Will return in Okay state if a '9' was seen.
1719 -----------------------
1720 -- Number_Completion --
1721 -----------------------
1723 procedure Number_Completion
is
1725 while not At_End
loop
1728 when '_' |
'0' |
'/' =>
1732 Pic
.Picture
.Expanded
(Index
) := 'b';
1736 Computed_BWZ
:= False;
1737 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1741 when 'V' |
'v' |
'.' =>
1742 Pic
.Radix_Position
:= Index
;
1751 end Number_Completion
;
1753 ---------------------
1754 -- Number_Fraction --
1755 ---------------------
1757 procedure Number_Fraction
is
1759 -- Note that number fraction can be called in either State.
1760 -- It will set state to Valid only if a 9 is encountered.
1768 when '_' |
'0' |
'/' =>
1772 Pic
.Picture
.Expanded
(Index
) := 'b';
1776 Computed_BWZ
:= False;
1777 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1778 Set_State
(Okay
); Skip
;
1784 end Number_Fraction
;
1786 --------------------------------
1787 -- Number_Fraction_Or_Bracket --
1788 --------------------------------
1790 procedure Number_Fraction_Or_Bracket
is
1799 when '_' |
'0' |
'/' => Skip
;
1802 Pic
.Picture
.Expanded
(Index
) := 'b';
1806 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1807 Pic
.End_Float
:= Index
;
1816 when '_' |
'0' |
'/' =>
1820 Pic
.Picture
.Expanded
(Index
) := 'b';
1824 Pic
.Max_Trailing_Digits
:=
1825 Pic
.Max_Trailing_Digits
+ 1;
1826 Pic
.End_Float
:= Index
;
1839 end Number_Fraction_Or_Bracket
;
1841 -------------------------------
1842 -- Number_Fraction_Or_Dollar --
1843 -------------------------------
1845 procedure Number_Fraction_Or_Dollar
is
1853 when '_' |
'0' |
'/' =>
1857 Pic
.Picture
.Expanded
(Index
) := 'b';
1861 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1862 Pic
.End_Float
:= Index
;
1871 when '_' |
'0' |
'/' =>
1875 Pic
.Picture
.Expanded
(Index
) := 'b';
1879 Pic
.Max_Trailing_Digits
:=
1880 Pic
.Max_Trailing_Digits
+ 1;
1881 Pic
.End_Float
:= Index
;
1894 end Number_Fraction_Or_Dollar
;
1896 ------------------------------
1897 -- Number_Fraction_Or_Pound --
1898 ------------------------------
1900 procedure Number_Fraction_Or_Pound
is
1909 when '_' |
'0' |
'/' =>
1913 Pic
.Picture
.Expanded
(Index
) := 'b';
1917 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1918 Pic
.End_Float
:= Index
;
1928 when '_' |
'0' |
'/' =>
1932 Pic
.Picture
.Expanded
(Index
) := 'b';
1936 Pic
.Max_Trailing_Digits
:=
1937 Pic
.Max_Trailing_Digits
+ 1;
1938 Pic
.End_Float
:= Index
;
1953 end Number_Fraction_Or_Pound
;
1955 ----------------------------------
1956 -- Number_Fraction_Or_Star_Fill --
1957 ----------------------------------
1959 procedure Number_Fraction_Or_Star_Fill
is
1968 when '_' |
'0' |
'/' =>
1972 Pic
.Picture
.Expanded
(Index
) := 'b';
1976 Pic
.Star_Fill
:= True;
1977 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1978 Pic
.End_Float
:= Index
;
1988 when '_' |
'0' |
'/' =>
1992 Pic
.Picture
.Expanded
(Index
) := 'b';
1996 Pic
.Star_Fill
:= True;
1997 Pic
.Max_Trailing_Digits
:=
1998 Pic
.Max_Trailing_Digits
+ 1;
1999 Pic
.End_Float
:= Index
;
2013 end Number_Fraction_Or_Star_Fill
;
2015 -------------------------------
2016 -- Number_Fraction_Or_Z_Fill --
2017 -------------------------------
2019 procedure Number_Fraction_Or_Z_Fill
is
2028 when '_' |
'0' |
'/' =>
2032 Pic
.Picture
.Expanded
(Index
) := 'b';
2036 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
2037 Pic
.End_Float
:= Index
;
2038 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2049 when '_' |
'0' |
'/' =>
2053 Pic
.Picture
.Expanded
(Index
) := 'b';
2057 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2059 Pic
.Max_Trailing_Digits
:=
2060 Pic
.Max_Trailing_Digits
+ 1;
2061 Pic
.End_Float
:= Index
;
2074 end Number_Fraction_Or_Z_Fill
;
2076 -----------------------
2077 -- Optional_RHS_Sign --
2078 -----------------------
2080 procedure Optional_RHS_Sign
is
2089 Pic
.Sign_Position
:= Index
;
2094 Pic
.Sign_Position
:= Index
;
2095 Pic
.Picture
.Expanded
(Index
) := 'C';
2098 if Look
= 'R' or Look
= 'r' then
2099 Pic
.Second_Sign
:= Index
;
2100 Pic
.Picture
.Expanded
(Index
) := 'R';
2104 raise Picture_Error
;
2110 Pic
.Sign_Position
:= Index
;
2111 Pic
.Picture
.Expanded
(Index
) := 'D';
2114 if Look
= 'B' or Look
= 'b' then
2115 Pic
.Second_Sign
:= Index
;
2116 Pic
.Picture
.Expanded
(Index
) := 'B';
2120 raise Picture_Error
;
2126 if Pic
.Picture
.Expanded
(Pic
.Sign_Position
) = '<' then
2127 Pic
.Second_Sign
:= Index
;
2131 raise Picture_Error
;
2138 end Optional_RHS_Sign
;
2144 -- Note that Picture can be called in either State.
2146 -- It will set state to Valid only if a 9 is encountered or floating
2147 -- currency is called.
2149 procedure Picture
is
2158 when '_' |
'0' |
'/' =>
2162 Pic
.Picture
.Expanded
(Index
) := 'b';
2174 Computed_BWZ
:= False;
2176 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2179 when 'V' |
'v' |
'.' =>
2180 Pic
.Radix_Position
:= Index
;
2193 ---------------------
2194 -- Picture_Bracket --
2195 ---------------------
2197 procedure Picture_Bracket
is
2199 Pic
.Sign_Position
:= Index
;
2200 Pic
.Sign_Position
:= Index
;
2202 -- Treat as a floating sign, and unwind otherwise.
2205 Pic
.Start_Float
:= Index
;
2206 Pic
.End_Float
:= Index
;
2208 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2211 Skip
; -- Known Bracket
2216 when '_' |
'0' |
'/' =>
2217 Pic
.End_Float
:= Index
;
2221 Pic
.End_Float
:= Index
;
2222 Pic
.Picture
.Expanded
(Index
) := 'b';
2226 Set_State
(Okay
); -- "<<>" is enough.
2232 when '$' |
'#' |
'9' |
'*' =>
2233 if State
/= Okay
then
2235 Pic
.Start_Float
:= Invalid_Position
;
2236 Pic
.End_Float
:= Invalid_Position
;
2244 when '.' |
'V' |
'v' =>
2245 if State
/= Okay
then
2247 Pic
.Start_Float
:= Invalid_Position
;
2248 Pic
.End_Float
:= Invalid_Position
;
2251 -- Don't assume that state is okay, haven't seen a digit
2258 raise Picture_Error
;
2262 end Picture_Bracket
;
2268 procedure Picture_Minus
is
2270 Pic
.Sign_Position
:= Index
;
2272 -- Treat as a floating sign, and unwind otherwise.
2275 Pic
.Start_Float
:= Index
;
2276 Pic
.End_Float
:= Index
;
2278 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2281 Skip
; -- Known Minus
2286 when '_' |
'0' |
'/' =>
2287 Pic
.End_Float
:= Index
;
2291 Pic
.End_Float
:= Index
;
2292 Pic
.Picture
.Expanded
(Index
) := 'b';
2296 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2297 Pic
.End_Float
:= Index
;
2299 Set_State
(Okay
); -- "-- " is enough.
2304 when '$' |
'#' |
'9' |
'*' =>
2305 if State
/= Okay
then
2307 Pic
.Start_Float
:= Invalid_Position
;
2308 Pic
.End_Float
:= Invalid_Position
;
2317 -- Can't have Z and a floating sign.
2319 if State
= Okay
then
2323 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2329 when '.' |
'V' |
'v' =>
2330 if State
/= Okay
then
2332 Pic
.Start_Float
:= Invalid_Position
;
2333 Pic
.End_Float
:= Invalid_Position
;
2336 -- Don't assume that state is okay, haven't seen a digit.
2352 procedure Picture_Plus
is
2354 Pic
.Sign_Position
:= Index
;
2356 -- Treat as a floating sign, and unwind otherwise.
2359 Pic
.Start_Float
:= Index
;
2360 Pic
.End_Float
:= Index
;
2362 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2370 when '_' |
'0' |
'/' =>
2371 Pic
.End_Float
:= Index
;
2375 Pic
.End_Float
:= Index
;
2376 Pic
.Picture
.Expanded
(Index
) := 'b';
2380 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2381 Pic
.End_Float
:= Index
;
2383 Set_State
(Okay
); -- "++" is enough.
2388 when '$' |
'#' |
'9' |
'*' =>
2389 if State
/= Okay
then
2391 Pic
.Start_Float
:= Invalid_Position
;
2392 Pic
.End_Float
:= Invalid_Position
;
2400 if State
= Okay
then
2404 -- Can't have Z and a floating sign.
2406 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2408 -- '+Z' is acceptable
2417 when '.' |
'V' |
'v' =>
2418 if State
/= Okay
then
2420 Pic
.Start_Float
:= Invalid_Position
;
2421 Pic
.End_Float
:= Invalid_Position
;
2424 -- Don't assume that state is okay, haven't seen a digit.
2436 --------------------
2437 -- Picture_String --
2438 --------------------
2440 procedure Picture_String
is
2442 while Is_Insert
loop
2462 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2472 when '9' |
'.' |
'V' |
'v' =>
2478 raise Picture_Error
;
2482 -- Blank when zero either if the PIC does not contain a '9' or if
2483 -- requested by the user and no '*'
2485 Pic
.Blank_When_Zero
:=
2486 (Computed_BWZ
or Pic
.Blank_When_Zero
) and not Pic
.Star_Fill
;
2488 -- Star fill if '*' and no '9'.
2490 Pic
.Star_Fill
:= Pic
.Star_Fill
and Computed_BWZ
;
2502 procedure Set_State
(L
: Legality
) is
2516 ----------------------
2517 -- Star_Suppression --
2518 ----------------------
2520 procedure Star_Suppression
is
2523 Pic
.Start_Float
:= Index
;
2524 Pic
.End_Float
:= Index
;
2525 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2528 -- Even a single * is a valid picture
2530 Pic
.Star_Fill
:= True;
2540 when '_' |
'0' |
'/' =>
2541 Pic
.End_Float
:= Index
;
2545 Pic
.End_Float
:= Index
;
2546 Pic
.Picture
.Expanded
(Index
) := 'b';
2550 Pic
.End_Float
:= Index
;
2551 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2552 Set_State
(Okay
); Skip
;
2559 when '.' |
'V' |
'v' =>
2560 Pic
.Radix_Position
:= Index
;
2562 Number_Fraction_Or_Star_Fill
;
2570 when others => raise Picture_Error
;
2573 end Star_Suppression
;
2575 ----------------------
2576 -- Trailing_Bracket --
2577 ----------------------
2579 procedure Trailing_Bracket
is
2582 Pic
.Second_Sign
:= Index
;
2585 raise Picture_Error
;
2587 end Trailing_Bracket
;
2589 -----------------------
2590 -- Trailing_Currency --
2591 -----------------------
2593 procedure Trailing_Currency
is
2600 Pic
.Start_Currency
:= Index
;
2601 Pic
.End_Currency
:= Index
;
2605 while not At_End
and then Look
= '#' loop
2606 if Pic
.Start_Currency
= Invalid_Position
then
2607 Pic
.Start_Currency
:= Index
;
2610 Pic
.End_Currency
:= Index
;
2621 when '_' |
'0' |
'/' => Skip
;
2624 Pic
.Picture
.Expanded
(Index
) := 'b';
2627 when others => return;
2630 end Trailing_Currency
;
2632 ----------------------
2633 -- Zero_Suppression --
2634 ----------------------
2636 procedure Zero_Suppression
is
2639 Pic
.Start_Float
:= Index
;
2640 Pic
.End_Float
:= Index
;
2641 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2642 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2647 -- Even a single Z is a valid picture
2655 when '_' |
'0' |
'/' =>
2656 Pic
.End_Float
:= Index
;
2660 Pic
.End_Float
:= Index
;
2661 Pic
.Picture
.Expanded
(Index
) := 'b';
2665 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2667 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2668 Pic
.End_Float
:= Index
;
2677 when '.' |
'V' |
'v' =>
2678 Pic
.Radix_Position
:= Index
;
2680 Number_Fraction_Or_Z_Fill
;
2692 end Zero_Suppression
;
2694 -- Start of processing for Precalculate
2699 if State
= Reject
then
2700 raise Picture_Error
;
2705 when Constraint_Error
=>
2707 -- To deal with special cases like null strings.
2709 raise Picture_Error
;
2718 (Pic_String
: in String;
2719 Blank_When_Zero
: in Boolean := False)
2726 Item
: constant String := Expand
(Pic_String
);
2729 Result
.Contents
.Picture
:= (Item
'Length, Item
);
2730 Result
.Contents
.Original_BWZ
:= Blank_When_Zero
;
2731 Result
.Contents
.Blank_When_Zero
:= Blank_When_Zero
;
2732 Precalculate
(Result
.Contents
);
2738 raise Picture_Error
;
2746 function To_Wide
(C
: Character) return Wide_Character is
2748 return Wide_Character'Val (Character'Pos (C
));
2756 (Pic_String
: in String;
2757 Blank_When_Zero
: in Boolean := False)
2762 Expanded_Pic
: constant String := Expand
(Pic_String
);
2763 -- Raises Picture_Error if Item not well-formed
2765 Format_Rec
: Format_Record
;
2768 Format_Rec
.Picture
:= (Expanded_Pic
'Length, Expanded_Pic
);
2769 Format_Rec
.Blank_When_Zero
:= Blank_When_Zero
;
2770 Format_Rec
.Original_BWZ
:= Blank_When_Zero
;
2771 Precalculate
(Format_Rec
);
2773 -- False only if Blank_When_0 is True but the pic string
2776 return not Blank_When_Zero
or
2777 Strings_Fixed
.Index
(Expanded_Pic
, "*") = 0;
2781 when others => return False;
2785 end Ada
.Wide_Text_IO
.Editing
;