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/] [c9/] [c95078a.ada] - Blame information for rev 154

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

Line No. Rev Author Line
1 149 jeremybenn 
-- C95078A.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 AN EXCEPTION RAISED DURING THE EXECUTION OF AN ACCEPT
27 
--     STATEMENT CAN BE HANDLED WITHIN THE ACCEPT BODY.
28 
 
29 
-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
30 
-- ***       remove incompatibilities associated with the transition   -- 9X
31 
-- ***       to Ada 9X.                                                -- 9X
32 
-- ***                                                                 -- 9X
33 
 
34 
-- HISTORY:
35 
--     DHH 03/21/88 CREATED ORIGINAL TEST.
36 
--     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
37 
 
38 
WITH REPORT; USE REPORT;
39 
PROCEDURE C95078A IS
40 
 
41 
BEGIN
42 
 
43 
     TEST("C95078A", "CHECK THAT AN EXCEPTION RAISED DURING THE " &
44 
                     "EXECUTION OF AN ACCEPT STATEMENT CAN BE " &
45 
                     "HANDLED WITHIN THE ACCEPT BODY");
46 
 
47 
     DECLARE
48 
          O,PT,QT,R,S,TP,B,C,D :INTEGER := 0;
49 
          TASK TYPE PROG_ERR IS
50 
               ENTRY START(M,N,A : IN OUT INTEGER);
51 
               ENTRY STOP;
52 
          END PROG_ERR;
53 
 
54 
          TASK T IS
55 
               ENTRY START(M,N,A : IN OUT INTEGER);
56 
               ENTRY STOP;
57 
          END T;
58 
 
59 
          TYPE REC IS
60 
               RECORD
61 
                    B : PROG_ERR;
62 
               END RECORD;
63 
 
64 
          TYPE ACC IS ACCESS PROG_ERR;
65 
 
66 
          SUBTYPE X IS INTEGER RANGE 1 .. 10;
67 
 
68 
          PACKAGE P IS
69 
               OBJ : REC;
70 
          END P;
71 
 
72 
          TASK BODY PROG_ERR IS
73 
               FAULT : X;
74 
          BEGIN
75 
               ACCEPT START(M,N,A : IN OUT INTEGER) DO
76 
                    BEGIN
77 
                         M := IDENT_INT(1);
78 
                         FAULT := IDENT_INT(11);
79 
                         FAULT := IDENT_INT(FAULT);
80 
                    EXCEPTION
81 
                         WHEN CONSTRAINT_ERROR =>
82 
                              NULL;
83 
                         WHEN OTHERS =>
84 
                              FAILED("UNEXPECTED ERROR RAISED - " &
85 
                                     "CONSTRAINT - TASK TYPE");
86 
                    END; -- EXCEPTION
87 
                    BEGIN
88 
                         N := IDENT_INT(1);
89 
                         FAULT := IDENT_INT(5);
90 
                         FAULT := FAULT/IDENT_INT(0);
91 
                         FAULT := IDENT_INT(FAULT);
92 
                    EXCEPTION
93 
                         WHEN CONSTRAINT_ERROR =>
94 
                              NULL;
95 
                         WHEN OTHERS =>
96 
                              FAILED("UNEXPECTED ERROR RAISED - " &
97 
                                     "CONSTRAINT - TASK TYPE");
98 
                    END; -- EXCEPTION
99 
                    A := IDENT_INT(1);
100 
               END START;
101 
 
102 
               ACCEPT STOP;
103 
          END PROG_ERR;
104 
 
105 
          TASK BODY T IS
106 
               FAULT : X;
107 
          BEGIN
108 
               ACCEPT START(M,N,A : IN OUT INTEGER) DO
109 
                    BEGIN
110 
                         M := IDENT_INT(1);
111 
                         FAULT := IDENT_INT(11);
112 
                         FAULT := IDENT_INT(FAULT);
113 
                    EXCEPTION
114 
                         WHEN CONSTRAINT_ERROR =>
115 
                              NULL;
116 
                         WHEN OTHERS =>
117 
                              FAILED("UNEXPECTED ERROR RAISED - " &
118 
                                     "CONSTRAINT - TASK");
119 
                    END; -- EXCEPTION
120 
                    BEGIN
121 
                         N := IDENT_INT(1);
122 
                         FAULT := IDENT_INT(5);
123 
                         FAULT := FAULT/IDENT_INT(0);
124 
                         FAULT := IDENT_INT(FAULT);
125 
                    EXCEPTION
126 
                         WHEN CONSTRAINT_ERROR =>
127 
                              NULL;
128 
                         WHEN OTHERS =>
129 
                              FAILED("UNEXPECTED ERROR RAISED - " &
130 
                                     "CONSTRAINT - TASK");
131 
                    END; -- EXCEPTION
132 
                    A := IDENT_INT(1);
133 
               END START;
134 
 
135 
               ACCEPT STOP;
136 
          END T;
137 
 
138 
          PACKAGE BODY P IS
139 
          BEGIN
140 
               OBJ.B.START(O,PT,B);
141 
               OBJ.B.STOP;
142 
 
143 
               IF O /= IDENT_INT(1) OR PT /= IDENT_INT(1) THEN
144 
                    FAILED("EXCEPTION HANDLER NEVER ENTERED " &
145 
                           "PROPERLY - TASK TYPE OBJECT");
146 
               END IF;
147 
 
148 
               IF B /= IDENT_INT(1) THEN
149 
                    FAILED("TASK NOT EXITED PROPERLY - TASK TYPE " &
150 
                           "OBJECT");
151 
               END IF;
152 
          END P;
153 
 
154 
          PACKAGE Q IS
155 
               OBJ : ACC;
156 
          END Q;
157 
 
158 
          PACKAGE BODY Q IS
159 
          BEGIN
160 
               OBJ := NEW PROG_ERR;
161 
               OBJ.START(QT,R,C);
162 
               OBJ.STOP;
163 
 
164 
               IF QT /= IDENT_INT(1) OR R /= IDENT_INT(1) THEN
165 
                    FAILED("EXCEPTION HANDLER NEVER ENTERED " &
166 
                           "PROPERLY - ACCESS TASK TYPE");
167 
               END IF;
168 
 
169 
               IF C /= IDENT_INT(1) THEN
170 
                    FAILED("TASK NOT EXITED PROPERLY - ACCESS TASK " &
171 
                           "TYPE");
172 
               END IF;
173 
          END;
174 
 
175 
     BEGIN
176 
          T.START(S,TP,D);
177 
          T.STOP;
178 
 
179 
          IF S /= IDENT_INT(1) OR TP /= IDENT_INT(1) THEN
180 
               FAILED("EXCEPTION HANDLER NEVER ENTERED PROPERLY " &
181 
                      "- TASK");
182 
          END IF;
183 
 
184 
          IF D /= IDENT_INT(1) THEN
185 
               FAILED("TASK NOT EXITED PROPERLY - TASK");
186 
          END IF;
187 
     END; -- DECLARE
188 
 
189 
     RESULT;
190 
 
191 
EXCEPTION
192 
     WHEN OTHERS =>
193 
          FAILED("EXCEPTION NOT HANDLED INSIDE ACCEPT BODY");
194 
          RESULT;
195 
END C95078A;

powered by: WebSVN 2.1.0

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