OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c4a012b.ada] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C4A012B.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 FOR
27
--     A UNIVERSAL_REAL EXPRESSION IF DIVISION BY ZERO IS ATTEMPTED.
28
 
29
--     CHECK THAT CONSTRAINT_ERROR IS RAISED FOR
30
--     0.0 ** (-1) (OR ANY OTHER NEGATIVE EXPONENT VALUE).
31
 
32
-- HISTORY:
33
--     RJW 09/04/86  CREATED ORIGINAL TEST.
34
--     CJJ 09/04/87  ADDED PASS MESSAGE FOR RAISING NUMERIC_ERROR;
35
--                   MODIFIED CODE TO PREVENT COMPILER OPTIMIZING
36
--                   OUT THE TEST.
37
--     JET 12/31/87  ADDED MORE CODE TO PREVENT OPTIMIZATION.
38
--     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
39
--     JRL 02/29/96  Added code to check for value of Machine_Overflows; if
40
--                   False, test is inapplicable.
41
 
42
WITH REPORT; USE REPORT;
43
 
44
PROCEDURE C4A012B IS
45
 
46
     F : FLOAT;
47
 
48
     I3 : INTEGER := -3;
49
 
50
     SUBTYPE SINT IS INTEGER RANGE -10 .. 10;
51
     SI5 : CONSTANT SINT := -5;
52
 
53
     FUNCTION IDENT (X:FLOAT) RETURN FLOAT IS
54
     BEGIN
55
          IF EQUAL (3,3) THEN
56
               RETURN X;
57
          ELSE
58
               RETURN 1.0;
59
          END IF;
60
     END IDENT;
61
 
62
BEGIN
63
 
64
     TEST ( "C4A012B", "CHECK THAT CONSTRAINT_ERROR " &
65
                       "IS RAISED FOR " &
66
                       "0.0 ** (-1) (OR ANY OTHER NEGATIVE EXPONENT " &
67
                       "VALUE)" );
68
 
69
     IF FLOAT'MACHINE_OVERFLOWS = FALSE THEN
70
        REPORT.NOT_APPLICABLE ("Float'Machine_Overflows = False");
71
     ELSE
72
 
73
        BEGIN
74
             F := IDENT (0.0) ** (-1);
75
             FAILED ( "THE EXPRESSION '0.0 ** (-1)' DID NOT RAISE " &
76
                      "AN EXCEPTION" );
77
             IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
78
                  COMMENT ("SHOULDN'T BE HERE!");
79
             END IF;
80
        EXCEPTION
81
             WHEN CONSTRAINT_ERROR =>
82
                  COMMENT ("CONSTRAINT_ERROR RAISED - 1");
83
             WHEN OTHERS =>
84
                  FAILED ( "THE EXPRESSION '0.0 ** (-1)' RAISED THE " &
85
                           "WRONG EXCEPTION" );
86
        END;
87
 
88
        BEGIN
89
             F := 0.0 ** (IDENT_INT (-1));
90
             FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (-1))' DID " &
91
                       "NOT RAISE AN EXCEPTION" );
92
             IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
93
                  COMMENT ("SHOULDN'T BE HERE!");
94
             END IF;
95
        EXCEPTION
96
             WHEN CONSTRAINT_ERROR =>
97
                  COMMENT ("CONSTRAINT_ERROR RAISED - 2");
98
             WHEN OTHERS =>
99
                  FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (-1))' " &
100
                           "RAISED THE WRONG EXCEPTION" );
101
        END;
102
 
103
        BEGIN
104
             F := 0.0 ** (INTEGER'POS (IDENT_INT (-1)));
105
             FAILED ( "THE EXPRESSION '0.0 ** " &
106
                      "(INTEGER'POS (IDENT_INT (-1)))' DID " &
107
                      "NOT RAISE AN EXCEPTION" );
108
             IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
109
                  COMMENT ("SHOULDN'T BE HERE!");
110
             END IF;
111
        EXCEPTION
112
             WHEN CONSTRAINT_ERROR =>
113
                  COMMENT ("CONSTRAINT_ERROR RAISED - 3");
114
             WHEN OTHERS =>
115
                  FAILED ( "THE EXPRESSION '0.0 ** " &
116
                           "(INTEGER'POS (IDENT_INT (-1)))' RAISED " &
117
                           "THE WRONG EXCEPTION" );
118
        END;
119
 
120
        BEGIN
121
             F := IDENT(0.0) ** I3;
122
             FAILED ( "THE EXPRESSION '0.0 ** I3' DID NOT RAISE " &
123
                       "AN EXCEPTION" );
124
             IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
125
                  COMMENT ("SHOULDN'T BE HERE!");
126
             END IF;
127
        EXCEPTION
128
             WHEN CONSTRAINT_ERROR =>
129
                  COMMENT ("CONSTRAINT_ERROR RAISED - 4");
130
             WHEN OTHERS =>
131
                  FAILED ( "THE EXPRESSION '0.0 ** I3' RAISED THE " &
132
                           "WRONG EXCEPTION" );
133
        END;
134
 
135
        BEGIN
136
             F := 0.0 ** (IDENT_INT (I3));
137
             FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (I3))' DID " &
138
                      "NOT RAISE AN EXCEPTION" );
139
             IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
140
                  COMMENT ("SHOULDN'T BE HERE!");
141
             END IF;
142
        EXCEPTION
143
             WHEN CONSTRAINT_ERROR =>
144
                  COMMENT ("CONSTRAINT_ERROR RAISED - 5");
145
             WHEN OTHERS =>
146
                  FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (I3))' " &
147
                            "RAISED THE WRONG EXCEPTION" );
148
        END;
149
 
150
        BEGIN
151
             F := IDENT (0.0) ** SI5;
152
             FAILED ( "THE EXPRESSION '0.0 ** SI5' DID NOT RAISE " &
153
                       "AN EXCEPTION" );
154
             IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
155
                  COMMENT ("SHOULDN'T BE HERE!");
156
             END IF;
157
        EXCEPTION
158
             WHEN CONSTRAINT_ERROR =>
159
                  COMMENT ("CONSTRAINT_ERROR RAISED - 6");
160
             WHEN OTHERS =>
161
                  FAILED ( "THE EXPRESSION '0.0 ** SI5' RAISED THE " &
162
                           "WRONG EXCEPTION" );
163
        END;
164
 
165
        BEGIN
166
             F := 0.0 ** (IDENT_INT (SI5));
167
             FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (SI5))' DID " &
168
                      "NOT RAISE AN EXCEPTION" );
169
             IF EQUAL ( INTEGER(F), INTEGER(F) ) THEN
170
                  COMMENT ("SHOULDN'T BE HERE!");
171
             END IF;
172
        EXCEPTION
173
             WHEN CONSTRAINT_ERROR =>
174
                  COMMENT ("CONSTRAINT_ERROR RAISED - 7");
175
             WHEN OTHERS =>
176
                  FAILED ( "THE EXPRESSION '0.0 ** (IDENT_INT (SI5))' " &
177
                            "RAISED THE WRONG EXCEPTION" );
178
        END;
179
 
180
     END IF;
181
 
182
     RESULT;
183
 
184
END C4A012B;

powered by: WebSVN 2.1.0

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