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

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c45322a.ada] - Blame information for rev 12

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 12 jlechner
-- C45322A.ADA
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
-- OBJECTIVE:
26
--     CHECK THAT CONSTRAINT_ERROR IS RAISED IF 
27
--     MACHINE_OVERFLOWS IS TRUE AND THE RESULT OF THE ADDITION OR 
28
--     SUBTRACTION LIES OUTSIDE OF THE RANGE OF THE BASE TYPE.
29
 
30
-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
31
-- ***       remove incompatibilities associated with the transition   -- 9X
32
-- ***       to Ada 9X.                                                -- 9X
33
 
34
-- HISTORY:
35
--     NPL 09/01/90  CREATED ORIGINAL TEST.
36
--     LDC 10/09/90  CHANGED THE STYLE OF THE TEST TO THE STANDARD
37
--                   ACVC FORMAT AND WRAPPED LINES WHICH WHERE LONGER
38
--                   THAN 71 CHARACTERS.
39
--     JRL 03/30/93  REMOVED NUMERIC_ERROR FROM TEST.
40
 
41
WITH REPORT; USE REPORT;
42
 
43
PROCEDURE C45322A IS
44
 
45
  TYPE FLOAT5 IS DIGITS 5;
46
  F5 : FLOAT5;
47
 
48
  FUNCTION IDENT (F : FLOAT5) RETURN FLOAT5 IS
49
  BEGIN
50
    RETURN F * FLOAT5(IDENT_INT(1));
51
  END IDENT;
52
 
53
  FUNCTION EQUAL (F,G : FLOAT5) RETURN BOOLEAN IS
54
  BEGIN
55
    RETURN F = G + FLOAT5(IDENT_INT(0));
56
  END EQUAL;
57
 
58
BEGIN
59
     TEST ("C45322A", "CHECK THAT CONSTRAINT_ERROR " &
60
                      "IS RAISED IF MACHINE_OVERFLOWS IS TRUE AND " &
61
                      "THE RESULT OF THE ADDITION OR SUBTRACTION " &
62
                      "LIES OUTSIDE OF THE RANGE OF THE BASE TYPE");
63
 
64
     IF NOT FLOAT5'MACHINE_OVERFLOWS THEN
65
          NOT_APPLICABLE("MACHINE_OVERFLOWS IS FALSE");
66
     ELSE
67
 
68
          BEGIN
69
               F5 := IDENT(FLOAT5'BASE'LAST) + FLOAT5'BASE'LAST;
70
 
71
               FAILED("NO EXCEPTION RAISED BY LARGE '+'");
72
 
73
               IF NOT EQUAL(F5, F5) THEN
74
                    COMMENT("DON'T OPTIMIZE F5");
75
               END IF;
76
          EXCEPTION
77
               WHEN CONSTRAINT_ERROR =>
78
                    NULL;
79
               WHEN OTHERS =>
80
                    FAILED("UNEXPECTED EXCEPTION RAISED BY LARGE '+'");
81
          END;
82
 
83
          -- AS ABOVE BUT INTERCHANGING '+' AND '-'
84
          BEGIN
85
               F5 := IDENT(FLOAT5'BASE'LAST) - FLOAT5'BASE'LAST;
86
 
87
               IF NOT EQUAL(F5, F5) THEN
88
                    COMMENT("DON'T OPTIMIZE F5");
89
               END IF;
90
          EXCEPTION
91
               WHEN CONSTRAINT_ERROR =>
92
                    FAILED("CONSTRAINT_ERROR " &
93
                           "RAISED BY INTERCHANGING LARGE '+'");
94
               WHEN OTHERS =>
95
                    FAILED("UNEXPECTED EXCEPTION RAISED BY " &
96
                           "INTERCHANGING LARGE '+'");
97
          END;
98
 
99
          BEGIN
100
               F5 := IDENT(FLOAT5'BASE'FIRST) + FLOAT5'BASE'FIRST;
101
 
102
               FAILED("NO EXCEPTION RAISED BY SMALL '+'");
103
 
104
               IF NOT EQUAL(F5, F5) THEN
105
                    COMMENT("DON'T OPTIMIZE F5");
