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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C64109K.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 SLICES OF ARRAYS WHICH ARE COMPONENTS OF RECORDS ARE
27
--    PASSED CORRECTLY TO SUBPROGRAMS.  SPECIFICALLY,
28
--    (E) CHECK THE CASE WHERE THE FORMAL IS UNCONSTRAINED, AND ARRAYS
29
--       WITH DIFFERENT BOUNDS ARE PASSED AS ACTUALS.
30
 
31
-- HISTORY:
32
--    TBN 07/11/86          CREATED ORIGINAL TEST.
33
--    JET 08/04/87          MODIFIED REC.A REFERENCES.
34
 
35
WITH REPORT; USE REPORT;
36
PROCEDURE C64109K IS
37
 
38
BEGIN
39
     TEST ("C64109K", "CHECK THAT SLICES OF ARRAYS WHICH ARE " &
40
                      "COMPONENTS OF RECORDS ARE PASSED CORRECTLY " &
41
                      "TO SUBPROGRAMS - ARRAYS WITH DIFFERENT BOUNDS " &
42
                      "PASSED TO UNCONSTRAINED FORMAL");
43
 
44
     DECLARE   -- (E)
45
 
46
          SUBTYPE SUBINT IS INTEGER RANGE 0..5;
47
          TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
48
          TYPE RECORD_TYPE IS
49
               RECORD
50
                    A : ARRAY_TYPE (IDENT_INT(0)..IDENT_INT(4));
51
                    B : ARRAY_TYPE (1..5);
52
               END RECORD;
53
          REC : RECORD_TYPE := (A => (0..4 => IDENT_BOOL(TRUE)),
54
                                B => (1..5 => IDENT_BOOL(FALSE)));
55
          BOOL : BOOLEAN;
56
 
57
          PROCEDURE P1 (ARR : ARRAY_TYPE; ARR2 : ARRAY_TYPE) IS
58
          BEGIN
59
               IF ARR /= (TRUE, TRUE, TRUE) THEN
60
                    FAILED ("IN PARAM NOT PASSED CORRECTLY");
61
               END IF;
62
               IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
63
                    FAILED ("WRONG IN PARAMETER BOUNDS - 1");
64
               END IF;
65
               IF ARR2 /= (FALSE, FALSE, FALSE) THEN
66
                    FAILED ("IN PARAM NOT PASSED CORRECTLY - 2");
67
               END IF;
68
               IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
69
                    FAILED ("WRONG IN PARAMETER BOUNDS - 2");
70
               END IF;
71
          EXCEPTION
72
               WHEN OTHERS =>
73
                    FAILED ("EXCEPTION RAISED IN PROCEDURE P1");
74
          END P1;
75
 
76
          FUNCTION F1 ( ARR : ARRAY_TYPE; ARR2 : ARRAY_TYPE)
77
               RETURN BOOLEAN IS
78
          BEGIN
79
               IF ARR /= (TRUE, TRUE, TRUE) THEN
80
                    FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
81
               END IF;
82
               IF ARR'FIRST /= IDENT_INT(1) OR ARR'LAST /= 3 THEN
83
                    FAILED ("WRONG IN PARAMETER BOUNDS FOR FN - 1");
84
               END IF;
85
               IF ARR2 /= (FALSE, FALSE, FALSE) THEN
86
                    FAILED ("IN PARAM NOT PASSED CORRECTLY TO FN");
87
               END IF;
88
               IF ARR2'FIRST /= 3 OR ARR2'LAST /= IDENT_INT(5) THEN
89
                    FAILED ("WRONG IN PARAMETER BOUNDS FOR FN - 2");
90
               END IF;
91
               RETURN TRUE;
92
          EXCEPTION
93
               WHEN OTHERS =>
94
                    FAILED ("EXCEPTION RAISED IN FUNCTION F1");
95
          END F1;
96
 
97
          PROCEDURE P2 (ARR : IN OUT ARRAY_TYPE;
98
                        ARR2 : IN OUT ARRAY_TYPE) IS
99
          BEGIN
100
               IF ARR /= (TRUE, TRUE, TRUE) THEN
101
                    FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
102
               END IF;
103
               IF ARR'FIRST /= IDENT_INT(2) OR ARR'LAST /= 4 THEN
104
                    FAILED ("WRONG IN OUT PARAMETER BOUNDS - 1");
105
               END IF;
106
               IF ARR2 /= (FALSE, FALSE, FALSE) THEN
107
                    FAILED ("IN OUT PARAM NOT PASSED CORRECTLY");
