File : g-forstr.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- G N A T . F O R M A T T E D _ S T R I N G --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2014, Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
17 -- --
18 -- --
19 -- --
20 -- --
21 -- --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
29 -- --
30 ------------------------------------------------------------------------------
31
32 with Ada.Characters.Handling;
33 with Ada.Float_Text_IO;
34 with Ada.Integer_Text_IO;
35 with Ada.Long_Float_Text_IO;
36 with Ada.Long_Integer_Text_IO;
37 with Ada.Strings.Fixed;
38 with Ada.Unchecked_Deallocation;
39
40 with System.Address_Image;
41
42 package body GNAT.Formatted_String is
43
44 type F_Kind is (Decimal_Int, -- %d %i
45 Unsigned_Decimal_Int, -- %u
46 Unsigned_Octal, -- %o
47 Unsigned_Hexadecimal_Int, -- %x
48 Unsigned_Hexadecimal_Int_Up, -- %X
49 Decimal_Float, -- %f %F
50 Decimal_Scientific_Float, -- %e
51 Decimal_Scientific_Float_Up, -- %E
52 Shortest_Decimal_Float, -- %g
53 Shortest_Decimal_Float_Up, -- %G
54 Char, -- %c
55 Str, -- %s
56 Pointer -- %p
57 );
58
59 type Sign_Kind is (Neg, Zero, Pos);
60
61 subtype Is_Number is F_Kind range Decimal_Int .. Decimal_Float;
62
63 type F_Sign is (If_Neg, Forced, Space) with Default_Value => If_Neg;
64
65 type F_Base is (None, C_Style, Ada_Style) with Default_Value => None;
66
67 Unset : constant Integer := -1;
68
69 type F_Data is record
70 Kind : F_Kind;
71 Width : Natural := 0;
72 Precision : Integer := Unset;
73 Left_Justify : Boolean := False;
74 Sign : F_Sign;
75 Base : F_Base;
76 Zero_Pad : Boolean := False;
77 Value_Needed : Natural range 0 .. 2 := 0;
78 end record;
79
80 procedure Next_Format
81 (Format : Formatted_String;
82 F_Spec : out F_Data;
83 Start : out Positive);
84 -- Parse the next format specifier, a format specifier has the following
85 -- syntax: %[flags][width][.precision][length]specifier
86
87 function Get_Formatted
88 (F_Spec : F_Data;
89 Value : String;
90 Len : Positive) return String;
91 -- Returns Value formatted given the information in F_Spec
92
93 procedure Raise_Wrong_Format (Format : Formatted_String) with No_Return;
94 -- Raise the Format_Error exception which information about the context
95
96 generic
97 type Flt is private;
98
99 with procedure Put
100 (To : out String;
101 Item : Flt;
102 Aft : Text_IO.Field;
103 Exp : Text_IO.Field);
104 function P_Flt_Format
105 (Format : Formatted_String;
106 Var : Flt) return Formatted_String;
107 -- Generic routine which handles all floating point numbers
108
109 generic
110 type Int is private;
111
112 with function To_Integer (Item : Int) return Integer;
113
114 with function Sign (Item : Int) return Sign_Kind;
115
116 with procedure Put
117 (To : out String;
118 Item : Int;
119 Base : Text_IO.Number_Base);
120 function P_Int_Format
121 (Format : Formatted_String;
122 Var : Int) return Formatted_String;
123 -- Generic routine which handles all the integer numbers
124
125 ---------
126 -- "+" --
127 ---------
128
129 function "+" (Format : String) return Formatted_String is
130 begin
131 return Formatted_String'
132 (Finalization.Controlled with
133 D => new Data'(Format'Length, 1, Format, 1,
134 Null_Unbounded_String, 0, 0, (0, 0)));
135 end "+";
136
137 ---------
138 -- "-" --
139 ---------
140
141 function "-" (Format : Formatted_String) return String is
142 F : String renames Format.D.Format;
143 J : Natural renames Format.D.Index;
144 R : Unbounded_String := Format.D.Result;
145
146 begin
147 -- Make sure we get the remaining character up to the next unhandled
148 -- format specifier.
149
150 while (J <= F'Length and then F (J) /= '%')
151 or else (J < F'Length - 1 and then F (J + 1) = '%')
152 loop
153 Append (R, F (J));
154
155 -- If we have two consecutive %, skip the second one
156
157 if F (J) = '%' and then J < F'Length - 1 and then F (J + 1) = '%' then
158 J := J + 1;
159 end if;
160
161 J := J + 1;
162 end loop;
163
164 return To_String (R);
165 end "-";
166
167 ---------
168 -- "&" --
169 ---------
170
171 function "&"
172 (Format : Formatted_String;
173 Var : Character) return Formatted_String
174 is
175 F : F_Data;
176 Start : Positive;
177
178 begin
179 Next_Format (Format, F, Start);
180
181 if F.Value_Needed > 0 then
182 Raise_Wrong_Format (Format);
183 end if;
184
185 case F.Kind is
186 when Char =>
187 Append (Format.D.Result, Get_Formatted (F, String'(1 => Var), 1));
188 when others =>
189 Raise_Wrong_Format (Format);
190 end case;
191
192 return Format;
193 end "&";
194
195 function "&"
196 (Format : Formatted_String;
197 Var : String) return Formatted_String
198 is
199 F : F_Data;
200 Start : Positive;
201
202 begin
203 Next_Format (Format, F, Start);
204
205 if F.Value_Needed > 0 then
206 Raise_Wrong_Format (Format);
207 end if;
208
209 case F.Kind is
210 when Str =>
211 declare
212 S : constant String := Get_Formatted (F, Var, Var'Length);
213 begin
214 if F.Precision = Unset then
215 Append (Format.D.Result, S);
216 else
217 Append
218 (Format.D.Result,
219 S (S'First .. S'First + F.Precision - 1));
220 end if;
221 end;
222
223 when others =>
224 Raise_Wrong_Format (Format);
225 end case;
226
227 return Format;
228 end "&";
229
230 function "&"
231 (Format : Formatted_String;
232 Var : Boolean) return Formatted_String is
233 begin
234 return Format & Boolean'Image (Var);
235 end "&";
236
237 function "&"
238 (Format : Formatted_String;
239 Var : Float) return Formatted_String
240 is
241 function Float_Format is new Flt_Format (Float, Float_Text_IO.Put);
242 begin
243 return Float_Format (Format, Var);
244 end "&";
245
246 function "&"
247 (Format : Formatted_String;
248 Var : Long_Float) return Formatted_String
249 is
250 function Float_Format is
251 new Flt_Format (Long_Float, Long_Float_Text_IO.Put);
252 begin
253 return Float_Format (Format, Var);
254 end "&";
255
256 function "&"
257 (Format : Formatted_String;
258 Var : Duration) return Formatted_String
259 is
260 package Duration_Text_IO is new Text_IO.Fixed_IO (Duration);
261 function Duration_Format is
262 new P_Flt_Format (Duration, Duration_Text_IO.Put);
263 begin
264 return Duration_Format (Format, Var);
265 end "&";
266
267 function "&"
268 (Format : Formatted_String;
269 Var : Integer) return Formatted_String
270 is
271 function Integer_Format is
272 new Int_Format (Integer, Integer_Text_IO.Put);
273 begin
274 return Integer_Format (Format, Var);
275 end "&";
276
277 function "&"
278 (Format : Formatted_String;
279 Var : Long_Integer) return Formatted_String
280 is
281 function Integer_Format is
282 new Int_Format (Long_Integer, Long_Integer_Text_IO.Put);
283 begin
284 return Integer_Format (Format, Var);
285 end "&";
286
287 function "&"
288 (Format : Formatted_String;
289 Var : System.Address) return Formatted_String
290 is
291 A_Img : constant String := System.Address_Image (Var);
292 F : F_Data;
293 Start : Positive;
294
295 begin
296 Next_Format (Format, F, Start);
297
298 if F.Value_Needed > 0 then
299 Raise_Wrong_Format (Format);
300 end if;
301
302 case F.Kind is
303 when Pointer =>
304 Append (Format.D.Result, Get_Formatted (F, A_Img, A_Img'Length));
305 when others =>
306 Raise_Wrong_Format (Format);
307 end case;
308
309 return Format;
310 end "&";
311
312 ------------
313 -- Adjust --
314 ------------
315
316 overriding procedure Adjust (F : in out Formatted_String) is
317 begin
318 F.D.Ref_Count := F.D.Ref_Count + 1;
319 end Adjust;
320
321 --------------------
322 -- Decimal_Format --
323 --------------------
324
325 function Decimal_Format
326 (Format : Formatted_String;
327 Var : Flt) return Formatted_String
328 is
329 function Flt_Format is new P_Flt_Format (Flt, Put);
330 begin
331 return Flt_Format (Format, Var);
332 end Decimal_Format;
333
334 -----------------
335 -- Enum_Format --
336 -----------------
337
338 function Enum_Format
339 (Format : Formatted_String;
340 Var : Enum) return Formatted_String is
341 begin
342 return Format & Enum'Image (Var);
343 end Enum_Format;
344
345 --------------
346 -- Finalize --
347 --------------
348
349 overriding procedure Finalize (F : in out Formatted_String) is
350 procedure Unchecked_Free is
351 new Unchecked_Deallocation (Data, Data_Access);
352
353 D : Data_Access := F.D;
354
355 begin
356 F.D := null;
357
358 D.Ref_Count := D.Ref_Count - 1;
359
360 if D.Ref_Count = 0 then
361 Unchecked_Free (D);
362 end if;
363 end Finalize;
364
365 ------------------
366 -- Fixed_Format --
367 ------------------
368
369 function Fixed_Format
370 (Format : Formatted_String;
371 Var : Flt) return Formatted_String
372 is
373 function Flt_Format is new P_Flt_Format (Flt, Put);
374 begin
375 return Flt_Format (Format, Var);
376 end Fixed_Format;
377
378 ----------------
379 -- Flt_Format --
380 ----------------
381
382 function Flt_Format
383 (Format : Formatted_String;
384 Var : Flt) return Formatted_String
385 is
386 function Flt_Format is new P_Flt_Format (Flt, Put);
387 begin
388 return Flt_Format (Format, Var);
389 end Flt_Format;
390
391 -------------------
392 -- Get_Formatted --
393 -------------------
394
395 function Get_Formatted
396 (F_Spec : F_Data;
397 Value : String;
398 Len : Positive) return String
399 is
400 use Ada.Strings.Fixed;
401
402 Res : Unbounded_String;
403 S : Positive := Value'First;
404
405 begin
406 -- Handle the flags
407
408 if F_Spec.Kind in Is_Number then
409 if F_Spec.Sign = Forced and then Value (Value'First) /= '-' then
410 Append (Res, "+");
411 elsif F_Spec.Sign = Space and then Value (Value'First) /= '-' then
412 Append (Res, " ");
413 end if;
414
415 if Value (Value'First) = '-' then
416 Append (Res, "-");
417 S := S + 1;
418 end if;
419 end if;
420
421 -- Zero padding if required and possible
422
423 if F_Spec.Left_Justify = False
424 and then F_Spec.Zero_Pad
425 and then F_Spec.Width > Len + Value'First - S
426 then
427 Append (Res, String'((F_Spec.Width - Len + Value'First - S) * '0'));
428 end if;
429
430 -- Add the value now
431
432 Append (Res, Value (S .. Value'Last));
433
434 declare
435 R : String (1 .. Natural'Max (Natural'Max (F_Spec.Width, Len),
436 Length (Res))) := (others => ' ');
437 begin
438 if F_Spec.Left_Justify then
439 R (1 .. Length (Res)) := To_String (Res);
440 else
441 R (R'Last - Length (Res) + 1 .. R'Last) := To_String (Res);
442 end if;
443
444 return R;
445 end;
446 end Get_Formatted;
447
448 ----------------
449 -- Int_Format --
450 ----------------
451
452 function Int_Format
453 (Format : Formatted_String;
454 Var : Int) return Formatted_String
455 is
456 function Sign (Var : Int) return Sign_Kind is
457 (if Var < 0 then Neg elsif Var = 0 then Zero else Pos);
458
459 function To_Integer (Var : Int) return Integer is
460 (Integer (Var));
461
462 function Int_Format is new P_Int_Format (Int, To_Integer, Sign, Put);
463
464 begin
465 return Int_Format (Format, Var);
466 end Int_Format;
467
468 ----------------
469 -- Mod_Format --
470 ----------------
471
472 function Mod_Format
473 (Format : Formatted_String;
474 Var : Int) return Formatted_String
475 is
476 function Sign (Var : Int) return Sign_Kind is
477 (if Var < 0 then Neg elsif Var = 0 then Zero else Pos);
478
479 function To_Integer (Var : Int) return Integer is
480 (Integer (Var));
481
482 function Int_Format is new P_Int_Format (Int, To_Integer, Sign, Put);
483
484 begin
485 return Int_Format (Format, Var);
486 end Mod_Format;
487
488 -----------------
489 -- Next_Format --
490 -----------------
491
492 procedure Next_Format
493 (Format : Formatted_String;
494 F_Spec : out F_Data;
495 Start : out Positive)
496 is
497 F : String renames Format.D.Format;
498 J : Natural renames Format.D.Index;
499 S : Natural;
500 Width_From_Var : Boolean := False;
501
502 begin
503 Format.D.Current := Format.D.Current + 1;
504 F_Spec.Value_Needed := 0;
505
506 -- Got to next %
507
508 while (J <= F'Last and then F (J) /= '%')
509 or else (J < F'Last - 1 and then F (J + 1) = '%')
510 loop
511 Append (Format.D.Result, F (J));
512
513 -- If we have two consecutive %, skip the second one
514
515 if F (J) = '%' and then J < F'Last - 1 and then F (J + 1) = '%' then
516 J := J + 1;
517 end if;
518
519 J := J + 1;
520 end loop;
521
522 if F (J) /= '%' or else J = F'Last then
523 raise Format_Error with "no format specifier found for parameter"
524 & Positive'Image (Format.D.Current);
525 end if;
526
527 Start := J;
528
529 J := J + 1;
530
531 -- Check for any flags
532
533 Flags_Check : while J < F'Last loop
534 if F (J) = '-' then
535 F_Spec.Left_Justify := True;
536 elsif F (J) = '+' then
537 F_Spec.Sign := Forced;
538 elsif F (J) = ' ' then
539 F_Spec.Sign := Space;
540 elsif F (J) = '#' then
541 F_Spec.Base := C_Style;
542 elsif F (J) = '~' then
543 F_Spec.Base := Ada_Style;
544 elsif F (J) = '0' then
545 F_Spec.Zero_Pad := True;
546 else
547 exit Flags_Check;
548 end if;
549
550 J := J + 1;
551 end loop Flags_Check;
552
553 -- Check width if any
554
555 if F (J) in '0' .. '9' then
556
557 -- We have a width parameter
558
559 S := J;
560
561 while J < F'Last and then F (J + 1) in '0' .. '9' loop
562 J := J + 1;
563 end loop;
564
565 F_Spec.Width := Natural'Value (F (S .. J));
566
567 J := J + 1;
568
569 elsif F (J) = '*' then
570
571 -- The width will be taken from the integer parameter
572
573 F_Spec.Value_Needed := 1;
574 Width_From_Var := True;
575
576 J := J + 1;
577 end if;
578
579 if F (J) = '.' then
580
581 -- We have a precision parameter
582
583 J := J + 1;
584
585 if F (J) in '0' .. '9' then
586 S := J;
587
588 while J < F'Length and then F (J + 1) in '0' .. '9' loop
589 J := J + 1;
590 end loop;
591
592 if F (J) = '.' then
593
594 -- No precision, 0 is assumed
595
596 F_Spec.Precision := 0;
597
598 else
599 F_Spec.Precision := Natural'Value (F (S .. J));
600 end if;
601
602 J := J + 1;
603
604 elsif F (J) = '*' then
605
606 -- The prevision will be taken from the integer parameter
607
608 F_Spec.Value_Needed := F_Spec.Value_Needed + 1;
609 J := J + 1;
610 end if;
611 end if;
612
613 -- Skip the length specifier, this is not needed for this implementation
614 -- but yet for compatibility reason it is handled.
615
616 Length_Check :
617 while J <= F'Last
618 and then F (J) in 'h' | 'l' | 'j' | 'z' | 't' | 'L'
619 loop
620 J := J + 1;
621 end loop Length_Check;
622
623 if J > F'Last then
624 Raise_Wrong_Format (Format);
625 end if;
626
627 -- Read next character which should be the expected type
628
629 case F (J) is
630 when 'c' => F_Spec.Kind := Char;
631 when 's' => F_Spec.Kind := Str;
632 when 'd' | 'i' => F_Spec.Kind := Decimal_Int;
633 when 'u' => F_Spec.Kind := Unsigned_Decimal_Int;
634 when 'f' | 'F' => F_Spec.Kind := Decimal_Float;
635 when 'e' => F_Spec.Kind := Decimal_Scientific_Float;
636 when 'E' => F_Spec.Kind := Decimal_Scientific_Float_Up;
637 when 'g' => F_Spec.Kind := Shortest_Decimal_Float;
638 when 'G' => F_Spec.Kind := Shortest_Decimal_Float_Up;
639 when 'o' => F_Spec.Kind := Unsigned_Octal;
640 when 'x' => F_Spec.Kind := Unsigned_Hexadecimal_Int;
641 when 'X' => F_Spec.Kind := Unsigned_Hexadecimal_Int_Up;
642
643 when others =>
644 raise Format_Error with "unknown format specified for parameter"
645 & Positive'Image (Format.D.Current);
646 end case;
647
648 J := J + 1;
649
650 if F_Spec.Value_Needed > 0
651 and then F_Spec.Value_Needed = Format.D.Stored_Value
652 then
653 if F_Spec.Value_Needed = 1 then
654 if Width_From_Var then
655 F_Spec.Width := Format.D.Stack (1);
656 else
657 F_Spec.Precision := Format.D.Stack (1);
658 end if;
659
660 else
661 F_Spec.Width := Format.D.Stack (1);
662 F_Spec.Precision := Format.D.Stack (2);
663 end if;
664 end if;
665 end Next_Format;
666
667 ------------------
668 -- P_Flt_Format --
669 ------------------
670
671 function P_Flt_Format
672 (Format : Formatted_String;
673 Var : Flt) return Formatted_String
674 is
675 F : F_Data;
676 Buffer : String (1 .. 50);
677 S, E : Positive := 1;
678 Start : Positive;
679 Aft : Text_IO.Field;
680
681 begin
682 Next_Format (Format, F, Start);
683
684 if F.Value_Needed > 0 then
685 Raise_Wrong_Format (Format);
686 end if;
687
688 if F.Precision = Unset then
689 Aft := 6;
690 else
691 Aft := F.Precision;
692 end if;
693
694 case F.Kind is
695 when Decimal_Float =>
696
697 Put (Buffer, Var, Aft, Exp => 0);
698 S := Strings.Fixed.Index_Non_Blank (Buffer);
699 E := Buffer'Last;
700
701 when Decimal_Scientific_Float | Decimal_Scientific_Float_Up =>
702
703 Put (Buffer, Var, Aft, Exp => 3);
704 S := Strings.Fixed.Index_Non_Blank (Buffer);
705 E := Buffer'Last;
706
707 if F.Kind = Decimal_Scientific_Float then
708 Buffer (S .. E) :=
709 Characters.Handling.To_Lower (Buffer (S .. E));
710 end if;
711
712 when Shortest_Decimal_Float | Shortest_Decimal_Float_Up =>
713
714 -- Without exponent
715
716 Put (Buffer, Var, Aft, Exp => 0);
717 S := Strings.Fixed.Index_Non_Blank (Buffer);
718 E := Buffer'Last;
719
720 -- Check with exponent
721
722 declare
723 Buffer2 : String (1 .. 50);
724 S2, E2 : Positive;
725
726 begin
727 Put (Buffer2, Var, Aft, Exp => 3);
728 S2 := Strings.Fixed.Index_Non_Blank (Buffer2);
729 E2 := Buffer2'Last;
730
731 -- If with exponent it is shorter, use it
732
733 if (E2 - S2) < (E - S) then
734 Buffer := Buffer2;
735 S := S2;
736 E := E2;
737 end if;
738 end;
739
740 if F.Kind = Shortest_Decimal_Float then
741 Buffer (S .. E) :=
742 Characters.Handling.To_Lower (Buffer (S .. E));
743 end if;
744
745 when others =>
746 Raise_Wrong_Format (Format);
747 end case;
748
749 Append (Format.D.Result,
750 Get_Formatted (F, Buffer (S .. E), Buffer (S .. E)'Length));
751
752 return Format;
753 end P_Flt_Format;
754
755 ------------------
756 -- P_Int_Format --
757 ------------------
758
759 function P_Int_Format
760 (Format : Formatted_String;
761 Var : Int) return Formatted_String
762 is
763 function Handle_Precision return Boolean;
764 -- Return True if nothing else to do
765
766 F : F_Data;
767 Buffer : String (1 .. 50);
768 S, E : Positive := 1;
769 Len : Natural := 0;
770 Start : Positive;
771
772 ----------------------
773 -- Handle_Precision --
774 ----------------------
775
776 function Handle_Precision return Boolean is
777 begin
778 if F.Precision = 0 and then Sign (Var) = Zero then
779 return True;
780
781 elsif F.Precision = Natural'Last then
782 null;
783
784 elsif F.Precision > E - S + 1 then
785 Len := F.Precision - (E - S + 1);
786 Buffer (S - Len .. S - 1) := (others => '0');
787 S := S - Len;
788 end if;
789
790 return False;
791 end Handle_Precision;
792
793 -- Start of processing for P_Int_Format
794
795 begin
796 Next_Format (Format, F, Start);
797
798 if Format.D.Stored_Value < F.Value_Needed then
799 Format.D.Stored_Value := Format.D.Stored_Value + 1;
800 Format.D.Stack (Format.D.Stored_Value) := To_Integer (Var);
801 Format.D.Index := Start;
802 return Format;
803 end if;
804
805 case F.Kind is
806 when Unsigned_Octal =>
807 if Sign (Var) = Neg then
808 Raise_Wrong_Format (Format);
809 end if;
810
811 Put (Buffer, Var, Base => 8);
812 S := Strings.Fixed.Index (Buffer, "8#") + 2;
813 E := Strings.Fixed.Index (Buffer (S .. Buffer'Last), "#") - 1;
814
815 if Handle_Precision then
816 return Format;
817 end if;
818
819 case F.Base is
820 when None => null;
821 when C_Style => Len := 1;
822 when Ada_Style => Len := 3;
823 end case;
824
825 when Unsigned_Hexadecimal_Int =>
826 if Sign (Var) = Neg then
827 Raise_Wrong_Format (Format);
828 end if;
829
830 Put (Buffer, Var, Base => 16);
831 S := Strings.Fixed.Index (Buffer, "16#") + 3;
832 E := Strings.Fixed.Index (Buffer (S .. Buffer'Last), "#") - 1;
833 Buffer (S .. E) := Characters.Handling.To_Lower (Buffer (S .. E));
834
835 if Handle_Precision then
836 return Format;
837 end if;
838
839 case F.Base is
840 when None => null;
841 when C_Style => Len := 2;
842 when Ada_Style => Len := 4;
843 end case;
844
845 when Unsigned_Hexadecimal_Int_Up =>
846 if Sign (Var) = Neg then
847 Raise_Wrong_Format (Format);
848 end if;
849
850 Put (Buffer, Var, Base => 16);
851 S := Strings.Fixed.Index (Buffer, "16#") + 3;
852 E := Strings.Fixed.Index (Buffer (S .. Buffer'Last), "#") - 1;
853
854 if Handle_Precision then
855 return Format;
856 end if;
857
858 case F.Base is
859 when None => null;
860 when C_Style => Len := 2;
861 when Ada_Style => Len := 4;
862 end case;
863
864 when Unsigned_Decimal_Int =>
865 if Sign (Var) = Neg then
866 Raise_Wrong_Format (Format);
867 end if;
868
869 Put (Buffer, Var, Base => 10);
870 S := Strings.Fixed.Index_Non_Blank (Buffer);
871 E := Buffer'Last;
872
873 if Handle_Precision then
874 return Format;
875 end if;
876
877 when Decimal_Int =>
878 Put (Buffer, Var, Base => 10);
879 S := Strings.Fixed.Index_Non_Blank (Buffer);
880 E := Buffer'Last;
881
882 if Handle_Precision then
883 return Format;
884 end if;
885
886 when Char =>
887 S := Buffer'First;
888 E := Buffer'First;
889 Buffer (S) := Character'Val (To_Integer (Var));
890
891 if Handle_Precision then
892 return Format;
893 end if;
894
895 when others =>
896 Raise_Wrong_Format (Format);
897 end case;
898
899 -- Then add base if needed
900
901 declare
902 N : String := Get_Formatted (F, Buffer (S .. E), E - S + 1 + Len);
903 P : constant Positive :=
904 (if F.Left_Justify
905 then N'First
906 else Natural'Max (Strings.Fixed.Index_Non_Blank (N) - 1,
907 N'First));
908 begin
909 case F.Base is
910 when None =>
911 null;
912
913 when C_Style =>
914 case F.Kind is
915 when Unsigned_Octal =>
916 N (P) := 'O';
917
918 when Unsigned_Hexadecimal_Int =>
919 if F.Left_Justify then
920 N (P .. P + 1) := "Ox";
921 else
922 N (P - 1 .. P) := "0x";
923 end if;
924
925 when Unsigned_Hexadecimal_Int_Up =>
926 if F.Left_Justify then
927 N (P .. P + 1) := "OX";
928 else
929 N (P - 1 .. P) := "0X";
930 end if;
931
932 when others =>
933 null;
934 end case;
935
936 when Ada_Style =>
937 case F.Kind is
938 when Unsigned_Octal =>
939 if F.Left_Justify then
940 N (N'First + 2 .. N'Last) := N (N'First .. N'Last - 2);
941 else
942 N (P .. N'Last - 1) := N (P + 1 .. N'Last);
943 end if;
944
945 N (N'First .. N'First + 1) := "8#";
946 N (N'Last) := '#';
947
948 when Unsigned_Hexadecimal_Int |
949 Unsigned_Hexadecimal_Int_Up =>
950 if F.Left_Justify then
951 N (N'First + 3 .. N'Last) := N (N'First .. N'Last - 3);
952 else
953 N (P .. N'Last - 1) := N (P + 1 .. N'Last);
954 end if;
955
956 N (N'First .. N'First + 2) := "16#";
957 N (N'Last) := '#';
958
959 when others =>
960 null;
961 end case;
962 end case;
963
964 Append (Format.D.Result, N);
965 end;
966
967 return Format;
968 end P_Int_Format;
969
970 ------------------------
971 -- Raise_Wrong_Format --
972 ------------------------
973
974 procedure Raise_Wrong_Format (Format : Formatted_String) is
975 begin
976 raise Format_Error with
977 "wrong format specified for parameter"
978 & Positive'Image (Format.D.Current);
979 end Raise_Wrong_Format;
980
981 end GNAT.Formatted_String;