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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cc/] [cc1221b.ada] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CC1221B.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
--     FOR A FORMAL INTEGER TYPE, CHECK THAT THE FOLLOWING BASIC
27
--     OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE
28
--     WITHIN THE GENERIC UNIT:  ATTRIBUTES 'FIRST, 'LAST, 'WIDTH,
29
--     'ADDRESS, AND 'SIZE.
30
 
31
-- HISTORY:
32
--     BCB 11/12/87  CREATED ORIGINAL TEST FROM SPLIT OF CC1221A.ADA.
33
 
34
WITH SYSTEM; USE SYSTEM;
35
WITH REPORT; USE REPORT;
36
PROCEDURE CC1221B IS
37
 
38
     SUBTYPE SUBINT IS INTEGER RANGE -100 .. 100;
39
     SUBTYPE NOINT IS INTEGER RANGE 1 .. -1;
40
     TYPE NEWINT IS NEW INTEGER;
41
     TYPE INT IS RANGE -300 .. 300;
42
     SUBTYPE SINT1 IS INT
43
          RANGE INT (IDENT_INT (-4)) .. INT (IDENT_INT (4));
44
     SUBTYPE SINT2 IS INT RANGE 16#E#E1 .. 2#1111_1111#;
45
     TYPE INT2 IS RANGE 0E8 .. 1E3;
46
 
47
BEGIN
48
     TEST ( "CC1221B", "FOR A FORMAL INTEGER TYPE, CHECK THAT THE " &
49
                       "FOLLOWING BASIC OPERATIONS ARE IMPLICITLY " &
50
                       "DECLARED AND ARE THEREFORE AVAILABLE " &
51
                       "WITHIN THE GENERIC UNIT:  ATTRIBUTES 'FIRST, " &
52
                       "'LAST, 'WIDTH, 'ADDRESS, AND 'SIZE");
53
 
54
     DECLARE -- (B) CHECKS FOR BASIC OPERATIONS OF A DISCRETE TYPE.
55
             --     PART II.
56
 
57
          GENERIC
58
               TYPE T IS RANGE <>;
59
               F, L : T;
60
               W : INTEGER;
61
          PROCEDURE P (STR : STRING);
62
 
63
          PROCEDURE P (STR : STRING) IS
64
               I : INTEGER := F'SIZE;
65
               T1 : T;
66
               A : ADDRESS := T1'ADDRESS;
67
 
68
          BEGIN
69
               IF T'FIRST /= F THEN
70
                    FAILED ( "INCORRECT VALUE FOR " & STR & "'FIRST" );
71
               END IF;
72
 
73
               IF T'LAST /= L THEN
74
                    FAILED ( "INCORRECT VALUE FOR " & STR & "'LAST" );
75
               END IF;
76
 
77
               IF T'BASE'FIRST > T'FIRST THEN
78
                    FAILED ( "INCORRECT RESULTS WITH " & STR &
79
                             "'BASE'FIRST" );
80
               END IF;
81
 
82
               IF T'BASE'LAST < T'LAST THEN
83
                    FAILED ( "INCORRECT RESULTS WITH " & STR &
84
                             "'BASE'LAST" );
85
               END IF;
86
 
87
               IF T'WIDTH /= W THEN
88
                    FAILED ( "INCORRECT VALUE FOR " & STR &
89
                             "'WIDTH" );
90
               END IF;
91
 
92
               IF T'BASE'WIDTH < T'WIDTH THEN
93
                    FAILED ( "INCORRECT RESULTS WITH " & STR &
94
                             "'BASE'WIDTH" );
95
               END IF;
96
 
97
          END P;
98
 
99
          GENERIC
100
               TYPE T IS RANGE <>;
101
          PROCEDURE Q;
102
 
103
          PROCEDURE Q IS
104
          BEGIN
105
               IF T'FIRST /= 1 THEN
106
                    FAILED ( "INCORRECT VALUE FOR NOINT'FIRST" );
107
               END IF;
108
 
109
               IF T'LAST /= -1 THEN
110
                    FAILED ( "INCORRECT VALUE FOR NOINT'LAST" );
111
               END IF;
112
 
113
               IF T'BASE'FIRST > T'FIRST THEN
114
                    FAILED ( "INCORRECT RESULTS WITH " &
115
                             "NOINT'BASE'FIRST" );
116
               END IF;
117
 
118
               IF T'BASE'LAST < T'LAST THEN
119
                    FAILED ( "INCORRECT RESULTS WITH " &
120
                             "NOINT'BASE'LAST" );
121
               END IF;
122
 
123
               IF T'WIDTH /= 0 THEN
124
                    FAILED ( "INCORRECT VALUE FOR " &
125
                             "NOINT'WIDTH" );
126
               END IF;
127
 
128
               IF T'BASE'WIDTH < T'WIDTH THEN
129
                    FAILED ( "INCORRECT RESULTS WITH " &
130
                             "NOINT'BASE'WIDTH" );
131
               END IF;
132
 
133
          END Q;
134
 
135
          PROCEDURE P1 IS NEW P (INTEGER, INTEGER'FIRST, INTEGER'LAST,
136
                                 INTEGER'WIDTH);
137
          PROCEDURE P2 IS NEW P (SUBINT, -100, 100, 4);
138
          PROCEDURE P3 IS NEW P (NEWINT, NEWINT'FIRST, NEWINT'LAST,
139
                                 NEWINT'WIDTH);
140
          PROCEDURE P4 IS NEW P (SINT1, -4, 4, 2);
141
          PROCEDURE P5 IS NEW P (SINT2, 224, 255, 4);
142
          PROCEDURE P6 IS NEW P (INT2 , 0, 1000, 5);
143
 
144
          PROCEDURE Q1 IS NEW Q (NOINT);
145
 
146
     BEGIN
147
           P1 ( "INTEGER" );
148
           P2 ( "SUBINT" );
149
           P3 ( "NEWINT" );
150
           P4 ( "SINT1" );
151
           P5 ( "SINT2" );
152
           P6 ( "INT2" );
153
 
154
           Q1;
155
 
156
     END; -- (B).
157
 
158
     RESULT;
159
END CC1221B;

powered by: WebSVN 2.1.0

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