1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
|
-- CB41002.A
--
-- Grant of Unlimited Rights
--
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
-- unlimited rights in the software and documentation contained herein.
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
-- this public release, the Government intends to confer upon all
-- recipients unlimited rights equal to those held by the Government.
-- These rights include rights to use, duplicate, release or disclose the
-- released technical data and computer software in whole or in part, in
-- any manner and for any purpose whatsoever, and to have or permit others
-- to do so.
--
-- DISCLAIMER
--
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
-- PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--
-- OBJECTIVE:
-- Check that the message string input parameter in a call to the
-- Raise_Exception procedure is associated with the raised exception
-- occurrence, and that the message string can be obtained using the
-- Exception_Message function with the associated Exception_Occurrence
-- object. Check that Function Exception_Information is available
-- to provide implementation-defined information about the exception
-- occurrence.
--
-- TEST DESCRIPTION:
-- This test checks that a message associated with a raised exception
-- is propagated with the exception, and can be retrieved using the
-- Exception_Message function. The exception will be raised using the
-- 'Identity attribute as a parameter to the Raise_Exception procedure,
-- and an associated message string will be provided. The exception
-- will be handled, and the message associated with the occurrence will
-- be compared to the original source message (non-default).
--
-- The test also includes a simulated logging procedure
-- (Check_Exception_Information) that checks that Exception_Information
-- can be called.
--
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
-- 22 Jun 00 RLB Added a check at Exception_Information can be
-- called.
--
--!
with Report;
with Ada.Exceptions;
procedure CB41002 is
begin
Report.Test ("CB41002", "Check that the message string input parameter " &
"in a call to the Raise_Exception procedure is " &
"associated with the raised exception " &
"occurrence, and that the message string can " &
"be obtained using the Exception_Message " &
"function with the associated " &
"Exception_Occurrence object. Also check that " &
"the Exception_Information function can be called");
Test_Block:
declare
Number_Of_Exceptions : constant := 3;
User_Exception_1,
User_Exception_2,
User_Exception_3 : exception;
type String_Ptr is access String;
User_Messages : constant array (1..Number_Of_Exceptions)
of String_Ptr :=
(new String'("Msg"),
new String'("This message will override the default " &
"message provided by the implementation"),
new String'("The message can be captured by procedure" & -- 200 chars
" Exception_Message. It is designed to b" &
"e exactly 200 characters in length, sinc" &
"e there is a permission concerning the " &
"truncation of a message over 200 chars. "));
procedure Check_Exception_Information (
Occur : in Ada.Exceptions.Exception_Occurrence) is
-- Simulates an error logging routine.
Info : constant String :=
Ada.Exceptions.Exception_Information (Occur);
function Is_Substring_of (Target, Search : in String) return Boolean is
-- Returns True if Search is a substring of Target, and False
-- otherwise.
begin
for I in Report.Ident_Int(Target'First) ..
Target'Last - Search'Length + 1 loop
if Target(I .. I+Search'Length-1) = Search then
return True;
end if;
end loop;
return False;
end Is_Substring_of;
begin
-- We can't display Info, as it often contains line breaks
-- (confusing Report), and might look much like the failure of a test
-- with an unhandled exception (thus confusing grading tools).
--
-- We don't particular care if the implementation advice is followed,
-- but we make these checks to insure that a compiler cannot optimize
-- away Info or the rest of this routine.
if not Is_Substring_of (Info,
Ada.Exceptions.Exception_Name (Occur)) then
Report.Comment ("Exception_Information does not contain " &
"Exception_Name - see 11.4.1(19)");
elsif not Is_Substring_of (Info,
Ada.Exceptions.Exception_Message (Occur)) then
Report.Comment ("Exception_Information does not contain " &
"Exception_Message - see 11.4.1(19)");
end if;
end Check_Exception_Information;
begin
for i in 1..Number_Of_Exceptions loop
begin
-- Raise a user-defined exception with a specific message string.
case i is
when 1 =>
Ada.Exceptions.Raise_Exception(User_Exception_1'Identity,
User_Messages(i).all);
when 2 =>
Ada.Exceptions.Raise_Exception(User_Exception_2'Identity,
User_Messages(i).all);
when 3 =>
Ada.Exceptions.Raise_Exception(User_Exception_3'Identity,
User_Messages(i).all);
when others =>
Report.Failed("Incorrect result from Case statement");
end case;
Report.Failed
("Exception not raised by procedure Exception_With_Message " &
"for User_Exception #" & Integer'Image(i));
exception
when Excptn : others =>
begin
-- The message that is associated with the raising of each
-- exception is captured here using the Exception_Message
-- function.
if User_Messages(i).all /=
Ada.Exceptions.Exception_Message(Excptn)
then
Report.Failed
("Message captured from exception is not the " &
"message provided when the exception was raised, " &
"User_Exception #" & Integer'Image(i));
end if;
Check_Exception_Information(Excptn);
end;
end;
end loop;
-- Verify that the exception specific message is carried across
-- various boundaries:
begin
begin
Ada.Exceptions.Raise_Exception(User_Exception_1'Identity,
User_Messages(1).all);
Report.Failed("User_Exception_1 not raised");
end;
Report.Failed("User_Exception_1 not propagated");
exception
when Excptn : User_Exception_1 =>
if User_Messages(1).all /=
Ada.Exceptions.Exception_Message(Excptn)
then
Report.Failed("User_Message_1 not found");
end if;
Check_Exception_Information(Excptn);
when others => Report.Failed("Unexpected exception handled - 1");
end;
begin
begin
Ada.Exceptions.Raise_Exception(User_Exception_2'Identity,
User_Messages(2).all);
Report.Failed("User_Exception_2 not raised");
exception
when Exc : User_Exception_2 =>
-- The exception is reraised here; message should propagate
-- with exception occurrence.
Ada.Exceptions.Reraise_Occurrence(Exc);
when others => Report.Failed("User_Exception_2 not handled");
end;
Report.Failed("User_Exception_2 not propagated");
exception
when Excptn : User_Exception_2 =>
if User_Messages(2).all /=
Ada.Exceptions.Exception_Message(Excptn)
then
Report.Failed("User_Message_2 not found");
end if;
Check_Exception_Information(Excptn);
when others => Report.Failed("Unexpected exception handled - 2");
end;
-- Check exception and message propagation across task boundaries.
declare
task Raise_An_Exception is -- single task
entry Raise_It;
end Raise_An_Exception;
task body Raise_An_Exception is
begin
accept Raise_It do
Ada.Exceptions.Raise_Exception(User_Exception_3'Identity,
User_Messages(3).all);
end Raise_It;
Report.Failed("User_Exception_3 not raised");
exception
when Excptn : User_Exception_3 =>
if User_Messages(3).all /=
Ada.Exceptions.Exception_Message(Excptn)
then
Report.Failed
("User_Message_3 not returned inside task body");
end if;
Check_Exception_Information(Excptn);
when others =>
Report.Failed("Incorrect exception raised in task body");
end Raise_An_Exception;
begin
Raise_An_Exception.Raise_It; -- Exception will be propagated here.
Report.Failed("User_Exception_3 not propagated to caller");
exception
when Excptn : User_Exception_3 =>
if User_Messages(3).all /=
Ada.Exceptions.Exception_Message(Excptn)
then
Report.Failed("User_Message_3 not returned to caller of task");
end if;
Check_Exception_Information(Excptn);
when others =>
Report.Failed("Incorrect exception raised by task");
end;
exception
when others => Report.Failed ("Exception raised in Test_Block");
end Test_Block;
Report.Result;
end CB41002;
|
