aboutsummaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats-4/tests/cb/cb30001.a
blob: 10572299194ffa23b2b78e06a5aa063850759c6f (plain)
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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
-- CB30001.A
--
--                             Grant of Unlimited Rights
--
--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
--     rights in the software and documentation contained herein. Unlimited
--     rights are the same as those granted by the U.S. Government for older
--     parts of the Ada Conformity Assessment Test Suite, and are defined
--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
--     intends to confer upon all recipients unlimited rights equal to those
--     held by the ACAA. 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 ACAA 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.
--
--                                     Notice
--
--     The ACAA has created and maintains the Ada Conformity Assessment Test
--     Suite for the purpose of conformity assessments conducted in accordance
--     with the International Standard ISO/IEC 18009 - Ada: Conformity
--     assessment of a language processor. This test suite should not be used
--     to make claims of conformance unless used in accordance with
--     ISO/IEC 18009 and any applicable ACAA procedures.
--*
--
-- OBJECTIVE:
--      Check that the optional message string in a raise statement is
--      associated with the raised exception occurrence, and that the message
--      string can be obtained using the Exception_Message function with the
--      associated Exception_Occurrence object.
--
-- TEST DESCRIPTION:
--      This test checks that a message associated with a raised exception
--      is propagated with the exception, and can be retrieved using the
--      Exception_Message function.  The exception will be raised using
--      a raise statement with an associated message string.  The exception
--      will be handled, and the message associated with the occurrence will
--      be compared to the original source message (non-default).
--
--
-- CHANGE HISTORY:
--      20 Nov 14   RLB     Created test from existing CB41002 test.
--
--!

with Report;
with Ada.Exceptions;

procedure CB30001 is
begin

   Report.Test ("CB30001", "Check that the optional message string in a "   &
                           "raise statement is "                            &
                           "associated with the raised exception "          &
                           "occurrence, and that the message string can "   &
                           "be obtained using the Exception_Message "       &
                           "function with the associated "                  &
                           "Exception_Occurrence object");

   Test_Block:
   declare

      Number_Of_Exceptions : constant := 3;

      User_Exception_1,
      User_Exception_2,
      User_Exception_3 : exception;

      type String_Ptr is access String;

      User_Messages : constant array (1..Number_Of_Exceptions+1)
        of String_Ptr :=
        (new String'("Msg"),
         new String'("This message will override the default "   &
                     "message provided by the implementation"),
         new String'("The message can be captured by procedure"  & -- 200 chars
                      " Exception_Message.  It is designed to b" &
                      "e exactly 200 characters in length, sinc" &
                      "e there is a permission  concerning the " &
                      "truncation of a message over 200 chars. "),
         new String'("A different message than the one usually " &
                     "associated with this exception."));

   begin

      for i in 1..Number_Of_Exceptions loop
         begin

            -- Raise a user-defined exception with a specific message string.
            case i is
               when 1 =>
                  raise User_Exception_1 with User_Messages(i).all;
               when 2 =>
                  raise User_Exception_2 with User_Messages(i).all;
               when 3 =>
                  raise User_Exception_3 with User_Messages(i).all;
               when others =>
                  Report.Failed("Incorrect result from Case statement");
            end case;

            Report.Failed
              ("Exception not raised by raise statement " &
               "for User_Exception #" & Integer'Image(i));

         exception
            when Excptn : others =>

               begin
                  -- The message that is associated with the raising of each
                  -- exception is captured here using the Exception_Message
                  -- function.

                  if User_Messages(i).all /=
                     Ada.Exceptions.Exception_Message(Excptn)
                  then
                     Report.Failed
                       ("Message captured from exception is not the "  &
                        "message provided when the exception was raised, " &
                        "User_Exception #" & Integer'Image(i));
                  end if;
               end;
         end;
      end loop;



      -- Verify that the exception specific message is carried across
      -- various boundaries:

      begin

         begin
            raise User_Exception_1 with User_Messages(1).all;
            Report.Failed("User_Exception_1 not raised");
         end;
         Report.Failed("User_Exception_1 not propagated");
      exception
         when Excptn : User_Exception_1 =>

            if User_Messages(1).all /=
               Ada.Exceptions.Exception_Message(Excptn)
            then
               Report.Failed("User_Message_1 not found");
            end if;

         when others => Report.Failed("Unexpected exception handled - 1");
      end;


      begin

         begin
            raise User_Exception_2 with User_Messages(4).all;
            Report.Failed("User_Exception_2 not raised");
         exception
            when Exc : User_Exception_2 =>

               -- The exception is reraised here; message should propagate
               -- with exception occurrence.

               Ada.Exceptions.Reraise_Occurrence(Exc);
            when others => Report.Failed("User_Exception_2 not handled");
         end;
         Report.Failed("User_Exception_2 not propagated");
      exception
         when Excptn : User_Exception_2 =>

            if User_Messages(4).all /=
               Ada.Exceptions.Exception_Message(Excptn)
            then
               Report.Failed("User_Message_4 not found");
            end if;

         when others => Report.Failed("Unexpected exception handled - 2");
      end;


      -- Check exception and message propagation across task boundaries.

      declare

         task Raise_An_Exception is  -- single task
            entry Raise_It;
         end Raise_An_Exception;

         task body Raise_An_Exception is
         begin
            accept Raise_It do
               raise User_Exception_3 with User_Messages(2).all;
            end Raise_It;
            Report.Failed("User_Exception_3 not raised");
         exception
            when Excptn : User_Exception_3 =>
               if User_Messages(2).all /=
                  Ada.Exceptions.Exception_Message(Excptn)
               then
                  Report.Failed
                    ("User_Message_2 not returned inside task body");
               end if;
            when others =>
               Report.Failed("Incorrect exception raised in task body");
         end Raise_An_Exception;

      begin
         Raise_An_Exception.Raise_It;  -- Exception will be propagated here.
         Report.Failed("User_Exception_3 not propagated to caller");
      exception
         when Excptn : User_Exception_3 =>
            if User_Messages(2).all /=
               Ada.Exceptions.Exception_Message(Excptn)
            then
               Report.Failed("User_Message_3 not returned to caller of task");
            end if;
         when others =>
            Report.Failed("Incorrect exception raised by task");
      end;


   exception
      when others => Report.Failed ("Exception raised in Test_Block");
   end Test_Block;

   Report.Result;

end CB30001;