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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ca/] [ca11d03.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CA11D03.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 an exception declared in a package can be raised by a
28
--      client of a child of the package.  Check that it can be renamed in
29
--      the client of the child of the package and raised with the correct
30
--      effect.
31
--
32
-- TEST DESCRIPTION:
33
--      Declare a package which defines complex number abstraction with
34
--      user-defined exceptions (foundation code).
35
--
36
--      Add a public child package to the above package. Declare two
37
--      subprograms for the parent type.
38
--
39
--      In the main program, "with" the child package, then check that
40
--      an exception can be raised and handled as expected.
41
--
42
-- TEST FILES:
43
--      This test depends on the following foundation code:
44
--
45
--         FA11D00.A
46
--
47
--
48
-- CHANGE HISTORY:
49
--      06 Dec 94   SAIC    ACVC 2.0
50
--
51
--!
52
 
53
-- Child package of FA11D00.
54
package FA11D00.CA11D03_0 is     -- Basic_Complex
55
 
56
   function "+" (Left, Right : Complex_Type)
57
     return Complex_Type;                   -- Add two complex numbers.
58
 
59
   function "*" (Left, Right : Complex_Type)
60
     return Complex_Type;                   -- Multiply two complex numbers.
61
 
62
end FA11D00.CA11D03_0;     -- Basic_Complex
63
 
64
--=======================================================================--
65
 
66
package body FA11D00.CA11D03_0 is     -- Basic_Complex
67
 
68
   function "+" (Left, Right : Complex_Type) return Complex_Type is
69
   begin
70
      return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) );
71
   end "+";
72
   --------------------------------------------------------------
73
   function "*" (Left, Right : Complex_Type) return Complex_Type is
74
   begin
75
      return ( Real => (Left.Real * Right.Real),
76
               Imag => (Left.Imag * Right.Imag) );
77
   end "*";
78
 
79
end FA11D00.CA11D03_0;     -- Basic_Complex
80
 
81
--=======================================================================--
82
 
83
with FA11D00.CA11D03_0;    -- Basic_Complex,
84
                           -- implicitly with Complex_Definition.
85
with Report;
86
 
87
procedure CA11D03 is
88
 
89
   package Complex_Pkg renames FA11D00;     -- Complex_Definition_Pkg
90
   package Basic_Complex_Pkg renames FA11D00.CA11D03_0;   -- Basic_Complex
91
 
92
   use Complex_Pkg;
93
   use Basic_Complex_Pkg;
94
 
95
   TC_Handled_In_Subtest_1,
96
   TC_Handled_In_Subtest_2 : boolean := false;
97
 
98
begin
99
 
100
   Report.Test ("CA11D03", "Check that an exception declared in a package " &
101
                "can be raised by a client of a child of the package");
102
 
103
   Multiply_Complex_Subtest:
104
   declare
105
      Operand_1  : Complex_Type := Complex (Int_Type (Report.Ident_Int (3)),
106
                                   Int_Type (Report.Ident_Int (2)));
107
                                   -- Referenced to function in parent package.
108
      Operand_2  : Complex_Type := Complex (Int_Type (Report.Ident_Int (10)),
109
                                   Int_Type (Report.Ident_Int (8)));
110
      Mul_Res    : Complex_type := Complex (Int_Type (Report.Ident_Int (30)),
111
                                   Int_Type (Report.Ident_Int (16)));
112
      Complex_No : Complex_Type := Zero;  -- Zero is declared in parent package.
113
   begin
114
      Complex_No := Operand_1 * Operand_2;   -- Basic_Complex."*".
115
      if Complex_No /= Mul_Res then
116
         Report.Failed ("Incorrect results from multiplication");
117
      end if;
118
 
119
      -- Error is raised and exception will be handled.
120
      if Complex_No = Mul_Res then
121
         raise Multiply_Error;             -- Reference to exception in
122
      end if;                              -- parent package.
123
 
124
   exception
125
      when Multiply_Error =>
126
         TC_Handled_In_Subtest_1 := true;
127
      when others =>
128
         TC_Handled_In_Subtest_1 := false;  -- Improper exception handling.
129
 
130
   end Multiply_Complex_Subtest;
131
 
132
   Add_Complex_Subtest:
133
   declare
134
      Error_In_Client : exception renames Add_Error;
135
                        -- Reference to exception in parent package.
136
      Operand_1  : Complex_Type := Complex (Int_Type (Report.Ident_Int (2)),
137
                                   Int_Type (Report.Ident_Int (7)));
138
      Operand_2  : Complex_Type := Complex (Int_Type (Report.Ident_Int (-4)),
139
                                   Int_Type (Report.Ident_Int (1)));
140
      Add_Res    : Complex_type := Complex (Int_Type (Report.Ident_Int (-2)),
141
                                   Int_Type (Report.Ident_Int (8)));
142
      Complex_No : Complex_Type := One;   -- One is declared in parent
143
                                          -- package.
144
   begin
145
      Complex_No := Operand_1 + Operand_2;   -- Basic_Complex."+".
146
 
147
      if Complex_No /= Add_Res then
148
         Report.Failed ("Incorrect results from multiplication");
149
      end if;
150
 
151
      -- Error is raised and exception will be handled.
152
      if Complex_No = Add_Res then
153
         raise Error_In_Client;
154
      end if;
155
 
156
   exception
157
      when Error_In_Client =>
158
         TC_Handled_In_Subtest_2 := true;
159
 
160
      when others =>
161
         TC_Handled_In_Subtest_2 := false;  -- Improper exception handling.
162
 
163
   end Add_Complex_Subtest;
164
 
165
   if not (TC_Handled_In_Subtest_1           and   -- Check to see that all
166
           TC_Handled_In_Subtest_2)                -- exceptions were handled
167
                                                   -- in the proper location.
168
   then
169
      Report.Failed ("Exceptions handled in incorrect locations");
170
   end if;
171
 
172
   Report.Result;
173
 
174
end CA11D03;

powered by: WebSVN 2.1.0

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