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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cb/] [cb41002.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CB41002.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 the message string input parameter in a call to the
28
--      Raise_Exception procedure is associated with the raised exception
29
--      occurrence, and that the message string can be obtained using the
30
--      Exception_Message function with the associated Exception_Occurrence
31
--      object.  Check that Function Exception_Information is available
32
--      to provide implementation-defined information about the exception
33
--      occurrence.
34
--
35
-- TEST DESCRIPTION:
36
--      This test checks that a message associated with a raised exception
37
--      is propagated with the exception, and can be retrieved using the
38
--      Exception_Message function.  The exception will be raised using the
39
--      'Identity attribute as a parameter to the Raise_Exception procedure,
40
--      and an associated message string will be provided.  The exception
41
--      will be handled, and the message associated with the occurrence will
42
--      be compared to the original source message (non-default).
43
--
44
--      The test also includes a simulated logging procedure
45
--      (Check_Exception_Information) that checks that Exception_Information
46
--      can be called.
47
--
48
--
49
-- CHANGE HISTORY:
50
--      06 Dec 94   SAIC    ACVC 2.0
51
--      22 Jun 00   RLB     Added a check at Exception_Information can be
52
--                          called.
53
--
54
--!
55
 
56
with Report;
57
with Ada.Exceptions;
58
 
59
procedure CB41002 is
60
begin
61
 
62
   Report.Test ("CB41002", "Check that the message string input parameter " &
63
                           "in a call to the Raise_Exception procedure is " &
64
                           "associated with the raised exception "          &
65
                           "occurrence, and that the message string can "   &
66
                           "be obtained using the Exception_Message "       &
67
                           "function with the associated "                  &
68
                           "Exception_Occurrence object. Also check that "  &
69
                           "the Exception_Information function can be called");
70
 
71
   Test_Block:
72
   declare
73
 
74
      Number_Of_Exceptions : constant := 3;
75
 
76
      User_Exception_1,
77
      User_Exception_2,
78
      User_Exception_3 : exception;
79
 
80
      type String_Ptr is access String;
81
 
82
      User_Messages : constant array (1..Number_Of_Exceptions)
83
        of String_Ptr :=
84
        (new String'("Msg"),
85
         new String'("This message will override the default "   &
86
                     "message provided by the implementation"),
87
         new String'("The message can be captured by procedure"  & -- 200 chars
88
                      " Exception_Message.  It is designed to b" &
89
                      "e exactly 200 characters in length, sinc" &
90
                      "e there is a permission  concerning the " &
91
                      "truncation of a message over 200 chars. "));
92
 
93
      procedure Check_Exception_Information (
94
                 Occur : in Ada.Exceptions.Exception_Occurrence) is
95
          -- Simulates an error logging routine.
96
         Info : constant String :=
97
              Ada.Exceptions.Exception_Information (Occur);
98
         function Is_Substring_of (Target, Search : in String) return Boolean is
99
            -- Returns True if Search is a substring of Target, and False
100
            -- otherwise.
101
         begin
