1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . W I D E _ W I D E _ T E X T _ I O . I N T E G E R _ A U X -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2020, 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.Wide_Wide_Text_IO.Generic_Aux; use Ada.Wide_Wide_Text_IO.Generic_Aux; 33 34package body Ada.Wide_Wide_Text_IO.Integer_Aux is 35 36 --------- 37 -- Get -- 38 --------- 39 40 procedure Get 41 (File : File_Type; 42 Item : out Num; 43 Width : Field) 44 is 45 Buf : String (1 .. Field'Last); 46 Ptr : aliased Integer := 1; 47 Stop : Integer := 0; 48 49 begin 50 if Width /= 0 then 51 Load_Width (File, Width, Buf, Stop); 52 String_Skip (Buf, Ptr); 53 else 54 Load_Integer (File, Buf, Stop); 55 end if; 56 57 Item := Scan (Buf, Ptr'Access, Stop); 58 Check_End_Of_Field (Buf, Stop, Ptr, Width); 59 end Get; 60 61 ---------- 62 -- Gets -- 63 ---------- 64 65 procedure Gets 66 (From : String; 67 Item : out Num; 68 Last : out Positive) 69 is 70 Pos : aliased Integer; 71 72 begin 73 String_Skip (From, Pos); 74 Item := Scan (From, Pos'Access, From'Last); 75 Last := Pos - 1; 76 77 exception 78 when Constraint_Error => 79 raise Data_Error; 80 end Gets; 81 82 --------- 83 -- Put -- 84 --------- 85 86 procedure Put 87 (File : File_Type; 88 Item : Num; 89 Width : Field; 90 Base : Number_Base) 91 is 92 Buf : String (1 .. Integer'Max (Field'Last, Width)); 93 Ptr : Natural := 0; 94 95 begin 96 if Base = 10 and then Width = 0 then 97 Set_Image (Item, Buf, Ptr); 98 elsif Base = 10 then 99 Set_Image_Width (Item, Width, Buf, Ptr); 100 else 101 Set_Image_Based (Item, Base, Width, Buf, Ptr); 102 end if; 103 104 Put_Item (File, Buf (1 .. Ptr)); 105 end Put; 106 107 ---------- 108 -- Puts -- 109 ---------- 110 111 procedure Puts 112 (To : out String; 113 Item : Num; 114 Base : Number_Base) 115 is 116 Buf : String (1 .. Integer'Max (Field'Last, To'Length)); 117 Ptr : Natural := 0; 118 119 begin 120 if Base = 10 then 121 Set_Image_Width (Item, To'Length, Buf, Ptr); 122 else 123 Set_Image_Based (Item, Base, To'Length, Buf, Ptr); 124 end if; 125 126 if Ptr > To'Length then 127 raise Layout_Error; 128 else 129 To (To'First .. To'First + Ptr - 1) := Buf (1 .. Ptr); 130 end if; 131 end Puts; 132 133end Ada.Wide_Wide_Text_IO.Integer_Aux; 134