1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . W I D E _ W I D E _ T E X T _ I O . C O M P L E X _ A U X --
9 -- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada.Wide_Wide_Text_IO.Generic_Aux; use Ada.Wide_Wide_Text_IO.Generic_Aux;
33 with Ada.Wide_Wide_Text_IO.Float_Aux;
35 with System.Img_Real; use System.Img_Real;
37 package body Ada.Wide_Wide_Text_IO.Complex_Aux is
39 package Aux renames Ada.Wide_Wide_Text_IO.Float_Aux;
47 ItemR : out Long_Long_Float;
48 ItemI : out Long_Long_Float;
51 Buf : String (1 .. Field'Last);
53 Ptr : aliased Integer;
54 Paren : Boolean := False;
57 -- General note for following code, exceptions from the calls
58 -- to Get for components of the complex value are propagated.
61 Load_Width (File, Width, Buf, Stop);
62 Gets (Buf (1 .. Stop), ItemR, ItemI, Ptr);
64 for J in Ptr + 1 .. Stop loop
65 if not Is_Blank (Buf (J)) then
75 Load (File, Buf, Ptr, '(', Paren);
76 Aux.Get (File, ItemR, 0);
78 Load (File, Buf, Ptr, ',');
79 Aux.Get (File, ItemI, 0);
83 Load (File, Buf, Ptr, ')', Paren);
98 ItemR : out Long_Long_Float;
99 ItemI : out Long_Long_Float;
106 String_Skip (From, Pos);
108 if From (Pos) = '(' then
115 Aux.Gets (From (Pos .. From'Last), ItemR, Pos);
117 String_Skip (From (Pos + 1 .. From'Last), Pos);
119 if From (Pos) = ',' then
123 Aux.Gets (From (Pos .. From'Last), ItemI, Pos);
126 String_Skip (From (Pos + 1 .. From'Last), Pos);
128 if From (Pos) /= ')' then
142 ItemR : Long_Long_Float;
143 ItemI : Long_Long_Float;
150 Aux.Put (File, ItemR, Fore, Aft, Exp);
152 Aux.Put (File, ItemI, Fore, Aft, Exp);
162 ItemR : Long_Long_Float;
163 ItemI : Long_Long_Float;
167 I_String : String (1 .. 3 * Field'Last);
168 R_String : String (1 .. 3 * Field'Last);
174 -- Both parts are initially converted with a Fore of 0
177 Set_Image_Real (ItemR, R_String, Rptr, 0, Aft, Exp);
179 Set_Image_Real (ItemI, I_String, Iptr, 0, Aft, Exp);
181 -- Check room for both parts plus parens plus comma (RM G.1.3(34))
183 if Rptr + Iptr + 3 > To'Length then
187 -- If there is room, layout result according to (RM G.1.3(31-33))
189 To (To'First) := '(';
190 To (To'First + 1 .. To'First + Rptr) := R_String (1 .. Rptr);
191 To (To'First + Rptr + 1) := ',';
195 To (To'Last - Iptr .. To'Last - 1) := I_String (1 .. Iptr);
197 for J in To'First + Rptr + 2 .. To'Last - Iptr - 1 loop
202 end Ada.Wide_Wide_Text_IO.Complex_Aux;