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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ca/] [ca11d010.a] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- 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

powered by: WebSVN 2.1.0

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