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-2019, 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-- 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. -- 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 32with Ada.Characters.Handling; 33with Ada.Float_Text_IO; 34with Ada.Integer_Text_IO; 35with Ada.Long_Float_Text_IO; 36with Ada.Long_Integer_Text_IO; 37with Ada.Strings.Fixed; 38with Ada.Unchecked_Deallocation; 39 40with System.Address_Image; 41 42package 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, 1, 134 Null_Unbounded_String, 0, 0, (0, 0), Format)); 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 702 | Decimal_Scientific_Float_Up 703 => 704 Put (Buffer, Var, Aft, Exp => 3); 705 S := Strings.Fixed.Index_Non_Blank (Buffer); 706 E := Buffer'Last; 707 708 if F.Kind = Decimal_Scientific_Float then 709 Buffer (S .. E) := 710 Characters.Handling.To_Lower (Buffer (S .. E)); 711 end if; 712 713 when Shortest_Decimal_Float 714 | Shortest_Decimal_Float_Up 715 => 716 -- Without exponent 717 718 Put (Buffer, Var, Aft, Exp => 0); 719 S := Strings.Fixed.Index_Non_Blank (Buffer); 720 E := Buffer'Last; 721 722 -- Check with exponent 723 724 declare 725 Buffer2 : String (1 .. 50); 726 S2, E2 : Positive; 727 728 begin 729 Put (Buffer2, Var, Aft, Exp => 3); 730 S2 := Strings.Fixed.Index_Non_Blank (Buffer2); 731 E2 := Buffer2'Last; 732 733 -- If with exponent it is shorter, use it 734 735 if (E2 - S2) < (E - S) then 736 Buffer := Buffer2; 737 S := S2; 738 E := E2; 739 end if; 740 end; 741 742 if F.Kind = Shortest_Decimal_Float then 743 Buffer (S .. E) := 744 Characters.Handling.To_Lower (Buffer (S .. E)); 745 end if; 746 747 when others => 748 Raise_Wrong_Format (Format); 749 end case; 750 751 Append (Format.D.Result, 752 Get_Formatted (F, Buffer (S .. E), Buffer (S .. E)'Length)); 753 754 return Format; 755 end P_Flt_Format; 756 757 ------------------ 758 -- P_Int_Format -- 759 ------------------ 760 761 function P_Int_Format 762 (Format : Formatted_String; 763 Var : Int) return Formatted_String 764 is 765 function Handle_Precision return Boolean; 766 -- Return True if nothing else to do 767 768 F : F_Data; 769 Buffer : String (1 .. 50); 770 S, E : Positive := 1; 771 Len : Natural := 0; 772 Start : Positive; 773 774 ---------------------- 775 -- Handle_Precision -- 776 ---------------------- 777 778 function Handle_Precision return Boolean is 779 begin 780 if F.Precision = 0 and then Sign (Var) = Zero then 781 return True; 782 783 elsif F.Precision = Natural'Last then 784 null; 785 786 elsif F.Precision > E - S + 1 then 787 Len := F.Precision - (E - S + 1); 788 Buffer (S - Len .. S - 1) := (others => '0'); 789 S := S - Len; 790 end if; 791 792 return False; 793 end Handle_Precision; 794 795 -- Start of processing for P_Int_Format 796 797 begin 798 Next_Format (Format, F, Start); 799 800 if Format.D.Stored_Value < F.Value_Needed then 801 Format.D.Stored_Value := Format.D.Stored_Value + 1; 802 Format.D.Stack (Format.D.Stored_Value) := To_Integer (Var); 803 Format.D.Index := Start; 804 return Format; 805 end if; 806 807 case F.Kind is 808 when Unsigned_Octal => 809 if Sign (Var) = Neg then 810 Raise_Wrong_Format (Format); 811 end if; 812 813 Put (Buffer, Var, Base => 8); 814 S := Strings.Fixed.Index (Buffer, "8#") + 2; 815 E := Strings.Fixed.Index (Buffer (S .. Buffer'Last), "#") - 1; 816 817 if Handle_Precision then 818 return Format; 819 end if; 820 821 case F.Base is 822 when None => null; 823 when C_Style => Len := 1; 824 when Ada_Style => Len := 3; 825 end case; 826 827 when Unsigned_Hexadecimal_Int => 828 if Sign (Var) = Neg then 829 Raise_Wrong_Format (Format); 830 end if; 831 832 Put (Buffer, Var, Base => 16); 833 S := Strings.Fixed.Index (Buffer, "16#") + 3; 834 E := Strings.Fixed.Index (Buffer (S .. Buffer'Last), "#") - 1; 835 Buffer (S .. E) := Characters.Handling.To_Lower (Buffer (S .. E)); 836 837 if Handle_Precision then 838 return Format; 839 end if; 840 841 case F.Base is 842 when None => null; 843 when C_Style => Len := 2; 844 when Ada_Style => Len := 4; 845 end case; 846 847 when Unsigned_Hexadecimal_Int_Up => 848 if Sign (Var) = Neg then 849 Raise_Wrong_Format (Format); 850 end if; 851 852 Put (Buffer, Var, Base => 16); 853 S := Strings.Fixed.Index (Buffer, "16#") + 3; 854 E := Strings.Fixed.Index (Buffer (S .. Buffer'Last), "#") - 1; 855 856 if Handle_Precision then 857 return Format; 858 end if; 859 860 case F.Base is 861 when None => null; 862 when C_Style => Len := 2; 863 when Ada_Style => Len := 4; 864 end case; 865 866 when Unsigned_Decimal_Int => 867 if Sign (Var) = Neg then 868 Raise_Wrong_Format (Format); 869 end if; 870 871 Put (Buffer, Var, Base => 10); 872 S := Strings.Fixed.Index_Non_Blank (Buffer); 873 E := Buffer'Last; 874 875 if Handle_Precision then 876 return Format; 877 end if; 878 879 when Decimal_Int => 880 Put (Buffer, Var, Base => 10); 881 S := Strings.Fixed.Index_Non_Blank (Buffer); 882 E := Buffer'Last; 883 884 if Handle_Precision then 885 return Format; 886 end if; 887 888 when Char => 889 S := Buffer'First; 890 E := Buffer'First; 891 Buffer (S) := Character'Val (To_Integer (Var)); 892 893 if Handle_Precision then 894 return Format; 895 end if; 896 897 when others => 898 Raise_Wrong_Format (Format); 899 end case; 900 901 -- Then add base if needed 902 903 declare 904 N : String := Get_Formatted (F, Buffer (S .. E), E - S + 1 + Len); 905 P : constant Positive := 906 (if F.Left_Justify 907 then N'First 908 else Natural'Max (Strings.Fixed.Index_Non_Blank (N) - 1, 909 N'First)); 910 begin 911 case F.Base is 912 when None => 913 null; 914 915 when C_Style => 916 case F.Kind is 917 when Unsigned_Octal => 918 N (P) := 'O'; 919 920 when Unsigned_Hexadecimal_Int => 921 if F.Left_Justify then 922 N (P .. P + 1) := "Ox"; 923 else 924 N (P - 1 .. P) := "0x"; 925 end if; 926 927 when Unsigned_Hexadecimal_Int_Up => 928 if F.Left_Justify then 929 N (P .. P + 1) := "OX"; 930 else 931 N (P - 1 .. P) := "0X"; 932 end if; 933 934 when others => 935 null; 936 end case; 937 938 when Ada_Style => 939 case F.Kind is 940 when Unsigned_Octal => 941 if F.Left_Justify then 942 N (N'First + 2 .. N'Last) := N (N'First .. N'Last - 2); 943 else 944 N (P .. N'Last - 1) := N (P + 1 .. N'Last); 945 end if; 946 947 N (N'First .. N'First + 1) := "8#"; 948 N (N'Last) := '#'; 949 950 when Unsigned_Hexadecimal_Int 951 | Unsigned_Hexadecimal_Int_Up 952 => 953 if F.Left_Justify then 954 N (N'First + 3 .. N'Last) := N (N'First .. N'Last - 3); 955 else 956 N (P .. N'Last - 1) := N (P + 1 .. N'Last); 957 end if; 958 959 N (N'First .. N'First + 2) := "16#"; 960 N (N'Last) := '#'; 961 962 when others => 963 null; 964 end case; 965 end case; 966 967 Append (Format.D.Result, N); 968 end; 969 970 return Format; 971 end P_Int_Format; 972 973 ------------------------ 974 -- Raise_Wrong_Format -- 975 ------------------------ 976 977 procedure Raise_Wrong_Format (Format : Formatted_String) is 978 begin 979 raise Format_Error with 980 "wrong format specified for parameter" 981 & Positive'Image (Format.D.Current); 982 end Raise_Wrong_Format; 983 984end GNAT.Formatted_String; 985