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/] [cb/] [cb40a01.a] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CB40A01.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 a user defined exception is correctly propagated out of
28
--      a public child package.
29
--
30
-- TEST DESCRIPTION:
31
--      Declare a public child package containing a procedure used to
32
--      analyze the alphanumeric content of a particular text string.
33
--      The procedure contains a processing loop that continues until the
34
--      range of the text string is exceeded, at which time a user defined
35
--      exception is raised.  This exception propagates out of the procedure
36
--      through the parent package, to the main test program.
37
--
38
--      Exception Type Raised:
39
--        * User Defined
40
--          Predefined
41
--
42
--      Hierarchical Structure Employed For This Test:
43
--        * Parent Package
44
--        * Public Child Package
45
--          Private Child Package
46
--          Public Child Subprogram
47
--          Private Child Subprogram
48
--
49
-- TEST FILES:
50
--      This test depends on the following foundation code:
51
--         FB40A00.A
52
--
53
--
54
-- CHANGE HISTORY:
55
--      06 Dec 94   SAIC    ACVC 2.0
56
--
57
--!
58
 
59
 
60
package FB40A00.CB40A01_0 is    -- package Text_Parser.Processing
61
 
62
   procedure Process_Text (Text : in String_Pointer_Type);
63
 
64
end FB40A00.CB40A01_0;
65
 
66
 
67
     --=================================================================--
68
 
69
 
70
with Report;
71
 
72
package body FB40A00.CB40A01_0 is
73
 
74
   procedure Process_Text (Text : in String_Pointer_Type) is
75
      Pos : Natural := Text'First - 1;
76
   begin
77
      loop   -- Process string, raise exception upon completion.
78
         Pos := Pos + 1;
79
         if Pos > Text.all'Last then
80
            raise Completed_Text_Processing;
81
         elsif (Text.all (Pos) in 'A' .. 'Z') or
82
               (Text.all (Pos) in 'a' .. 'z') or
83
               (Text.all (Pos) in '0' .. '9') then
84
            Increment_AlphaNumeric_Count;
85
         else
86
            Increment_Non_AlphaNumeric_Count;
87
         end if;
88
      end loop;
89
      -- No exception handler here, exception propagates.
90
      Report.Failed ("No exception raised in child package subprogram");
91
   end Process_Text;
92
 
93
end FB40A00.CB40A01_0;
94
 
95
 
96
     --=================================================================--
97
 
98
 
99
with FB40A00.CB40A01_0;
100
with Report;
101
 
102
procedure CB40A01 is
103
 
104
   String_Pointer : FB40A00.String_Pointer_Type :=
105
     new String'("'Twas the night before Christmas, " &
106
                 "and all through the house...");
107
 
108
begin
109
 
110
   Process_Block:
111
   begin
112
 
113
      Report.Test ("CB40A01", "Check that a user defined exception " &
114
                              "is correctly propagated out of a "    &
115
                              "public child package");
116
 
117
      FB40A00.CB40A01_0.Process_Text (String_Pointer);
118
 
119
      Report.Failed ("Exception should have been handled");
120
 
121
   exception
122
 
123
      when FB40A00.Completed_Text_Processing =>      -- Correct exception
124
         if FB40A00.AlphaNumeric_Count /= 48 then    -- propagation.
125
            Report.Failed ("Incorrect string processing");
126
         end if;
127
 
128
      when others =>
129
         Report.Failed ("Exception handled in an others handler");
130
 
131
   end Process_Block;
132
 
133
   Report.Result;
134
 
135
end CB40A01;

powered by: WebSVN 2.1.0

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