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/] [c47005a.ada] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn 
-- C47005A.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 
--     WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES A FLOATING
27 
--     POINT TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE VALUE
28 
--     OF THE OPERAND DOES NOT LIE WITHIN THE RANGE OF THE TYPE MARK.
29 
 
30 
-- HISTORY:
31 
--     RJW 07/23/86  CREATED ORIGINAL TEST.
32 
--     BCB 08/19/87  CHANGED HEADER TO STANDARD HEADER FORMAT.  ADDED
33 
--                   TEST FOR UPPER SIDE OF RANGE.
34 
 
35 
WITH REPORT; USE REPORT;
36 
PROCEDURE C47005A IS
37 
 
38 
BEGIN
39 
 
40 
     TEST( "C47005A", "WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION " &
41 
                      "DENOTES A FLOATING POINT TYPE, CHECK THAT " &
42 
                      "CONSTRAINT_ERROR IS RAISED WHEN THE VALUE " &
43 
                      "OF THE OPERAND DOES NOT LIE WITHIN THE " &
44 
                      "RANGE OF THE TYPE MARK" );
45 
 
46 
     DECLARE
47 
 
48 
          SUBTYPE SFLOAT IS FLOAT RANGE -1.0 .. 1.0;
49 
 
50 
          FUNCTION IDENT (F : FLOAT) RETURN FLOAT IS
51 
          BEGIN
52 
               IF EQUAL (3, 3) THEN
53 
                    RETURN F;
54 
               ELSE
55 
                    RETURN 0.0;
56 
               END IF;
57 
          END IDENT;
58 
 
59 
     BEGIN
60 
          IF SFLOAT'(IDENT (-2.0)) = -1.0 THEN
61 
               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
62 
                        "SUBTYPE SFLOAT - 1");
63 
          ELSE
64 
               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
65 
                        "SUBTYPE SFLOAT - 2");
66 
          END IF;
67 
     EXCEPTION
68 
          WHEN CONSTRAINT_ERROR =>
69 
               NULL;
70 
          WHEN OTHERS =>
71 
               FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
72 
                        "OF SUBTYPE SFLOAT" );
73 
     END;
74 
 
75 
     DECLARE
76 
 
77 
          TYPE FLT IS DIGITS 3 RANGE -5.0 .. 5.0;
78 
          SUBTYPE SFLT IS FLT RANGE -1.0 .. 1.0;
79 
 
80 
          FUNCTION IDENT (F : FLT) RETURN FLT IS
81 
          BEGIN
82 
               IF EQUAL (3, 3) THEN
83 
                    RETURN F;
84 
               ELSE
85 
                    RETURN 0.0;
86 
               END IF;
87 
          END IDENT;
88 
 
89 
     BEGIN
90 
          IF SFLT'(IDENT (-2.0)) = -1.0 THEN
91 
               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
92 
                        "SUBTYPE SFLT - 1");
93 
          ELSE
94 
               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
95 
                        "SUBTYPE SFLT - 2");
96 
          END IF;
97 
     EXCEPTION
98 
          WHEN CONSTRAINT_ERROR =>
99 
               NULL;
100 
          WHEN OTHERS =>
101 
               FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
102 
                        "OF SUBTYPE SFLT" );
103 
     END;
104 
 
105 
     DECLARE
106 
 
107 
          TYPE NFLT IS NEW FLOAT;
108 
          SUBTYPE SNFLT IS NFLT RANGE -1.0 .. 1.0;
109 
 
110 
          FUNCTION IDENT (F : NFLT) RETURN NFLT IS
111 
          BEGIN
112 
               IF EQUAL (3, 3) THEN
113 
                    RETURN F;
114 
               ELSE
115 
                    RETURN 0.0;
116 
               END IF;
117 
          END IDENT;
118 
 
119 
     BEGIN
120 
          IF SNFLT'(IDENT (2.0)) = 1.0 THEN
121 
               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
122 
                        "SUBTYPE SNFLT 1");
123 
          ELSE
124 
               FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " &
125 
                        "SUBTYPE SNFLT 2");
126 
          END IF;
127 
     EXCEPTION
128 
          WHEN CONSTRAINT_ERROR =>
129 
               NULL;
130 
          WHEN OTHERS =>
131 
               FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " &
132 
                        "OF SUBTYPE SNFLT" );
133 
     END;
134 
 
135 
     RESULT;
136 
END C47005A;

powered by: WebSVN 2.1.0

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