OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c455001.a] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- 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
 
37
with Report; use Report;
38
 
39
procedure 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
 
67
begin
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
 
164
end C455001;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.