106
               END IF;
107
          EXCEPTION
108
               WHEN CONSTRAINT_ERROR =>
109
                    NULL;
110
               WHEN OTHERS =>
111
                    FAILED("UNEXPECTED EXCEPTION RAISED BY SMALL '+'");
112
          END;
113
 
114
          -- AS ABOVE BUT INTERCHANGING '+' AND '-'
115
          BEGIN
116
               F5 := IDENT(FLOAT5'BASE'FIRST) - FLOAT5'BASE'FIRST;
117
 
118
               IF NOT EQUAL(F5, F5) THEN
119
                    COMMENT("DON'T OPTIMIZE F5");
120
               END IF;
121
          EXCEPTION
122
               WHEN CONSTRAINT_ERROR =>
123
                    FAILED("CONSTRAINT_ERROR " &
124
                           "RAISED BY INTERCHANGING SMALL '+'");
125
               WHEN OTHERS =>
126
                    FAILED("UNEXPECTED EXCEPTION RAISED BY " &
127
                           "INTERCHANGING SMALL '+'");
128
          END;
129
 
130
          BEGIN
131
               F5 := IDENT(FLOAT5'BASE'LAST) - FLOAT5'BASE'FIRST;
132
 
133
               FAILED("NO EXCEPTION RAISED BY LARGE '-'");
134
 
135
               IF NOT EQUAL(F5, F5) THEN
136
                    COMMENT("DON'T OPTIMIZE F5");
137
               END IF;
138
          EXCEPTION
139
               WHEN CONSTRAINT_ERROR =>
140
                    NULL;
141
               WHEN OTHERS =>
142
                    FAILED("UNEXPECTED EXCEPTION RAISED BY LARGE '-'");
143
          END;
144
 
145
          -- AS ABOVE BUT INTERCHANGING '+' AND '-'
146
          BEGIN
147
               F5 := IDENT(FLOAT5'BASE'LAST) + FLOAT5'BASE'FIRST;
148
 
149
               IF NOT EQUAL(F5, F5) THEN
150
                    COMMENT("DON'T OPTIMIZE F5");
151
               END IF;
152
          EXCEPTION
153
               WHEN CONSTRAINT_ERROR =>
154
                    FAILED("CONSTRAINT_ERROR " &
155
                           "RAISED BY INTERCHANGING LARGE '-'");
156
               WHEN OTHERS =>
157
                    FAILED("UNEXPECTED EXCEPTION RAISED BY " &
158
                           "INTERCHANGING LARGE '-'");
159
          END;
160
 
161
          BEGIN
162
               F5 := IDENT(FLOAT5'BASE'FIRST) - FLOAT5'BASE'LAST;
163
 
164
               FAILED("NO EXCEPTION RAISED BY SMALL '-'");
165
 
166
               IF NOT EQUAL(F5, F5) THEN
167
                    COMMENT("DON'T OPTIMIZE F5");
168
               END IF;
169
          EXCEPTION
170
               WHEN CONSTRAINT_ERROR =>
171
                    NULL;
172
               WHEN OTHERS =>
173
                    FAILED("UNEXPECTED EXCEPTION RAISED BY SMALL '-'");
174
          END;
175
 
176
          -- AS ABOVE BUT INTERCHANGING '+' AND '-'
177
          BEGIN
178
               F5 := IDENT(FLOAT5'BASE'FIRST) + FLOAT5'BASE'LAST;
179
 
180
               IF NOT EQUAL(F5, F5) THEN
181
                    COMMENT("DON'T OPTIMIZE F5");
182
               END IF;
183
          EXCEPTION
184
               WHEN CONSTRAINT_ERROR =>
185
                    FAILED("CONSTRAINT_ERROR " &
186
                           "RAISED BY INTERCHANGING SMALL '-'");
187
               WHEN OTHERS =>
188
                    FAILED("UNEXPECTED EXCEPTION RAISED BY " &
189
                           "INTERCHANGING SMALL '-'");
190
          END;
191
 
192
     END IF;
193
 
194
     RESULT;
195
 
196
END C45322A;

powered by: WebSVN 2.1.0

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