gcc/testsuite/ada/acats/tests/ca/ca11d013.am

   1 -- CA11D013.AM
   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 child unit can raise an exception that is declared in
  28 --      parent.
  29 --
  30 -- TEST DESCRIPTION:
  31 --      Declare a package which defines complex number abstraction with
  32 --      user-defined exceptions (foundation code).
  33 --
  34 --      Add a public child package to the above package. Declare two
  35 --      subprograms for the parent type.  Each of the subprograms raises a
  36 --      different exception, based on the value of an input parameter.
  37 --
  38 --      Add a public child procedure to the foundation package.  This
  39 --      procedure raises an exception based on the value of an input
  40 --      parameter.
  41 --
  42 --      Add a public child function to the foundation package.  This
  43 --      function raises an exception based on the value of an input
  44 --      parameter.
  45 --
  46 --      In the main program, "with" the child packages, then check that
  47 --      the exceptions are raised and handled as expected.  Ensure that
  48 --      exceptions are:
  49 --         1) raised in the public child package and handled/reraised to
  50 --            be handled by the main program.
  51 --         2) raised and handled locally in the public child package.
  52 --         3) raised and handled locally by "others" in the public child
  53 --            procedure.
  54 --         4) raised in the public child function and propagated to the
  55 --            main program.
  56 --
  57 -- TEST FILES:
  58 --      The following files comprise this test:
  59 --
  60 --         FA11D00.A
  61 --         CA11D010.A
  62 --         CA11D011.A
  63 --         CA11D012.A
  64 --      => CA11D013.AM
  65 --
  66 --
  67 -- CHANGE HISTORY:
  68 --      06 Dec 94   SAIC    ACVC 2.0
  69 --
  70 --!
  71
  72 with FA11D00.CA11D010;               -- Add_Subtract_Complex
  73 with FA11D00.CA11D011;               -- Multiply_Complex
  74 with FA11D00.CA11D012;               -- Divide_Complex
  75
  76 with Report;
  77
  78
  79 procedure CA11D013 is
  80
  81    package Complex_Pkg renames FA11D00;
  82    package Add_Subtract_Complex_Pkg renames FA11D00.CA11D010;
  83    use Complex_Pkg;
  84
  85 begin
  86
  87    Report.Test ("CA11D013", "Check that a child unit can raise an " &
  88                 "exception that is declared in parent");
  89
  90
  91    Add_Complex_Subtest:
  92    declare
  93       First       : Complex_Type := Complex (Int_Type (Report.Ident_Int (3)),
  94                                     Int_Type (Report.Ident_Int (7)));
  95       Second      : Complex_Type := Complex (Int_Type (Report.Ident_Int (5)),
  96                                     Int_Type (Report.Ident_Int (3)));
  97       Add_Result  : Complex_Type := Complex (Int_Type (Report.Ident_Int (8)),
  98                                     Int_Type (Report.Ident_Int (10)));
  99       Third       : Complex_Type := Complex (Int_Type(Report.Ident_Int(-100)),
 100                                     Int_Type (Report.Ident_Int (100)));
 101       Complex_Num : Complex_Type := Zero;
 102
 103    begin
 104       Add_Subtract_Complex_Pkg.Add (First, Second, Complex_Num);
 105
 106       if (Complex_Num /= Add_Result) then
 107          Report.Failed ("Incorrect results from addition");
 108       end if;
 109
 110       -- Error is raised in child package and exception
 111       -- will be handled/reraised to caller.
 112
 113       Add_Subtract_Complex_Pkg.Add (First, Third, Complex_Num);
 114
 115       -- Error was not raised in child package.
 116       Report.Failed ("Exception was not reraised in addition");
 117
 118    exception
 119       when Add_Error     =>
 120          if not TC_Handled_In_Child_Pkg_Proc then
 121             Report.Failed ("Exception was not raised in addition");
 122          else
 123             TC_Handled_In_Caller := true;  -- Exception is reraised from
 124                                            -- child package.
 125          end if;
 126
 127       when others =>
 128          Report.Failed ("Unexpected exception in addition subtest");
 129          TC_Handled_In_Caller := false;  -- Improper exception handling
 130                                          -- in caller.
 131
 132    end Add_Complex_Subtest;
 133
 134
 135    Subtract_Complex_Subtest:
 136    declare
 137       First       : Complex_Type := Complex (Int_Type (Report.Ident_Int (3)),
 138                                     Int_Type (Report.Ident_Int (6)));
 139       Second      : Complex_Type := Complex (Int_Type (Report.Ident_Int (5)),
 140                                     Int_Type (Report.Ident_Int (7)));
 141       Sub_Result  : Complex_Type := Complex (Int_Type (Report.Ident_Int (2)),
 142                                     Int_Type (Report.Ident_Int (1)));
 143       Third       : Complex_Type := Complex (Int_Type(Report.Ident_Int(-200)),
 144                                     Int_Type (Report.Ident_Int (1)));
 145       Complex_Num : Complex_Type;
 146
 147    begin
 148       Complex_Num := Add_Subtract_Complex_Pkg.Subtract (Second, First);
 149
 150       if (Complex_Num /= Sub_Result) then
 151          Report.Failed ("Incorrect results from subtraction");
 152       end if;
 153
 154       -- Error is raised and exception will be handled in child package.
 155       Complex_Num := Add_Subtract_Complex_Pkg.Subtract (Second, Third);
 156
 157    exception
 158       when Subtract_Error =>
 159          Report.Failed ("Exception raised in subtraction and " &
 160                         "propagated to caller");
 161          TC_Handled_In_Child_Pkg_Func := false; -- Improper exception handling
 162                                                 -- in caller.
 163
 164       when others =>
 165          Report.Failed ("Unexpected exception in subtraction subtest");
 166          TC_Handled_In_Child_Pkg_Func := false; -- Improper exception handling
 167                                                 -- in caller.
 168
 169    end Subtract_Complex_Subtest;
 170
 171
 172    Multiply_Complex_Subtest:
 173    declare
 174       First       : Complex_Type := Complex (Int_Type(Report.Ident_Int(3)),
 175                                     Int_Type (Report.Ident_Int (4)));
 176       Second      : Complex_Type := Complex (Int_Type(Report.Ident_Int(5)),
 177                                     Int_Type (Report.Ident_Int (3)));
 178       Mult_Result : Complex_Type := Complex(Int_Type(Report.Ident_Int(15)),
 179                                     Int_Type(Report.Ident_Int (12)));
 180       Third       : Complex_Type := Complex(Int_Type(Report.Ident_Int(10)),
 181                                     Int_Type(Report.Ident_Int (-10)));
 182       Complex_Num : Complex_Type;
 183
 184    begin
 185       CA11D011 (First, Second, Complex_Num);
 186
 187       if (Complex_Num /= Mult_Result) then
 188          Report.Failed ("Incorrect results from multiplication");
 189       end if;
 190
 191       -- Error is raised and exception will be handled in child package.
 192      CA11D011 (First, Third, Complex_Num);
 193
 194    exception
 195       when Multiply_Error =>
 196          Report.Failed ("Exception raised in multiplication and " &
 197                         "propagated to caller");
 198          TC_Handled_In_Child_Sub := false;     -- Improper exception handling
 199                                                -- in caller.
 200
 201       when others =>
 202          Report.Failed ("Unexpected exception in multiplication subtest");
 203          TC_Handled_In_Child_Sub := false;     -- Improper exception handling
 204                                                -- in caller.
 205    end Multiply_Complex_Subtest;
 206
 207
 208    Divide_Complex_Subtest:
 209    declare
 210       First       : Complex_Type := Complex (Int_Type (Report.Ident_Int(10)),
 211                                     Int_Type (Report.Ident_Int (15)));
 212       Second      : Complex_Type := Complex (Int_Type(Report.Ident_Int(5)),
 213                                     Int_Type (Report.Ident_Int (3)));
 214       Div_Result  : Complex_Type := Complex (Int_Type(Report.Ident_Int(2)),
 215                                     Int_Type (Report.Ident_Int (5)));
 216       Third       : Complex_Type := Complex (Int_Type(Report.Ident_Int(-10)),
 217                                     Int_Type (Report.Ident_Int (0)));
 218       Complex_Num : Complex_Type := Zero;
 219
 220    begin
 221       Complex_Num := CA11D012 (First, Second);
 222
 223       if (Complex_Num /= Div_Result) then
 224          Report.Failed ("Incorrect results from division");
 225       end if;
 226
 227       -- Error is raised in child package; exception will be
 228       -- propagated to caller.
 229       Complex_Num := CA11D012 (Second, Third);
 230
 231       -- Error was not raised in child package.
 232       Report.Failed ("Exception was not raised in division subtest ");
 233
 234    exception
 235       when Divide_Error =>
 236          TC_Propagated_To_Caller := true;  -- Exception is propagated.
 237
 238       when others =>
 239          Report.Failed ("Unexpected exception in division subtest");
 240          TC_Propagated_To_Caller := false;  -- Improper exception handling
 241                                             -- in caller.
 242    end Divide_Complex_Subtest;
 243
 244
 245    if not (TC_Handled_In_Caller         and     -- Check to see that all
 246            TC_Handled_In_Child_Pkg_Proc and     -- exceptions were handled in
 247            TC_Handled_In_Child_Pkg_Func and     -- the proper locations.
 248            TC_Handled_In_Child_Sub      and
 249            TC_Propagated_To_Caller)
 250    then
 251       Report.Failed ("Exceptions handled in incorrect locations");
 252    end if;
 253
 254    Report.Result;
 255
 256 end CA11D013;