1-- C354003.A
2--
3--                             Grant of Unlimited Rights
4--
5--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7--     unlimited rights in the software and documentation contained herein.
8--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
9--     this public release, the Government intends to confer upon all
10--     recipients unlimited rights  equal to those held by the Government.
11--     These rights include rights to use, duplicate, release or disclose the
12--     released technical data and computer software in whole or in part, in
13--     any manner and for any purpose whatsoever, and to have or permit others
14--     to do so.
15--
16--                                    DISCLAIMER
17--
18--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23--     PARTICULAR PURPOSE OF SAID MATERIAL.
24--*
25--
26-- OBJECTIVE:
27--      Check that the Wide_String attributes of modular types yield
28--      correct values/results.  The attributes checked are:
29--
30--      Wide_Image
31--      Wide_Value
32--
33-- TEST DESCRIPTION:
34--      This test is split from C354002.  It tests only the attributes:
35--
36--      Wide_Image, Wide_Value
37--
38--      This test defines several modular types.  One type defined at
39--      each of System.Max_Binary_Modulus, System.Max_Nonbinary_Modulus,
40--      a power of two half that of System.Max_Binary_Modulus, one less
41--      than that power of two; one more than that power of two, two
42--      less than a (large) power of two.  For each of these types,
43--      determine the correct operation of the Wide_String attributes.
44--
45--
46-- CHANGE HISTORY:
47--      13 DEC 94   SAIC    Initial version
48--      06 JAN 94   SAIC    Promoted to future release
49--      19 APR 95   SAIC    Revised in accord with reviewer comments
50--      01 DEC 95   SAIC    Corrected for 2.0.1
51--      27 JAN 96   SAIC    Eliminated potential 32/64 bit conflict for 2.1
52--      24 FEB 97   PWB.CTA Corrected out-of-range value
53--!
54
55with Report;
56with System;
57with TCTouch;
58with Ada.Characters.Handling;
59procedure C354003 is
60
61  function ID(Local_Value: Integer) return Integer renames Report.Ident_Int;
62  function ID(Local_Value: String)  return String renames  Report.Ident_Str;
63
64  function ID(Local_Value: String) return Wide_String is
65  begin
66    return Ada.Characters.Handling.To_Wide_String( ID( Local_Value ) );
67  end ID;
68
69  Half_Max_Binary_Value : constant := System.Max_Binary_Modulus / 2;
70
71  type Max_Binary      is mod System.Max_Binary_Modulus;
72  type Max_NonBinary   is mod System.Max_Nonbinary_Modulus;
73  type Half_Max_Binary is mod Half_Max_Binary_Value;
74
75  type Medium          is mod 2048;
76  type Medium_Plus     is mod 2042;
77  type Medium_Minus    is mod 2111;
78
79  type Small  is mod 2;
80  type Finger is mod 5;
81
82  type Finger_Id is (Thumb, Index, Middle, Ring, Pinkie);
83
84  subtype Midrange is Medium_Minus range 222 .. 1111;
85
86  AMB,   BMB   : Max_Binary;
87  AHMB,  BHMB  : Half_Max_Binary;
88  AM,    BM    : Medium;
89  AMP,   BMP   : Medium_Plus;
90  AMM,   BMM   : Medium_Minus;
91  AS,    BS    : Small;
92  AF,    BF    : Finger;
93
94  procedure Wide_Value_Fault( S: Wide_String ) is
95  -- check 'Wide_Value for failure modes
96  begin
97    -- the evaluation of the 'Wide_Value expression should raise C_E
98    TCTouch.Assert_Not( Midrange'Wide_Value(S) = 0, "Wide_Value_Fault" );
99    if Midrange'Wide_Value(S) not in Midrange'Base then
100      Report.Failed("'Wide_Value  raised no exception");
101    end if;
102  exception
103    when Constraint_Error => null; -- expected case
104    when others =>
105         Report.Failed("'Wide_Value raised wrong exception");
106  end Wide_Value_Fault;
107
108
109  The_Cap, The_Toe : Natural;
110
111  procedure Check_Non_Static_Cases( Lower_Bound,Upper_Bound : Medium ) is
112    subtype Non_Static is Medium range Lower_Bound..Upper_Bound;
113  begin
114  -- First, Last, Range, Min, Max, Succ, Pred, Pos, and Val
115
116    TCTouch.Assert( Non_Static'First = Medium(The_Toe), "Non_Static'First" );
117    TCTouch.Assert( Non_Static'Last = Non_Static(The_Cap),
118                    "Non_Static'Last" );
119    TCTouch.Assert( Non_Static(The_Cap/2) in Non_Static'Range,
120                    "Non_Static'Range" );
121    TCTouch.Assert( Non_Static'Min(Medium(Report.Ident_Int(100)),
122                                   Medium(Report.Ident_Int(200))) = 100,
123                    "Non_Static'Min" );
124    TCTouch.Assert( Non_Static'Max(Medium(Report.Ident_Int(100)),
125                                   Medium(Report.Ident_Int(200))) = 200,
126                    "Non_Static'Max" );
127    TCTouch.Assert( Non_Static'Succ(Non_Static(The_Cap))
128                    = Medium'Succ(Upper_Bound),
129                    "Non_Static'Succ" );
130    TCTouch.Assert( Non_Static'Pred(Medium(Report.Ident_Int(The_Cap)))
131                    = Non_Static(Report.Ident_Int(The_Cap-1)),
132                    "Non_Static'Pred" );
133    TCTouch.Assert( Non_Static'Pos(Upper_Bound) = Non_Static(The_Cap),
134                    "Non_Static'Pos" );
135    TCTouch.Assert( Non_Static'Val(Non_Static(The_Cap)) = Upper_Bound,
136                    "Non_Static'Val" );
137
138  end Check_Non_Static_Cases;
139
140
141begin  -- Main test procedure.
142
143  Report.Test ("C354003", "Check Wide_String attributes of modular types" );
144
145  Wide_Strings_Needed: declare
146
147    Max_Bin_Mod_Div_3 : constant := Max_Binary'Modulus/3;
148    Max_Non_Mod_Div_4 : constant := Max_NonBinary'Modulus/4;
149
150  begin
151
152-- Wide_Image
153
154    TCTouch.Assert( Half_Max_Binary'Wide_Image(255) = " 255",
155                   "Half_Max_Binary'Wide_Image" );
156
157    TCTouch.Assert( Medium'Wide_Image(0) = " 0",  "Medium'Wide_Image" );
158
159    TCTouch.Assert( Medium_Plus'Wide_Image(Medium_Plus'Last) = " 2041",
160                   "Medium_Plus'Wide_Image" );
161
162    TCTouch.Assert( Medium_Minus'Wide_Image(Medium_Minus(ID(1024))) = " 1024",
163                   "Medium_Minus'Wide_Image" );
164
165    TCTouch.Assert( Small'Wide_Image(1) = " 1",   "Small'Wide_Image" );
166
167    TCTouch.Assert( Midrange'Wide_Image(Midrange(ID(333))) = " 333",
168                   "Midrange'Wide_Image" );
169
170-- Wide_Value
171
172    TCTouch.Assert( Half_Max_Binary'Wide_Value("255") = 255,
173                   "Half_Max_Binary'Wide_Value" );
174
175    TCTouch.Assert( Medium'Wide_Value(" 0 ")  = 0,   "Medium'Wide_Value" );
176
177    TCTouch.Assert( Medium_Plus'Wide_Value(ID("2041")) = Medium_Plus'Last,
178                   "Medium_Plus'Wide_Value" );
179
180    TCTouch.Assert( Medium_Minus'Wide_Value("+1_4 ") = 14,
181                   "Medium_Minus'Wide_Value" );
182
183    TCTouch.Assert( Small'Wide_Value("+1") = 1,      "Small'Wide_Value" );
184
185    TCTouch.Assert( Midrange'Wide_Value(ID("333")) = 333,
186                   "Midrange'Wide_Value" );
187
188    TCTouch.Assert( Midrange'Wide_Value(ID("1E3")) = 1000,
189                   "Midrange'Wide_Value(""1E3"")" );
190
191    Wide_Value_Fault( "bad input" );
192    Wide_Value_Fault( "-333" );
193    Wide_Value_Fault( "9999" );
194    Wide_Value_Fault( ".1" );
195    Wide_Value_Fault( "1e-1" );
196
197  end Wide_Strings_Needed;
198
199  The_Toe := Report.Ident_Int(25);
200  The_Cap := Report.Ident_Int(256);
201  Check_Non_Static_Cases( Medium(Report.Ident_Int(The_Toe)),
202                          Medium(Report.Ident_Int(The_Cap)) );
203
204  The_Toe := Report.Ident_Int(40);
205  The_Cap := Report.Ident_Int(2047);
206  Check_Non_Static_Cases( Medium(Report.Ident_Int(The_Toe)),
207                          Medium(Report.Ident_Int(The_Cap)) );
208
209  Report.Result;
210
211end C354003;
212