gomp-20050608-branch/gcc/testsuite/ada/acats/tests/ca/ca11d010.a

   1 -- CA11D010.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 --      See CA11D013.AM
  28 --
  29 -- TEST DESCRIPTION:
  30 --      See CA11D013.AM
  31 --
  32 -- TEST FILES:
  33 --      The following files comprise this test:
  34 --
  35 --         FA11D00.A
  36 --      => CA11D010.A
  37 --         CA11D011.A
  38 --         CA11D012.A
  39 --         CA11D013.AM
  40 --
  41 -- CHANGE HISTORY:
  42 --      06 Dec 94   SAIC    ACVC 2.0
  43 --      26 Apr 96   SAIC    ACVC 2.1: Modified prologue.
  44 --
  45 --!
  46
  47 -- Child package of FA11D00.
  48
  49 package FA11D00.CA11D010 is     -- Add_Subtract_Complex
  50
  51    procedure Add (Left, Right : in     Complex_Type;   -- Add two complex
  52                   C           :    out Complex_Type);  -- numbers.
  53
  54    function Subtract (Left, Right : Complex_Type)      -- Subtract two
  55      return Complex_Type;                              -- complex numbers.
  56
  57
  58
  59 end FA11D00.CA11D010;     -- Add_Subtract_Complex
  60
  61 --=======================================================================--
  62
  63 with Report;
  64
  65 package body FA11D00.CA11D010 is     -- Add_Subtract_Complex
  66
  67    procedure Add (Left, Right : in Complex_Type;
  68                   C           :    out Complex_Type) is
  69    begin
  70       -- Zero is declared in parent package.
  71
  72       if Left.Real < Zero.Real or else Right.Real < Zero.Real
  73         or else Left.Imag < Zero.Imag or else Right.Imag < Zero.Imag then
  74           raise Add_Error;     -- Reference to exception in parent package.
  75           Report.Failed ("Program control not transferred by raise in " &
  76                          "procedure Add");
  77       else
  78          C.Real := (Left.Real + Right.Real);
  79          C.Imag := (Left.Imag + Right.Imag);
  80       end if;
  81
  82    exception
  83       when Add_Error =>
  84          TC_Handled_In_Child_Pkg_Proc := true;
  85          C := Check_Value;           -- Reference to object in parent package.
  86          raise;     -- Reraise the Add_Error exception in the subtest.
  87          Report.Failed ("Exception not reraised in handler");
  88
  89       when others    =>
  90          Report.Failed ("Unexpected exception raised in Add");
  91
  92    end Add;
  93    -----------------------------------------------------------
  94    function Subtract (Left, Right : Complex_Type)
  95      return Complex_Type is
  96    begin
  97       -- Zero is declared in parent package.
  98       if Left.Real < Zero.Real or Right.Real < Zero.Real
  99         or Left.Imag < Zero.Imag or Right.Imag < Zero.Imag then
 100           raise Subtract_Error;    -- Reference to exception in parent package.
 101           Report.Failed ("Program control not transferred by raise in " &
 102                          "function Subtract");
 103       else
 104          return ( Real => (Left.Real - Right.Real),
 105                   Imag => (Left.Imag - Right.Imag) );
 106       end if;
 107
 108    exception
 109       when Subtract_Error =>
 110          Report.Comment ("Exception is properly handled in Subtract");
 111          TC_Handled_In_Child_Pkg_Func := true;
 112          return Check_Value;
 113
 114       when others         =>
 115          Report.Failed ("Unexpected exception raised in Subtract");
 116
 117    end Subtract;
 118
 119 end FA11D00.CA11D010;     -- Add_Subtract_Complex