102
            for I in Report.Ident_Int(Target'First) ..
103
                     Target'Last - Search'Length + 1 loop
104
               if Target(I .. I+Search'Length-1) = Search then
105
                  return True;
106
               end if;
107
            end loop;
108
            return False;
109
         end Is_Substring_of;
110
      begin
111
         -- We can't display Info, as it often contains line breaks
112
         -- (confusing Report), and might look much like the failure of a test
113
         -- with an unhandled exception (thus confusing grading tools).
114
         --
115
         -- We don't particular care if the implementation advice is followed,
116
         -- but we make these checks to insure that a compiler cannot optimize
117
         -- away Info or the rest of this routine.
118
         if not Is_Substring_of (Info,
119
                       Ada.Exceptions.Exception_Name (Occur)) then
120
             Report.Comment ("Exception_Information does not contain " &
121
                             "Exception_Name - see 11.4.1(19)");
122
         elsif not Is_Substring_of (Info,
123
                       Ada.Exceptions.Exception_Message (Occur)) then
124
             Report.Comment ("Exception_Information does not contain " &
125
                             "Exception_Message - see 11.4.1(19)");
126
         end if;
127
      end Check_Exception_Information;
128
 
129
   begin
130
 
131
      for i in 1..Number_Of_Exceptions loop
132
         begin
133
 
134
            -- Raise a user-defined exception with a specific message string.
135
            case i is
136
               when 1 =>
137
                  Ada.Exceptions.Raise_Exception(User_Exception_1'Identity,
138
                                                 User_Messages(i).all);
139
               when 2 =>
140
                  Ada.Exceptions.Raise_Exception(User_Exception_2'Identity,
141
                                                 User_Messages(i).all);
142
               when 3 =>
143
                  Ada.Exceptions.Raise_Exception(User_Exception_3'Identity,
144
                                                 User_Messages(i).all);
145
               when others =>
146
                  Report.Failed("Incorrect result from Case statement");
147
            end case;
148
 
149
            Report.Failed
150
              ("Exception not raised by procedure Exception_With_Message " &
151
               "for User_Exception #" & Integer'Image(i));
152
 
153
         exception
154
            when Excptn : others =>
155
 
156
               begin
157
                  -- The message that is associated with the raising of each
158
                  -- exception is captured here using the Exception_Message
159
                  -- function.
160
 
161
                  if User_Messages(i).all /=
162
                     Ada.Exceptions.Exception_Message(Excptn)
163
                  then
164
                     Report.Failed
165
                       ("Message captured from exception is not the "  &
166
                        "message provided when the exception was raised, " &
167
                        "User_Exception #" & Integer'Image(i));
168
                  end if;
169
 
170
                  Check_Exception_Information(Excptn);
171
               end;
172
         end;
173
      end loop;
174
 
175
 
176
 
177
      -- Verify that the exception specific message is carried across
178
      -- various boundaries:
179
 
180
      begin
181
 
182
         begin
183
            Ada.Exceptions.Raise_Exception(User_Exception_1'Identity,
184
                                           User_Messages(1).all);
185
            Report.Failed("User_Exception_1 not raised");
186
         end;
187
         Report.Failed("User_Exception_1 not propagated");
188
      exception
189
         when Excptn : User_Exception_1 =>
190
 
191
            if User_Messages(1).all /=
192
               Ada.Exceptions.Exception_Message(Excptn)
193
            then
194
               Report.Failed("User_Message_1 not found");
195
            end if;
196
            Check_Exception_Information(Excptn);
197
 
198
         when others => Report.Failed("Unexpected exception handled - 1");
199
      end;
200
 
201
 
202
 
203
      begin
204
 
205
         begin
206
            Ada.Exceptions.Raise_Exception(User_Exception_2'Identity,
207
                                           User_Messages(2).all);
208
            Report.Failed("User_Exception_2 not raised");
209
         exception
210
            when Exc : User_Exception_2 =>
211
 
212
               -- The exception is reraised here; message should propagate
213
               -- with exception occurrence.
214
 
215
               Ada.Exceptions.Reraise_Occurrence(Exc);
216
            when others => Report.Failed("User_Exception_2 not handled");
217
         end;
218
         Report.Failed("User_Exception_2 not propagated");
219
      exception
220
         when Excptn : User_Exception_2 =>
221
 
222
            if User_Messages(2).all /=
223
               Ada.Exceptions.Exception_Message(Excptn)
224
            then
225
               Report.Failed("User_Message_2 not found");
226
            end if;
227
            Check_Exception_Information(Excptn);
228
 
229
         when others => Report.Failed("Unexpected exception handled - 2");
230
      end;
231
 
232
 
233
      -- Check exception and message propagation across task boundaries.
234
 
235
      declare
236
 
237
         task Raise_An_Exception is  -- single task
238
            entry Raise_It;
239
         end Raise_An_Exception;
240
 
241
         task body Raise_An_Exception is
242
         begin
243
            accept Raise_It do
244
               Ada.Exceptions.Raise_Exception(User_Exception_3'Identity,
245
                                              User_Messages(3).all);
246
            end Raise_It;
247
            Report.Failed("User_Exception_3 not raised");
248
         exception
249
            when Excptn : User_Exception_3 =>
250
               if User_Messages(3).all /=
251
                  Ada.Exceptions.Exception_Message(Excptn)
252
               then
253
                  Report.Failed
254
                    ("User_Message_3 not returned inside task body");
255
               end if;
256
               Check_Exception_Information(Excptn);
257
            when others =>
258
               Report.Failed("Incorrect exception raised in task body");
259
         end Raise_An_Exception;
260
 
261
      begin
262
         Raise_An_Exception.Raise_It;  -- Exception will be propagated here.
263
         Report.Failed("User_Exception_3 not propagated to caller");
264
      exception
265
         when Excptn : User_Exception_3 =>
266
            if User_Messages(3).all /=
267
               Ada.Exceptions.Exception_Message(Excptn)
268
            then
269
               Report.Failed("User_Message_3 not returned to caller of task");
270
            end if;
271
            Check_Exception_Information(Excptn);
272
         when others =>
273
            Report.Failed("Incorrect exception raised by task");
274
      end;
275
 
276
 
277
   exception
278
      when others => Report.Failed ("Exception raised in Test_Block");
279
   end Test_Block;
280
 
281
   Report.Result;
282
 
283
end CB41002;

powered by: WebSVN 2.1.0

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