1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT RUN-TIME COMPONENTS                         --
4--                                                                          --
5--           A D A . W I D E _ T E X T _ IO . C O M P L E X _ I O           --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 1992-2009, 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_Text_IO.Complex_Aux;
33
34with System.WCh_Con; use System.WCh_Con;
35with System.WCh_WtS; use System.WCh_WtS;
36
37with Ada.Unchecked_Conversion;
38
39package body Ada.Wide_Text_IO.Complex_IO is
40
41   package Aux renames Ada.Wide_Text_IO.Complex_Aux;
42
43   subtype LLF is Long_Long_Float;
44   --  Type used for calls to routines in Aux
45
46   function TFT is new
47     Ada.Unchecked_Conversion (File_Type, Ada.Wide_Text_IO.File_Type);
48   --  This unchecked conversion is to get around a visibility bug in
49   --  GNAT version 2.04w. It should be possible to simply use the
50   --  subtype declared above and do normal checked conversions.
51
52   ---------
53   -- Get --
54   ---------
55
56   procedure Get
57     (File  : File_Type;
58      Item  : out Complex;
59      Width : Field := 0)
60   is
61      Real_Item : Real'Base;
62      Imag_Item : Real'Base;
63
64   begin
65      Aux.Get (TFT (File), LLF (Real_Item), LLF (Imag_Item), Width);
66      Item := (Real_Item, Imag_Item);
67
68   exception
69      when Constraint_Error => raise Data_Error;
70   end Get;
71
72   ---------
73   -- Get --
74   ---------
75
76   procedure Get
77     (Item  : out Complex;
78      Width : Field := 0)
79   is
80   begin
81      Get (Current_Input, Item, Width);
82   end Get;
83
84   ---------
85   -- Get --
86   ---------
87
88   procedure Get
89     (From : Wide_String;
90      Item : out Complex;
91      Last : out Positive)
92   is
93      Real_Item : Real'Base;
94      Imag_Item : Real'Base;
95
96      S : constant String := Wide_String_To_String (From, WCEM_Upper);
97      --  String on which we do the actual conversion. Note that the method
98      --  used for wide character encoding is irrelevant, since if there is
99      --  a character outside the Standard.Character range then the call to
100      --  Aux.Gets will raise Data_Error in any case.
101
102   begin
103      Aux.Gets (S, LLF (Real_Item), LLF (Imag_Item), Last);
104      Item := (Real_Item, Imag_Item);
105
106   exception
107      when Data_Error => raise Constraint_Error;
108   end Get;
109
110   ---------
111   -- Put --
112   ---------
113
114   procedure Put
115     (File : File_Type;
116      Item : Complex;
117      Fore : Field := Default_Fore;
118      Aft  : Field := Default_Aft;
119      Exp  : Field := Default_Exp)
120   is
121   begin
122      Aux.Put (TFT (File), LLF (Re (Item)), LLF (Im (Item)), Fore, Aft, Exp);
123   end Put;
124
125   ---------
126   -- Put --
127   ---------
128
129   procedure Put
130     (Item : Complex;
131      Fore : Field := Default_Fore;
132      Aft  : Field := Default_Aft;
133      Exp  : Field := Default_Exp)
134   is
135   begin
136      Put (Current_Output, Item, Fore, Aft, Exp);
137   end Put;
138
139   ---------
140   -- Put --
141   ---------
142
143   procedure Put
144     (To   : out Wide_String;
145      Item : Complex;
146      Aft  : Field := Default_Aft;
147      Exp  : Field := Default_Exp)
148   is
149      S : String (To'First .. To'Last);
150
151   begin
152      Aux.Puts (S, LLF (Re (Item)), LLF (Im (Item)), Aft, Exp);
153
154      for J in S'Range loop
155         To (J) := Wide_Character'Val (Character'Pos (S (J)));
156      end loop;
157   end Put;
158
159end Ada.Wide_Text_IO.Complex_IO;
160