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

Subversion Repositories openrisc_me

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C95085B.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
-- CHECK THAT CONSTRAINT_ERROR IS RAISED UNDER APPROPRIATE CIRCUMSTANCES
26
-- WITH RESPECT TO PARAMETERS OF RECORD TYPES IN ENTRY CALLS.  SUBTESTS
27
-- INVOLVE ACTUAL RECORD PARAMETERS WHOSE CONSTRAINT VALUES ARE NOT
28
-- EQUAL TO THE CONSTRAINTS ON THEIR CORRESPONDING FORMAL PARAMETERS:
29
--        (A) IN PARAMETER, STATIC AGGREGATE.
30
--        (B) IN PARAMETER, DYNAMIC AGGREGATE.
31
--        (C) IN PARAMETER, VARIABLE.
32
--        (D) IN OUT PARAMETER, EXCEPTION RAISED ON CALL.
33
--        (E) OUT PARAMETER, EXCEPTION RAISED ON CALL.
34
 
35
-- JWC 10/25/85
36
 
37
WITH REPORT; USE REPORT;
38
PROCEDURE C95085B IS
39
 
40
     SUBTYPE INT IS INTEGER RANGE 0..10;
41
 
42
     TYPE REC (N : INT := 0) IS
43
          RECORD
44
               A : STRING (1..N);
45
          END RECORD;
46
 
47
     SUBTYPE SREC IS REC(N=>3);
48
 
49
BEGIN
50
 
51
     TEST ("C95085B", "CHECK RAISING OF CONSTRAINT_ERROR FOR " &
52
                      "PARAMETERS OF RECORD TYPES");
53
 
54
     DECLARE
55
 
56
          TASK TSK1 IS
57
               ENTRY E (R : IN SREC);
58
          END TSK1;
59
 
60
          TASK BODY TSK1 IS
61
          BEGIN
62
               LOOP
63
                    BEGIN
64
                         SELECT
65
                              ACCEPT E (R : IN SREC) DO
66
                                   FAILED ("EXCEPTION NOT RAISED ON " &
67
                                           "CALL TO TSK1");
68
                              END E;
69
                         OR
70
                              TERMINATE;
71
                         END SELECT;
72
                    EXCEPTION
73
                         WHEN OTHERS =>
74
                              FAILED ("EXCEPTION RAISED IN TSK1");
75
                    END;
76
               END LOOP;
77
          END TSK1;
78
 
79
     BEGIN
80
 
81
          BEGIN -- (A)
82
               TSK1.E ((2,"AA"));
83
               FAILED ("EXCEPTION NOT RAISED IN SUBTEST (A)");
84
          EXCEPTION
85
               WHEN CONSTRAINT_ERROR =>
86
                    NULL;
87
               WHEN OTHERS =>
88
                    FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (A)");
89
          END; -- (A)
90
 
91
          BEGIN -- (B)
92
               TSK1.E ((IDENT_INT(2), "AA"));
93
               FAILED ("EXCEPTION NOT RAISED IN SUBTEST (B)");
94
          EXCEPTION
95
               WHEN CONSTRAINT_ERROR =>
96
                    NULL;
97
               WHEN OTHERS =>
98
                    FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (B)");
99
          END; -- (B)
100
 
101
          DECLARE -- (C)
102
               R : REC     := (IDENT_INT(2), "AA");
103
          BEGIN -- (C)
104
               TSK1.E (R);
105
               FAILED ("EXCEPTION NOT RAISED IN SUBTEST (C)");
106
          EXCEPTION
107
               WHEN CONSTRAINT_ERROR =>
108
                    NULL;
109
               WHEN OTHERS =>
110
                    FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (C)");
111
          END; -- (C)
112
 
113
     END;
114
 
115
     DECLARE -- (D)
116
 
117
          R : REC := (IDENT_INT(2), "AA");
118
 
119
          TASK TSK2 IS
120
               ENTRY E (R : IN OUT SREC);
121
          END TSK2;
122
 
123
          TASK BODY TSK2 IS
124
          BEGIN
125
               SELECT
126
                    ACCEPT E (R : IN OUT SREC) DO
127
                         FAILED ("EXCEPTION NOT RAISED ON CALL TO " &
128
                                 "TSK2");
129
                    END E;
130
               OR
131
                    TERMINATE;
132
               END SELECT;
133
          EXCEPTION
134
               WHEN OTHERS =>
135
                    FAILED ("EXCEPTION RAISED IN TSK2");
136
          END TSK2;
137
 
138
     BEGIN -- (D)
139
          TSK2.E (R);
140
          FAILED ("EXCEPTION NOT RAISED IN SUBTEST (D)");
141
     EXCEPTION
142
          WHEN CONSTRAINT_ERROR =>
143
               NULL;
144
          WHEN OTHERS =>
145
               FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (D)");
146
     END; -- (D)
147
 
148
     DECLARE -- (E)
149
 
150
          R : REC;
151
 
152
          TASK TSK3 IS
153
               ENTRY E (R : OUT SREC);
154
          END TSK3;
155
 
156
          TASK BODY TSK3 IS
157
          BEGIN
158
               SELECT
159
                    ACCEPT E (R : OUT SREC) DO
160
                         FAILED ("EXCEPTION NOT RAISED ON CALL TO " &
161
                                 "TSK3");
162
                    END E;
163
               OR
164
                    TERMINATE;
165
               END SELECT;
166
          EXCEPTION
167
               WHEN OTHERS =>
168
                    FAILED ("EXCEPTION RAISED IN TSK3");
169
          END TSK3;
170
 
171
     BEGIN -- (E)
172
          TSK3.E (R);
173
          FAILED ("EXCEPTION NOT RAISED IN SUBTEST (E)");
174
     EXCEPTION
175
          WHEN CONSTRAINT_ERROR =>
176
               NULL;
177
          WHEN OTHERS =>
178
                FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (E)");
179
     END; -- (E)
180
 
181
     RESULT;
182
 
183
END C95085B;

powered by: WebSVN 2.1.0

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