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
|
-- CB42001.A
--
-- Grant of Unlimited Rights
--
-- The Ada Conformity Assessment Authority (ACAA) holds unlimited
-- rights in the software and documentation contained herein. Unlimited
-- rights are the same as those granted by the U.S. Government for older
-- parts of the Ada Conformity Assessment Test Suite, and are defined
-- in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
-- intends to confer upon all recipients unlimited rights equal to those
-- held by the ACAA. 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 ACAA 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.
--
-- Notice
--
-- The ACAA has created and maintains the Ada Conformity Assessment Test
-- Suite for the purpose of conformity assessments conducted in accordance
-- with the International Standard ISO/IEC 18009 - Ada: Conformity
-- assessment of a language processor. This test suite should not be used
-- to make claims of conformance unless used in accordance with
-- ISO/IEC 18009 and any applicable ACAA procedures.
--*
--
-- OBJECTIVE:
-- Check that the boolean expression of a pragma Assert is evaluated
-- if the Assertion_Policy is Check, and Ada.Assertions.Assertion_Error
-- is raised if the expression is False.
--
-- Check that the optional message string in a pragma Assert whose
-- boolean expression evaluates to False 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.
--
-- TEST DESCRIPTION:
-- This test checks the handling of failed Assertions. We use expressions
-- for pragma Assert which fail if one of the arguments is outside of the
-- expected range.
--
-- We check that the optional message associated with a pragma Assert
-- can be retrieved from Ada.Exceptions.Exception_Message.
--
-- CHANGE HISTORY:
-- 25 Jan 16 RLB Created test.
--
--!
with Report;
with Ada.Exceptions;
with Ada.Assertions;
procedure CB42001 is
pragma Assertion_Policy (Check);
-- We always have to give the policy, as the default
-- is implementation-defined.
Assertion_Message_Prefix : constant String :=
"Wrong number of iterations=";
procedure Loop_Counter (Bound : in Integer) is
-- Try a pragma Assert in place of a statement.
Iters : Integer := 0;
begin
-- We simulate a algorithm where the author has forgotten about
-- the possibility of negative input values.
for Index in 1 .. Bound loop
Iters := Iters + 1;
end loop;
pragma Assert (Iters = Bound, Message =>
Assertion_Message_Prefix & Integer'Image(Iters));
if Report.Equal (Iters, 100) then
Report.Comment ("Century!"); -- Prevent optimization.
end if;
end Loop_Counter;
First_Call : Boolean := True;
function Random return Float is
-- Not really random! Simulating a random function.
begin
First_Call := not First_Call;
if not First_Call then
return 0.65;
else
return 0.05;
end if;
end Random;
function Get_Die_Roll return Positive is
Roll : Float := Random;
Result : Integer := Integer(Roll*6.0);
-- Simulating an off-by-one error; pragma Assert in place of
-- a declarative item.
pragma Assert (Result in 1 .. 6);
begin
return Result;
end Get_Die_Roll;
begin
Report.Test ("CB42001", "Check that the boolean expression of a pragma " &
"Assert is evaluated if the Assertion_Policy is " &
"Check, and Ada.Assertions.Assertion_Error is " &
"raised if the expression is False. Check that " &
"the optional message string in a pragma Assert " &
"whose boolean expression evaluates to False is " &
"associated with the raised exception occurrence");
Test_Block:
declare
My_Roll : Positive;
begin
-- Assertion succeeds:
begin
Loop_Counter (4);
exception
when Ugh : others =>
Report.Failed
("Unexpected exception, case 1: " &
Ada.Exceptions.Exception_Name(Ugh) &
" with message " & Ada.Exceptions.Exception_Message(Ugh));
end;
-- Assertion fails:
begin
Loop_Counter (-10);
Report.Failed ("Assertion_Error not raised by failing assertion, " &
"case 2");
exception
when Excptn : Ada.Assertions.Assertion_Error =>
if Ada.Exceptions.Exception_Message(Excptn) /=
Assertion_Message_Prefix & " 0" then
Report.Failed
("Case 2: Message captured from exception is not the " &
"message provided to the pragma Assert, saw: " &
Ada.Exceptions.Exception_Message(Excptn) &
"; expected: " & Assertion_Message_Prefix & " 0");
end if;
when Ugh : others =>
Report.Failed
("Unexpected exception, case 2: " &
Ada.Exceptions.Exception_Name(Ugh) &
" with message " & Ada.Exceptions.Exception_Message(Ugh));
end;
-- Assertion succeeds:
begin
My_Roll := Get_Die_Roll;
exception
when Ugh : others =>
Report.Failed
("Unexpected exception, case 3: " &
Ada.Exceptions.Exception_Name(Ugh));
end;
-- Assertion fails:
begin
My_Roll := Get_Die_Roll;
Report.Failed ("Assertion_Error not raised by failing assertion, " &
"case 4");
exception
when Excptn : Ada.Assertions.Assertion_Error =>
Report.Comment
("Case 4: Exception message was: " &
Ada.Exceptions.Exception_Message(Excptn));
when Ugh : others =>
Report.Failed
("Unexpected exception, case 4: " &
Ada.Exceptions.Exception_Name(Ugh) &
" with message " & Ada.Exceptions.Exception_Message(Ugh));
end;
-- Verify that the assertion message is carried even when the
-- exception is reraised.
begin
begin
Loop_Counter (-4);
Report.Failed ("Assertion_Error not raised by failing " &
"assertion, case 5");
exception
when Exc : Ada.Assertions.Assertion_Error =>
-- The exception is reraised here; message should propagate
-- with exception occurrence.
Ada.Exceptions.Reraise_Occurrence(Exc);
when others => Report.Failed ("Unusual exception raised - " &
"case 5 inner");
end;
Report.Failed ("Assertion_Error not propagated");
exception
when Excptn : Ada.Assertions.Assertion_Error =>
if Ada.Exceptions.Exception_Message(Excptn) /=
Assertion_Message_Prefix & " 0" then
Report.Failed
("Case 5: Message propagated with exception is not the " &
"message provided to the pragma Assert, saw: " &
Ada.Exceptions.Exception_Message(Excptn) &
"; expected: " & Assertion_Message_Prefix & " 0");
end if;
when others => Report.Failed ("Unusual exception raised - " &
"case 5 outer");
end;
exception
when others => Report.Failed ("Exception raised in Test_Block");
end Test_Block;
Report.Result;
end CB42001;
|
