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
|
-- CB40A01.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 a user defined exception is correctly propagated out of
-- a public child package.
--
-- TEST DESCRIPTION:
-- Declare a public child package containing a procedure used to
-- analyze the alphanumeric content of a particular text string.
-- The procedure contains a processing loop that continues until the
-- range of the text string is exceeded, at which time a user defined
-- exception is raised. This exception propagates out of the procedure
-- through the parent package, to the main test program.
--
-- Exception Type Raised:
-- * User Defined
-- Predefined
--
-- Hierarchical Structure Employed For This Test:
-- * Parent Package
-- * Public Child Package
-- Private Child Package
-- Public Child Subprogram
-- Private Child Subprogram
--
-- TEST FILES:
-- This test depends on the following foundation code:
-- FB40A00.A
--
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
package FB40A00.CB40A01_0 is -- package Text_Parser.Processing
procedure Process_Text (Text : in String_Pointer_Type);
end FB40A00.CB40A01_0;
--=================================================================--
with Report;
package body FB40A00.CB40A01_0 is
procedure Process_Text (Text : in String_Pointer_Type) is
Pos : Natural := Text'First - 1;
begin
loop -- Process string, raise exception upon completion.
Pos := Pos + 1;
if Pos > Text.all'Last then
raise Completed_Text_Processing;
elsif (Text.all (Pos) in 'A' .. 'Z') or
(Text.all (Pos) in 'a' .. 'z') or
(Text.all (Pos) in '0' .. '9') then
Increment_AlphaNumeric_Count;
else
Increment_Non_AlphaNumeric_Count;
end if;
end loop;
-- No exception handler here, exception propagates.
Report.Failed ("No exception raised in child package subprogram");
end Process_Text;
end FB40A00.CB40A01_0;
--=================================================================--
with FB40A00.CB40A01_0;
with Report;
procedure CB40A01 is
String_Pointer : FB40A00.String_Pointer_Type :=
new String'("'Twas the night before Christmas, " &
"and all through the house...");
begin
Process_Block:
begin
Report.Test ("CB40A01", "Check that a user defined exception " &
"is correctly propagated out of a " &
"public child package");
FB40A00.CB40A01_0.Process_Text (String_Pointer);
Report.Failed ("Exception should have been handled");
exception
when FB40A00.Completed_Text_Processing => -- Correct exception
if FB40A00.AlphaNumeric_Count /= 48 then -- propagation.
Report.Failed ("Incorrect string processing");
end if;
when others =>
Report.Failed ("Exception handled in an others handler");
end Process_Block;
Report.Result;
end CB40A01;
|
