gcc/testsuite/ada/acats/tests/cb/cb41004.a

   1 -- CB41004.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 Raise_Exception and Reraise_Occurrence have no effect in
  28 --      the case of Null_Id or Null_Occurrence.  Check that Exception_Message,
  29 --      Exception_Identity, Exception_Name, and Exception_Information raise
  30 --      Constraint_Error for a Null_Occurrence input parameter.
  31 --      Check that calling the Save_Occurrence subprograms with the
  32 --      Null_Occurrence input parameter saves the Null_Occurrence to the
  33 --      appropriate target object, and does not raise Constraint_Error.
  34 --      Check that Null_Id is the default initial value of type Exception_Id.
  35 --
  36 -- TEST DESCRIPTION:
  37 --      This test performs a series of calls to many of the subprograms
  38 --      defined in package Ada.Exceptions, using either Null_Id or
  39 --      Null_Occurrence (based on their parameter profile).  In the cases of
  40 --      Raise_Exception and Reraise_Occurrence, these null input values
  41 --      should result in no exceptions being raised, and Constraint_Error
  42 --      should not be raised in response to these calls.  Test failure will
  43 --      result if any exception is raised in these cases.
  44 --      For the Save_Occurrence subprograms, calling them with the
  45 --      Null_Occurrence input parameter does not raise Constraint_Error, but
  46 --      simply results in the Null_Occurrence being saved into the appropriate
  47 --      target (either a Exception_Occurrence out parameter, or as an
  48 --      Exception_Occurrence_Access value).
  49 --      In the cases of the other mentioned subprograms, calls performed with
  50 --      a Null_Occurrence input parameter must result in Constraint_Error
  51 --      being raised.  This exception will be handled, with test failure the
  52 --      result if the exception is not raised.
  53 --
  54 --
  55 -- CHANGE HISTORY:
  56 --      06 Dec 94   SAIC    ACVC 2.0
  57 --      08 Dec 00   RLB     Removed Exception_Identity subtest, pending
  58 --                          resolution of AI95-00241.
  59 --                          Notes for future: Replace Exception_Identity
  60 --                          subtest with whatever the resolution is.
  61 --                          Add a subtest for Exception_Name(Null_Id), which
  62 --                          is missing from this test.
  63 --!
  64
  65 with Report;
  66 with Ada.Exceptions;
  67
  68 procedure CB41004 is
  69 begin
  70
  71    Report.Test ("CB41004", "Check that Null_Id and Null_Occurrence input " &
  72                            "parameters have the appropriate effect when "  &
  73                            "used in calls of the subprograms found in "    &
  74                            "package Ada.Exceptions");
  75
  76    Test_Block:
  77    declare
  78
  79       use Ada.Exceptions;
  80
  81       -- No initial values given for these two declarations; they default
  82       -- to Null_Id and Null_Occurrence respectively.
  83       A_Null_Exception_Id         : Ada.Exceptions.Exception_Id;
  84       A_Null_Exception_Occurrence : Ada.Exceptions.Exception_Occurrence;
  85
  86       TC_Flag : Boolean := False;
  87
  88    begin
  89
  90       -- Verify that Null_Id is the default initial value of type
  91       -- Exception_Id.
  92
  93       if not (A_Null_Exception_Id = Ada.Exceptions.Null_Id) then
  94          Report.Failed("The default initial value of an object of type " &
  95                        "Exception_Id was not Null_Id");
  96       end if;
  97
  98
  99       -- Verify that Reraise_Occurrence has no effect in the case of
 100       -- Null_Occurrence.
 101       begin
 102          Ada.Exceptions.Reraise_Occurrence(A_Null_Exception_Occurrence);
 103          TC_Flag := True;
 104       exception
 105          when others =>
 106             Report.Failed
 107               ("Exception raised by procedure Reraise_Occurrence " &
 108                "when called with a Null_Occurrence input parameter");
 109       end;
 110
 111       if not TC_Flag then
 112          Report.Failed("Incorrect processing following the call to " &
 113                        "Reraise_Occurrence with a Null_Occurrence "  &
 114                        "input parameter");
 115       end if;
 116
 117
 118       -- Verify that function Exception_Message raises Constraint_Error for
 119       -- a Null_Occurrence input parameter.
 120       begin
 121          declare
 122             Msg : constant String :=
 123               Ada.Exceptions.Exception_Message(A_Null_Exception_Occurrence);
 124          begin
 125             Report.Failed
 126               ("Constraint_Error not raised by Function Exception_Message " &
 127                "when called with a Null_Occurrence input parameter");
 128          end;
 129       exception
 130          when Constraint_Error => null; -- OK, expected exception.
 131          when others =>
 132             Report.Failed
 133               ("Unexpected exception raised by Function Exception_Message " &
 134                "when called with a Null_Occurrence input parameter");
 135       end;
 136
 137
 138 --      -- Verify that function Exception_Identity raises Constraint_Error for
 139 --      -- a Null_Occurrence input parameter.
 140 --      -- Note: (RLB, 2000/12/08) This behavior may be modified by AI-00241.
 141 --      -- As such, this test case has been removed pending a resolution.
 142 --      begin
 143 --         declare
 144 --            Id : Ada.Exceptions.Exception_Id :=
 145 --              Ada.Exceptions.Exception_Identity(A_Null_Exception_Occurrence);
 146 --         begin
 147 --            Report.Failed
 148 --              ("Constraint_Error not raised by Function Exception_Identity " &
 149 --               "when called with a Null_Occurrence input parameter");
 150 --         end;
 151 --      exception
 152 --         when Constraint_Error => null; -- OK, expected exception.
 153 --         when others =>
 154 --            Report.Failed
 155 --              ("Unexpected exception raised by Function Exception_Identity " &
 156 --               "when called with a Null_Occurrence input parameter");
 157 --      end;
 158
 159
 160       -- Verify that function Exception_Name raises Constraint_Error for
 161       -- a Null_Occurrence input parameter.
 162       begin
 163          declare
 164             Name : constant String :=
 165               Ada.Exceptions.Exception_Name(A_Null_Exception_Occurrence);
 166          begin
 167             Report.Failed
 168               ("Constraint_Error not raised by Function Exception_Name " &
 169                "when called with a Null_Occurrence input parameter");
 170          end;
 171       exception
 172          when Constraint_Error => null; -- OK, expected exception.
 173          when others =>
 174             Report.Failed
 175               ("Unexpected exception raised by Function Exception_Null " &
 176                "when called with a Null_Occurrence input parameter");
 177       end;
 178
 179
 180       -- Verify that function Exception_Information raises Constraint_Error
 181       -- for a Null_Occurrence input parameter.
 182       begin
 183          declare
 184             Info : constant String :=
 185               Ada.Exceptions.Exception_Information
 186                                (A_Null_Exception_Occurrence);
 187          begin
 188             Report.Failed
 189               ("Constraint_Error not raised by Function "  &
 190                "Exception_Information when called with a " &
 191                "Null_Occurrence input parameter");
 192          end;
 193       exception
 194          when Constraint_Error => null; -- OK, expected exception.
 195          when others =>
 196             Report.Failed
 197               ("Unexpected exception raised by Function Exception_Null " &
 198                "when called with a Null_Occurrence input parameter");
 199       end;
 200
 201
 202       -- Verify that calling the Save_Occurrence procedure with a
 203       -- Null_Occurrence input parameter saves the Null_Occurrence to the
 204       -- target object, and does not raise Constraint_Error.
 205       declare
 206          use Ada.Exceptions;
 207          Saved_Occurrence : Exception_Occurrence;
 208       begin
 209
 210          -- Initialize the Saved_Occurrence variable with a value other than
 211          -- Null_Occurrence (default).
 212          begin
 213             raise Program_Error;
 214          exception
 215             when Exc : others => Save_Occurrence(Saved_Occurrence, Exc);
 216          end;
 217
 218          -- Save a Null_Occurrence input parameter.
 219          begin
 220             Save_Occurrence(Target => Saved_Occurrence,
 221                             Source => Ada.Exceptions.Null_Occurrence);
 222          exception
 223             when others =>
 224                Report.Failed
 225                  ("Unexpected exception raised by procedure "           &
 226                   "Save_Occurrence when called with a Null_Occurrence " &
 227                   "input parameter");
 228          end;
 229
 230          -- Verify that the occurrence that was saved above is a
 231          -- Null_Occurrence value.
 232
 233          begin
 234             Reraise_Occurrence(Saved_Occurrence);
 235          exception
 236             when others =>
 237                Report.Failed("Value saved from Procedure Save_Occurrence " &
 238                              "resulted in an exception, i.e., was not a "  &
 239                              "value of Null_Occurrence");
 240          end;
 241
 242       exception
 243          when others =>
 244             Report.Failed("Unexpected exception raised during evaluation " &
 245                           "of Procedure Save_Occurrence");
 246       end;
 247
 248
 249       -- Verify that calling the Save_Occurrence function with a
 250       -- Null_Occurrence input parameter returns the Null_Occurrence as the
 251       -- function result, and does not raise Constraint_Error.
 252       declare
 253          Occurrence_Ptr : Ada.Exceptions.Exception_Occurrence_Access;
 254       begin
 255          -- Save a Null_Occurrence input parameter.
 256          begin
 257             Occurrence_Ptr :=
 258               Ada.Exceptions.Save_Occurrence(Ada.Exceptions.Null_Occurrence);
 259          exception
 260             when others =>
 261                Report.Failed
 262                  ("Unexpected exception raised by function "            &
 263                   "Save_Occurrence when called with a Null_Occurrence " &
 264                   "input parameter");
 265          end;
 266
 267          -- Verify that the occurrence that was saved above is a
 268          -- Null_Occurrence value.
 269
 270          begin
 271             -- Dereferenced value of type Exception_Occurrence_Access
 272             -- should be a Null_Occurrence value, based on the action
 273             -- of Function Save_Occurrence above.  Providing this as an
 274             -- input parameter to Reraise_Exception should not result in
 275             -- any exception being raised.
 276
 277             Ada.Exceptions.Reraise_Occurrence(Occurrence_Ptr.all);
 278
 279          exception
 280             when others =>
 281                Report.Failed("Value saved from Function Save_Occurrence " &
 282                              "resulted in an exception, i.e., was not a "  &
 283                              "value of Null_Occurrence");
 284          end;
 285       exception
 286          when others =>
 287             Report.Failed("Unexpected exception raised during evaluation " &
 288                           "of Function Save_Occurrence");
 289       end;
 290
 291
 292
 293    exception
 294       when others => Report.Failed ("Exception raised in Test_Block");
 295    end Test_Block;
 296
 297    Report.Result;
 298
 299 end CB41004;