108
               END IF;
109
               IF ARR2'FIRST /= 2 OR ARR2'LAST /= IDENT_INT(4) THEN
110
                    FAILED ("WRONG IN OUT PARAMETER BOUNDS - 2");
111
               END IF;
112
               ARR := (ARR'RANGE => FALSE);
113
               ARR2 := (ARR2'RANGE => TRUE);
114
          EXCEPTION
115
               WHEN OTHERS =>
116
                    FAILED ("EXCEPTION RAISED IN PROCEDURE P2");
117
          END P2;
118
 
119
          PROCEDURE P3 (ARR : OUT ARRAY_TYPE; ARR2 : OUT ARRAY_TYPE) IS
120
          BEGIN
121
               IF ARR'FIRST /= IDENT_INT(0) OR ARR'LAST /= 2 THEN
122
                    FAILED ("WRONG OUT PARAMETER BOUNDS - 1");
123
               END IF;
124
               IF ARR2'FIRST /= 1 OR ARR2'LAST /= IDENT_INT(3) THEN
125
                    FAILED ("WRONG OUT  PARAMETER BOUNDS - 2");
126
               END IF;
127
               ARR := (ARR'RANGE => FALSE);
128
               ARR2 := (ARR2'RANGE => TRUE);
129
          EXCEPTION
130
               WHEN OTHERS =>
131
                    FAILED ("EXCEPTION RAISED IN PROCEDURE P3");
132
          END P3;
133
 
134
     BEGIN     -- (E)
135
 
136
          BEGIN     -- (F)
137
               P1 (REC.A (0..2), REC.B (1..3));
138
               IF REC.A /= (TRUE, TRUE, TRUE, TRUE, TRUE) THEN
139
                    FAILED ("IN PARAM CHANGED BY PROCEDURE");
140
               END IF;
141
               IF REC.B /= (FALSE, FALSE, FALSE, FALSE, FALSE) THEN
142
                    FAILED ("IN PARAM CHANGED BY PROCEDURE - 2");
143
               END IF;
144
          EXCEPTION
145
               WHEN OTHERS =>
146
                    FAILED ("EXCEPTION RAISED DURING CALL OF P1");
147
          END;     -- (F)
148
 
149
          BEGIN     -- (G)
150
               BOOL := F1 (REC.A (1..3), REC.B (3..5));
151
               IF REC.A /= (TRUE, TRUE, TRUE, TRUE, TRUE) THEN
152
                    FAILED ("IN PARAM CHANGED BY FUNCTION");
153
               END IF;
154
               IF REC.B /= (FALSE, FALSE, FALSE, FALSE, FALSE) THEN
155
                    FAILED ("IN PARAM CHANGED BY FUNCTION - 2");
156
               END IF;
157
          EXCEPTION
158
               WHEN OTHERS =>
159
                    FAILED ("EXCEPTION RAISED DURING CALL OF F1");
160
          END;     -- (G)
161
 
162
          BEGIN     -- (H)
163
               P2 (REC.A (2..4), REC.B (2..4));
164
               IF REC.A /= (TRUE, TRUE, FALSE, FALSE, FALSE) THEN
165
                    FAILED ("IN OUT PARAM RETURNED INCORRECTLY");
166
               END IF;
167
               IF REC.B /= (FALSE, TRUE, TRUE, TRUE, FALSE) THEN
168
                    FAILED ("IN OUT PARAM RETURNED INCORRECTLY - 2");
169
               END IF;
170
          EXCEPTION
171
               WHEN OTHERS =>
172
                    FAILED ("EXCEPTION RAISED DURING CALL OF P2");
173
          END;     -- (H)
174
 
175
          BEGIN     -- (I)
176
               P3 (REC.A (0..2), REC.B (1..3));
177
               IF REC.A /= (FALSE, FALSE, FALSE, FALSE, FALSE) THEN
178
                    FAILED ("OUT PARAM RETURNED INCORRECTLY");
179
               END IF;
180
               IF REC.B /= (TRUE, TRUE, TRUE, TRUE, FALSE) THEN
181
                    FAILED ("OUT PARAM RETURNED INCORRECTLY - 2");
182
               END IF;
183
          EXCEPTION
184
               WHEN OTHERS =>
185
                    FAILED ("EXCEPTION RAISED DURING CALL OF P3");
186
          END;     -- (I)
187
 
188
     END; -- (E)
189
 
190
     RESULT;
191
END C64109K;

powered by: WebSVN 2.1.0

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