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-- 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, 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 981end GNAT.Formatted_String; 982