OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cb/] [cb20004.a] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CB20004.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 exceptions propagate correctly from objects of
28
--      protected types. Check propagation from protected entry bodies.
29
--
30
-- TEST DESCRIPTION:
31
--      Declare a package with a protected type, including entries and private
32
--      data, simulating a bounded buffer abstraction.  In the main procedure,
33
--      perform entry calls on an object of the protected type that raises
34
--      exceptions.
35
--      Ensure that the exceptions are:
36
--         1) raised and handled locally in the entry body
37
--         2) raised in the entry body and handled/reraised to be handled
38
--            by the caller.
39
--         3) raised in the entry body and propagated directly to the calling
40
--            procedure.
41
--
42
--
43
-- CHANGE HISTORY:
44
--      06 Dec 94   SAIC    ACVC 2.0
45
--
46
--!
47
 
48
package CB20004_0 is               -- Package Buffer.
49
 
50
   Max_Buffer_Size       : constant := 2;
51
 
52
   Handled_In_Body,
53
   Propagated_To_Caller,
54
   Handled_In_Caller     : Boolean := False;
55
 
56
   Data_Over_5,
57
   Data_Degradation      : exception;
58
 
59
   type Data_Item is range 0 .. 100;
60
 
61
   type Item_Array_Type is array (1 .. Max_Buffer_Size) of Data_Item;
62
 
63
   protected type Bounded_Buffer is
64
      entry Put (Item : in     Data_Item);
65
      entry Get (Item :    out Data_Item);
66
   private
67
      Item_Array : Item_Array_Type;
68
      I, J       : Integer range 1 .. Max_Buffer_Size := 1;
69
      Count      : Integer range 0 .. Max_Buffer_Size := 0;
70
   end Bounded_Buffer;
71
 
72
end CB20004_0;
73
 
74
     --=================================================================--
75
 
76
with Report;
77
 
78
package body CB20004_0 is               -- Package Buffer.
79
 
80
   protected body Bounded_Buffer is
81
 
82
      entry Put (Item : in Data_Item) when Count < Max_Buffer_Size is
83
      begin
84
         if Item > 10 then
85
            Item_Array (I) := Item * 8;  -- Constraint_Error will be raised
86
         elsif Item > 5 then             -- and handled in entry body.
87
            raise Data_Over_5;           -- Exception  handled/reraised in
88
         else                            -- entry body, propagated to caller.
89
            Item_Array (I) := Item;      -- Store data item in buffer.
90
            I := (I mod Max_Buffer_Size) + 1;
91
            Count := Count + 1;
92
         end if;
93
      exception
94
         when Constraint_Error =>
95
            Handled_In_Body := True;
96
         when Data_Over_5 =>
97
            Propagated_To_Caller := True;
98
            raise;    -- Propagate the exception to the caller.
99
      end Put;
100
 
101
 
102
      entry Get (Item : out Data_Item) when Count > 0 is
103
      begin
104
         Item := Item_Array(J);
105
         J := (J mod Max_Buffer_Size) + 1;
106
         Count := Count - 1;
107
         if Count = 0 then
108
            raise Data_Degradation;   -- Exception to propagate to caller.
109
         end if;
110
      end Get;
111
 
112
   end Bounded_Buffer;
113
 
114
end CB20004_0;
115
 
116
 
117
     --=================================================================--
118
 
119
 
120
with CB20004_0;                   -- Package Buffer.
121
with Report;
122
 
123
procedure CB20004 is
124
 
125
   package Buffer renames CB20004_0;
126
 
127
   Data        : Buffer.Data_Item := Buffer.Data_Item'First;
128
   Data_Buffer : Buffer.Bounded_Buffer;   -- an object of protected type.
129
 
130
   Handled_In_Caller : Boolean := False;  -- same name as boolean declared
131
                                          -- in package Buffer.
132
begin
133
 
134
   Report.Test ("CB20004", "Check that exceptions propagate correctly " &
135
                           "from objects of protected types" );
136
 
137
   Initial_Data_Block:
138
   begin                                    -- Data causes Constraint_Error.
139
      Data_Buffer.Put (CB20004_0.Data_Item(Report.Ident_Int(51)));
140
 
141
   exception
142
      when Constraint_Error =>
143
         Buffer.Handled_In_Body := False;     -- Improper exception handling
144
                                              -- in entry body.
145
         Report.Failed ("Exception propagated to caller " &
146
                        " from Initial_Data_Block");
147
      when others =>
148
         Report.Failed ("Exception raised in processing and " &
149
                        "propagated to caller from Initial_Data_Block");
150
   end Initial_Data_Block;
151
 
152
 
153
   Data_Entry_Block:
154
   begin
155
                                              -- Valid data. No exception.
156
      Data_Buffer.Put (CB20004_0.Data_Item(Report.Ident_Int(3)));
157
 
158
                                              -- Data will cause exception.
159
      Data_Buffer.Put (7);                    -- Call protected object entry,
160
                                              -- exception to be handled/
161
                                              -- reraised in entry body.
162
      Report.Failed ("Data_Over_5 Exception not raised in processing");
163
   exception
164
      when Buffer.Data_Over_5 =>
165
         if Buffer.Propagated_To_Caller then   -- Reraised in entry body?
166
            Buffer.Handled_In_Caller := True;
167
         else
168
            Report.Failed ("Exception not reraised in entry body");
169
         end if;
170
      when others =>
171
         Report.Failed ("Exception raised in processing and propagated " &
172
                        "to caller from Data_Entry_Block");
173
   end Data_Entry_Block;
174
 
175
 
176
   Data_Retrieval_Block:
177
   begin
178
 
179
      Data_Buffer.Get (Data);  -- Retrieval of buffer data, buffer now empty.
180
                               -- Exception will be raised in entry body, with
181
                               -- propagation to caller.
182
      Report.Failed ("Data_Degradation Exception not raised in processing");
183
   exception
184
      when Buffer.Data_Degradation =>
185
         Handled_In_Caller := True;   -- Local Boolean used here.
186
      when others =>
187
         Report.Failed ("Exception raised in processing and propagated " &
188
                        "to caller from Data_Retrieval_Block");
189
   end Data_Retrieval_Block;
190
 
191
 
192
   if not (Buffer.Handled_In_Body      and    -- Validate proper exception
193
           Buffer.Propagated_To_Caller and    -- handling in entry bodies.
194
           Buffer.Handled_In_Caller    and
195
           Handled_In_Caller)
196
   then
197
      Report.Failed ("Improper exception handling by entry bodies");
198
   end if;
199
 
200
 
201
   Report.Result;
202
 
203
end CB20004;

powered by: WebSVN 2.1.0

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