1-- C455001.A
2
3--                             Grant of Unlimited Rights
4--
5--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
6--     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
7--     software and documentation contained herein.  Unlimited rights are
8--     defined in DFAR 252.227-7013(a)(19).  By making this public release,
9--     the Government intends to confer upon all recipients unlimited rights
10--     equal to those held by the Government.  These rights include rights to
11--     use, duplicate, release or disclose the released technical data and
12--     computer software in whole or in part, in any manner and for any purpose
13--     whatsoever, and to have or permit others to do so.
14--
15--                                    DISCLAIMER
16--
17--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
18--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
19--     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
20--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
21--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
22--     PARTICULAR PURPOSE OF SAID MATERIAL.
23--*
24--
25-- OBJECTIVE:
26--     Check that universal fixed multiplying operators can be used without
27--     a conversion in contexts where the result type is determined.
28--
29--     Note: This is intended to check the changes made to these operators
30--     in Ada 95; legacy tests should cover cases from Ada 83.
31--
32-- CHANGE HISTORY:
33--      18 MAR 99   RLB    Initial version
34--
35--!
36
37with Report; use Report;
38
39procedure C455001 is
40
41     type F1 is delta 2.0**(-1) range 0.0 .. 8.0;
42
43     type F2 is delta 2.0**(-2) range 0.0 .. 4.0;
44
45     type F3 is delta 2.0**(-3) range 0.0 .. 2.0;
46
47     A : F1;
48     B : F2;
49     C : F3;
50
51     type Fixed_Record is record
52	D : F1;
53        E : F2;
54     end record;
55
56     R : Fixed_Record;
57
58     function Ident_Fix (X : F3) return F3 is
59     begin
60          if Equal(3,3) then
61               return X;
62          else
63               return 0.0;
64          end if;
65     end Ident_Fix;
66
67begin
68     Test ("C455001", "Check that universal fixed multiplying operators " &
69                      "can be used without a conversion in contexts where " &
70                      "the result type is determined.");
71
72     A := 1.0; B := 1.0;
73     C := A * B; -- Assignment context.
74
75     if C /= Ident_Fix(1.0) then
76          Failed ("Incorrect results for multiplication (1) - result is " &
77		  F3'Image(C));
78     end if;
79
80     C := A / B;
81
82     if C /= Ident_Fix(1.0) then
83          Failed ("Incorrect results for division (1) - result is " &
84		  F3'Image(C));
85     end if;
86
87     A := 2.5;
88     C := A * 0.25;
89
90     if C /= Ident_Fix(0.625) then
91          Failed ("Incorrect results for multiplication (2) - result is " &
92		  F3'Image(C));
93     end if;
94
95     C := A / 4.0;
96
97     if C /= Ident_Fix(0.625) then
98          Failed ("Incorrect results for division (2) - result is " &
99		  F3'Image(C));
100     end if;
101
102     C := Ident_Fix(0.75);
103     C := C * 0.5;
104
105     if C /= Ident_Fix(0.375) then
106          Failed ("Incorrect results for multiplication (3) - result is " &
107		  F3'Image(C));
108     end if;
109
110     C := Ident_Fix(0.75);
111     C := C / 0.5;
112
113     if C /= Ident_Fix(1.5) then
114          Failed ("Incorrect results for division (3) - result is " &
115		  F3'Image(C));
116     end if;
117
118     A := 0.5; B := 0.3; -- Function parameter context.
119     if Ident_Fix(A * B) not in Ident_Fix(0.125) .. Ident_Fix(0.25) then
120          Failed ("Incorrect results for multiplication (4) - result is " &
121		  F3'Image(A * B)); -- Exact = 0.15
122     end if;
123
124     B := 0.8;
125     if Ident_Fix(A / B) not in Ident_Fix(0.5) .. Ident_Fix(0.75) then
126          Failed ("Incorrect results for division (4) - result is " &
127		  F3'Image(A / B));
128		-- Exact = 0.625..., but B is only restricted to the range
129		-- 0.75 .. 1.0, so the result can be anywhere in the range
130		-- 0.5 .. 0.75.
131     end if;
132
133     C := 0.875; B := 1.5;
134     R := (D => C * 4.0, E => B / 0.5); -- Aggregate context.
135
136     if R.D /= 3.5 then
137          Failed ("Incorrect results for multiplication (5) - result is " &
138		  F1'Image(R.D));
139     end if;
140
141     if R.E /= 3.0 then
142          Failed ("Incorrect results for division (5) - result is " &
143		  F2'Image(R.E));
144     end if;
145
146     A := 0.5;
147     C := A * F1'(B * 2.0); -- Qualified expression context.
148
149     if C /= Ident_Fix(1.5) then
150          Failed ("Incorrect results for multiplication (6) - result is " &
151		  F3'Image(C));
152     end if;
153
154     A := 4.0;
155     C := F1'(B / 0.5) / A;
156
157     if C /= Ident_Fix(0.75) then
158          Failed ("Incorrect results for division (6) - result is " &
159		  F3'Image(C));
160     end if;
161
162     Result;
163
164end C455001;
165