1-- CB41004.A
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--
26-- OBJECTIVE:
27--      Check that Raise_Exception and Reraise_Occurrence have no effect in
28--      the case of Null_Id or Null_Occurrence.  Check that Exception_Message,
29--      Exception_Identity, Exception_Name, and Exception_Information raise
30--      Constraint_Error for a Null_Occurrence input parameter.
31--      Check that calling the Save_Occurrence subprograms with the
32--      Null_Occurrence input parameter saves the Null_Occurrence to the
33--      appropriate target object, and does not raise Constraint_Error.
34--      Check that Null_Id is the default initial value of type Exception_Id.
35--
36-- TEST DESCRIPTION:
37--      This test performs a series of calls to many of the subprograms
38--      defined in package Ada.Exceptions, using either Null_Id or
39--      Null_Occurrence (based on their parameter profile).  In the cases of
40--      Raise_Exception and Reraise_Occurrence, these null input values
41--      should result in no exceptions being raised, and Constraint_Error
42--      should not be raised in response to these calls.  Test failure will
43--      result if any exception is raised in these cases.
44--      For the Save_Occurrence subprograms, calling them with the
45--      Null_Occurrence input parameter does not raise Constraint_Error, but
46--      simply results in the Null_Occurrence being saved into the appropriate
47--      target (either a Exception_Occurrence out parameter, or as an
48--      Exception_Occurrence_Access value).
49--      In the cases of the other mentioned subprograms, calls performed with
50--      a Null_Occurrence input parameter must result in Constraint_Error
51--      being raised.  This exception will be handled, with test failure the
52--      result if the exception is not raised.
53--
54--
55-- CHANGE HISTORY:
56--      06 Dec 94   SAIC    ACVC 2.0
57--      08 Dec 00   RLB     Removed Exception_Identity subtest, pending
58--                          resolution of AI95-00241.
59--      29 Mar 07   RLB     Replaced Exception_Identity subtest, repaired
60--                          Raise_Exception subtest for AI95-00446.
61--!
62
63with Report;
64with Ada.Exceptions;
65
66procedure CB41004 is
67begin
68
69   Report.Test ("CB41004", "Check that Null_Id and Null_Occurrence input " &
70                           "parameters have the appropriate effect when "  &
71                           "used in calls of the subprograms found in "    &
72                           "package Ada.Exceptions");
73
74   Test_Block:
75   declare
76
77      use Ada.Exceptions;
78
79      -- No initial values given for these two declarations; they default
80      -- to Null_Id and Null_Occurrence respectively.
81      A_Null_Exception_Id         : Ada.Exceptions.Exception_Id;
82      A_Null_Exception_Occurrence : Ada.Exceptions.Exception_Occurrence;
83
84      TC_Flag : Boolean := False;
85
86   begin
87
88      -- Verify that Null_Id is the default initial value of type
89      -- Exception_Id.
90
91      if not (A_Null_Exception_Id = Ada.Exceptions.Null_Id) then
92         Report.Failed("The default initial value of an object of type " &
93                       "Exception_Id was not Null_Id");
94      end if;
95
96
97      -- Verify that Raise_Exception has no effect in the case of Null_Id.
98      -- Modified by AI-446.
99      begin
100         Ada.Exceptions.Raise_Exception(A_Null_Exception_Id);
101         Report.Comment(
102           "No exception raised by procedure Raise_Exception " &
103           "when called with a Null_Id input parameter - compatible with " &
104           "original Ada95");
105      exception
106         when Constraint_Error => null; -- OK, expected exception.
107            Report.Comment(
108               "Constraint_Error exception raised by procedure Raise_Exception " &
109               "when called with a Null_Id input parameter - compatible with " &
110               "AI95-00446");
111         when others =>
112            Report.Failed(
113               "Unexpected exception raised by procedure Raise_Exception " &
114               "when called with a Null_Id input parameter");
115      end;
116
117      TC_Flag := False;
118
119
120      -- Verify that Reraise_Occurrence has no effect in the case of
121      -- Null_Occurrence.
122      begin
123         Ada.Exceptions.Reraise_Occurrence(A_Null_Exception_Occurrence);
124         TC_Flag := True;
125      exception
126         when others =>
127            Report.Failed
128              ("Exception raised by procedure Reraise_Occurrence " &
129               "when called with a Null_Occurrence input parameter");
130      end;
131
132      if not TC_Flag then
133         Report.Failed("Incorrect processing following the call to " &
134                       "Reraise_Occurrence with a Null_Occurrence "  &
135                       "input parameter");
136      end if;
137
138
139      -- Verify that function Exception_Message raises Constraint_Error for
140      -- a Null_Occurrence input parameter.
141      begin
142         declare
143            Msg : constant String :=
144              Ada.Exceptions.Exception_Message(A_Null_Exception_Occurrence);
145         begin
146            Report.Failed
147              ("Constraint_Error not raised by Function Exception_Message " &
148               "when called with a Null_Occurrence input parameter");
149         end;
150      exception
151         when Constraint_Error => null; -- OK, expected exception.
152         when others =>
153            Report.Failed
154              ("Unexpected exception raised by Function Exception_Message " &
155               "when called with a Null_Occurrence input parameter");
156      end;
157
158
159      -- Verify that function Exception_Identity raises Constraint_Error for
160      -- a Null_Occurrence input parameter.
161      -- Modified by AI-241.
162      begin
163         declare
164            Id : Ada.Exceptions.Exception_Id :=
165              Ada.Exceptions.Exception_Identity(A_Null_Exception_Occurrence);
166         begin
167            Report.Comment
168              ("No exception raised by Function Exception_Identity " &
169               "when called with a Null_Occurrence input parameter - " &
170               "compatible with AI95-00241.");
171         end;
172      exception
173         when Constraint_Error =>
174            Report.Comment
175              ("Constraint_Error raised by Function Exception_Identity " &
176               "when called with a Null_Occurrence input parameter - " &
177               "compatible with original Ada95.");
178         when others =>
179            Report.Failed
180              ("Unexpected exception raised by Function Exception_Identity " &
181               "when called with a Null_Occurrence input parameter");
182      end;
183
184
185      -- Verify that function Exception_Name raises Constraint_Error for
186      -- a Null_Occurrence input parameter.
187      begin
188         declare
189            Name : constant String :=
190              Ada.Exceptions.Exception_Name(A_Null_Exception_Occurrence);
191         begin
192            Report.Failed
193              ("Constraint_Error not raised by Function Exception_Name " &
194               "when called with a Null_Occurrence input parameter");
195         end;
196      exception
197         when Constraint_Error => null; -- OK, expected exception.
198         when others =>
199            Report.Failed
200              ("Unexpected exception raised by Function Exception_Null " &
201               "when called with a Null_Occurrence input parameter");
202      end;
203
204
205      -- Verify that function Exception_Information raises Constraint_Error
206      -- for a Null_Occurrence input parameter.
207      begin
208         declare
209            Info : constant String :=
210              Ada.Exceptions.Exception_Information
211                               (A_Null_Exception_Occurrence);
212         begin
213            Report.Failed
214              ("Constraint_Error not raised by Function "  &
215               "Exception_Information when called with a " &
216               "Null_Occurrence input parameter");
217         end;
218      exception
219         when Constraint_Error => null; -- OK, expected exception.
220         when others =>
221            Report.Failed
222              ("Unexpected exception raised by Function Exception_Null " &
223               "when called with a Null_Occurrence input parameter");
224      end;
225
226
227      -- Verify that calling the Save_Occurrence procedure with a
228      -- Null_Occurrence input parameter saves the Null_Occurrence to the
229      -- target object, and does not raise Constraint_Error.
230      declare
231         use Ada.Exceptions;
232         Saved_Occurrence : Exception_Occurrence;
233      begin
234
235         -- Initialize the Saved_Occurrence variable with a value other than
236         -- Null_Occurrence (default).
237         begin
238            raise Program_Error;
239         exception
240            when Exc : others => Save_Occurrence(Saved_Occurrence, Exc);
241         end;
242
243         -- Save a Null_Occurrence input parameter.
244         begin
245            Save_Occurrence(Target => Saved_Occurrence,
246                            Source => Ada.Exceptions.Null_Occurrence);
247         exception
248            when others =>
249               Report.Failed
250                 ("Unexpected exception raised by procedure "           &
251                  "Save_Occurrence when called with a Null_Occurrence " &
252                  "input parameter");
253         end;
254
255         -- Verify that the occurrence that was saved above is a
256         -- Null_Occurrence value.
257
258         begin
259            Reraise_Occurrence(Saved_Occurrence);
260         exception
261            when others =>
262               Report.Failed("Value saved from Procedure Save_Occurrence " &
263                             "resulted in an exception, i.e., was not a "  &
264                             "value of Null_Occurrence");
265         end;
266
267      exception
268         when others =>
269            Report.Failed("Unexpected exception raised during evaluation " &
270                          "of Procedure Save_Occurrence");
271      end;
272
273
274      -- Verify that calling the Save_Occurrence function with a
275      -- Null_Occurrence input parameter returns the Null_Occurrence as the
276      -- function result, and does not raise Constraint_Error.
277      declare
278         Occurrence_Ptr : Ada.Exceptions.Exception_Occurrence_Access;
279      begin
280         -- Save a Null_Occurrence input parameter.
281         begin
282            Occurrence_Ptr :=
283              Ada.Exceptions.Save_Occurrence(Ada.Exceptions.Null_Occurrence);
284         exception
285            when others =>
286               Report.Failed
287                 ("Unexpected exception raised by function "            &
288                  "Save_Occurrence when called with a Null_Occurrence " &
289                  "input parameter");
290         end;
291
292         -- Verify that the occurrence that was saved above is a
293         -- Null_Occurrence value.
294
295         begin
296            -- Dereferenced value of type Exception_Occurrence_Access
297            -- should be a Null_Occurrence value, based on the action
298            -- of Function Save_Occurrence above.  Providing this as an
299            -- input parameter to Reraise_Exception should not result in
300            -- any exception being raised.
301
302            Ada.Exceptions.Reraise_Occurrence(Occurrence_Ptr.all);
303
304         exception
305            when others =>
306               Report.Failed("Value saved from Function Save_Occurrence " &
307                             "resulted in an exception, i.e., was not a "  &
308                             "value of Null_Occurrence");
309         end;
310      exception
311         when others =>
312            Report.Failed("Unexpected exception raised during evaluation " &
313                          "of Function Save_Occurrence");
314      end;
315
316
317
318   exception
319      when others => Report.Failed ("Exception raised in Test_Block");
320   end Test_Block;
321
322   Report.Result;
323
324end CB41004;
325