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/] [cc/] [cc1220a.ada] - Blame information for rev 149

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CC1220A.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 A GENERIC UNIT CAN REFER TO AN IMPLICITLY
27
--     DECLARED PREDEFINED OPERATOR.
28
 
29
-- HISTORY:
30
--     DAT 08/20/81  CREATED ORIGINAL TEST.
31
--     SPS 05/03/82
32
--     BCB 08/04/88  MODIFIED HEADER FORMAT AND ADDED CHECKS FOR OTHER
33
--                   OPERATIONS OF A DISCRETE TYPE.
34
--     RJW 03/27/90  REVISED TEST TO CHECK FOR A GENERIC FORMAL
35
--                   DISCRETE TYPE.
36
--     CJJ 10/14/90  ADDED CHECKS FOR RELATIONAL OPERATOR (<, <=, >, >=);
37
--                   MADE FAILED MESSAGES IN PROCEDURE BODY MORE SPECIFIC.
38
 
39
WITH REPORT; USE REPORT;
40
WITH SYSTEM; USE SYSTEM;
41
 
42
PROCEDURE CC1220A IS
43
 
44
BEGIN
45
     TEST ("CC1220A", "GENERIC UNIT CAN REFER TO IMPLICITLY " &
46
           "DECLARED OPERATORS");
47
 
48
 
49
     DECLARE
50
 
51
          GENERIC
52
               TYPE T IS (<>);
53
               STR : STRING;
54
               P1 : T := T'FIRST;
55
               P2 : T := T(T'SUCC (P1));
56
               P3 : T := T'(T'PRED (P2));
57
               P4 : INTEGER := IDENT_INT(T'WIDTH);
58
               P5 : BOOLEAN := (P1 < P2) AND (P2 > P3);
59
               P6: BOOLEAN := (P1 <= P3) AND (P2 >= P1);
60
               P7 : BOOLEAN := (P3 = P1);
61
               P8 : T := T'BASE'FIRST;
62
               P10 : T := T'LAST;
63
               P11 : INTEGER := T'SIZE;
64
               P12 : ADDRESS := P10'ADDRESS;
65
               P13 : INTEGER := T'WIDTH;
66
               P14 : INTEGER := T'POS(T'LAST);
67
               P15 : T := T'VAL(1);
68
               P16 : INTEGER := T'POS(P15);
69
               P17 : STRING := T'IMAGE(T'BASE'LAST);
70
               P18 : T := T'VALUE(P17);
71
               P19 : BOOLEAN := (P15 IN T);
72
               WITH FUNCTION IDENT (X : T) RETURN T;
73
          PACKAGE PKG IS
74
               ARR : ARRAY (1 .. 3) OF T := (P1,P2,P3);
75
               B1 : BOOLEAN := P7 AND P19;
76
               B2 : BOOLEAN := P5 AND P6;
77
          END PKG;
78
 
79
          PACKAGE BODY PKG IS
80
          BEGIN
81
               IF P1 /= T(T'FIRST) THEN
82
                    FAILED ("IMPROPER VALUE FOR 'FIRST - " & STR);
83
               END IF;
84
 
85
               IF T'SUCC (P1) /= IDENT (P2) OR
86
                  T'PRED (P2) /= IDENT (P1) THEN
87
                    FAILED ("IMPROPER VALUE FOR 'SUCC, PRED - " & STR);
88
               END IF;
89
 
90
               IF P10 /= T(T'LAST) THEN
91
                    FAILED ("IMPROPER VALUE FOR 'LAST - " & STR);
92
               END IF;
93
 
94
               IF NOT EQUAL(P11,T'SIZE) THEN
95
                    FAILED ("IMPROPER VALUE FOR 'SIZE - " & STR);
96
               END IF;
97
 
98
               IF NOT EQUAL(P13,T'WIDTH) THEN
99
                    FAILED ("IMPROPER VALUE FOR 'WIDTH - " & STR);
100
               END IF;
101
 
102
               IF NOT EQUAL (P16, T'POS (P15)) OR
103
                  T'VAL (P16) /= T(IDENT (P15)) THEN
104
                    FAILED ("IMPROPER VALUE FOR 'POS, 'VAL - " & STR);
105
               END IF;
106
 
107
               IF T'VALUE (P17) /= T'BASE'LAST OR
108
                  T'IMAGE (P18) /= T'IMAGE (T'BASE'LAST) THEN
109
                    FAILED ("IMPROPER VALUE FOR 'VALUE, 'IMAGE - " &
110
                             STR);
111
               END IF;
112
          END PKG;
113
 
114
     BEGIN
115
          DECLARE
116
               TYPE CHAR IS ('A', 'B', 'C', 'D', 'E');
117
 
118
               FUNCTION IDENT (C : CHAR) RETURN CHAR IS
119
               BEGIN
120
                    RETURN CHAR'VAL (IDENT_INT (CHAR'POS (C)));
121
               END IDENT;
122
 
123
               PACKAGE N_CHAR IS NEW PKG (T => CHAR, STR => "CHAR",
124
                                          IDENT => IDENT);
125
          BEGIN
126
               IF N_CHAR.ARR (1) /= IDENT ('A') OR
127
                  N_CHAR.ARR (2) /= IDENT ('B') OR
128
                  N_CHAR.ARR (3) /= 'A' OR
129
                  N_CHAR.B1 /= TRUE OR
130
                 N_CHAR.B2 /= TRUE THEN
131
                    FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" &
132
                            " IN INSTANTIATION OF N_CHAR.");
133
               END IF;
134
          END;
135
 
136
          DECLARE
137
               TYPE ENUM IS (JOVIAL, ADA, FORTRAN, BASIC);
138
 
139
               FUNCTION IDENT (C : ENUM) RETURN ENUM IS
140
               BEGIN
141
                    RETURN ENUM'VAL (IDENT_INT (ENUM'POS (C)));
142
               END IDENT;
143
 
144
               PACKAGE N_ENUM IS NEW PKG (T => ENUM, STR => "ENUM",
145
                                          IDENT => IDENT);
146
 
147
          BEGIN
148
               IF N_ENUM.ARR (1) /= IDENT (JOVIAL) OR
149
                  N_ENUM.ARR (2) /= IDENT (ADA) OR
150
                  N_ENUM.ARR (3) /= JOVIAL OR
151
                  N_ENUM.B1 /= TRUE OR
152
                  N_ENUM.B2 /= TRUE THEN
153
                    FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" &
154
                            " IN INSTANTIATION OF N_ENUM.");
155
               END IF;
156
          END;
157
 
158
          DECLARE
159
 
160
               PACKAGE N_INT IS NEW PKG (T => INTEGER, STR => "INTEGER",
161
                                          IDENT => IDENT_INT);
162
          BEGIN
163
               IF N_INT.ARR (1) /= IDENT_INT (INTEGER'FIRST) OR
164
                  N_INT.ARR (2) /= IDENT_INT (INTEGER'FIRST + 1) OR
165
                  N_INT.ARR (3) /= INTEGER'FIRST OR
166
                  N_INT.B1 /= TRUE OR
167
                  N_INT.B2 /= TRUE THEN
168
                    FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" &
169
                            " IN INSTANTIATION OF N_INT.");
170
               END IF;
171
          END;
172
     END;
173
     RESULT;
174
END CC1220A;

powered by: WebSVN 2.1.0

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