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/] [cc/] [cc70a01.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CC70A01.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 the visible part of a generic formal package includes the
28
--      first list of basic declarative items of the package specification.
29
--      Check for a generic package which declares a formal package with (<>)
30
--      as its actual part.
31
--
32
-- TEST DESCRIPTION:
33
--      The "first list of basic declarative items" of a package specification
34
--      is the visible part of the package. Thus, the declarations in the
35
--      visible part of the actual instance corresponding to a formal
36
--      package are available in the generic which declares the formal package.
37
--
38
--      Declare a generic package which simulates a complex integer abstraction
39
--      (foundation code).
40
--
41
--      Declare a second, library-level generic package which utilizes the
42
--      first generic package as a generic formal package (with a (<>)
43
--      actual_part). In the second generic package, declare objects, types,
44
--      and operations in terms of the objects, types, and operations declared
45
--      in the first generic package.
46
--
47
--      In the main program, instantiate the first generic package, then
48
--      instantiate the second generic package and pass the first instance
49
--      to it as a generic actual parameter. Check that the operations in
50
--      the second instance perform as expected.
51
--
52
--
53
-- CHANGE HISTORY:
54
--      06 Dec 94   SAIC    ACVC 2.0
55
--
56
--!
57
 
58
with FC70A00;         -- Generic complex integer operations.
59
 
60
generic               -- Generic complex matrix operations.
61
   with package Complex_Package is new FC70A00 (<>);
62
package CC70A01_0 is
63
 
64
   type Complex_Matrix_Type is                        -- 1st index is matrix
65
      array (Positive range <>, Positive range <>)    -- row, 2nd is column.
66
        of Complex_Package.Complex_Type;
67
   Dimension_Mismatch : exception;
68
 
69
 
70
   function Identity_Matrix (Size : Positive)         -- Create identity matrix
71
     return Complex_Matrix_Type;                      -- of specified size.
72
 
73
   function "*" (Left  : Complex_Matrix_Type;         -- Multiply two complex
74
                 Right : Complex_Matrix_Type)         -- matrices.
75
     return Complex_Matrix_Type;
76
 
77
end CC70A01_0;
78
 
79
 
80
     --==================================================================--
81
 
82
 
83
package body CC70A01_0 is  -- Generic complex matrix operations.
84
 
85
   use Complex_Package;
86
 
87
               --==============================================--
88
 
89
   function Inner_Product (Left, Right : Complex_Matrix_Type;
90
                           Row, Column : Positive)    -- Compute inner product
91
     return Complex_Package.Complex_Type is           -- for matrix-multiply.
92
 
93
      Result : Complex_Type := Zero;
94
      subtype Vector_Size is Positive range Left'Range(2);
95
 
96
   begin  -- Inner_Product.
97
      for I in Vector_Size loop
98
         Result := Result +                           -- Complex_Package."+".
99
                   (Left(Row, I) * Right(I, Column)); -- Complex_Package."*".
100
      end loop;
101
      return (Result);
102
   end Inner_Product;
103
 
104
               --==============================================--
105
 
106
   function Identity_Matrix (Size : Positive) return Complex_Matrix_Type is
107
      Result : Complex_Matrix_Type (1 .. Size, 1 .. Size) :=
108
               (others => (others => Zero));          -- Zeroes everywhere...
109
   begin
110
      for I in 1 .. Size loop
111
         Result (I, I) := One;                        -- Ones on the diagonal.
112
      end loop;
113
      return (Result);
114
   end Identity_Matrix;
115
 
116
               --==============================================--
117
 
118
   function "*" (Left  : Complex_Matrix_Type; Right : Complex_Matrix_Type)
119
     return Complex_Matrix_Type is
120
 
121
      subtype Rows    is Positive range Left'Range(1);
122
      subtype Columns is Positive range Right'Range(2);
123
 
124
      Result : Complex_Matrix_Type(Rows, Columns);
125
   begin
126
      if Left'Length(2) /= Right'Length(1) then       -- # columns of Left must
127
                                                      -- match # rows of Right.
128
         raise Dimension_Mismatch;
129
      else
130
         for I in Rows loop
131
            for J in Columns loop
132
                Result(I, J) := Inner_Product (Left, Right, I, J);
133
            end loop;
134
         end loop;
135
         return (Result);
136
      end if;
137
   end "*";
138
 
139
end CC70A01_0;
140
 
141
 
142
     --==================================================================--
143
 
144
 
145
with Report;
146
 
147
with FC70A00;    -- Generic complex integer operations.
148
with CC70A01_0;  -- Generic complex matrix operations.
149
 
150
procedure CC70A01 is
151
 
152
   type My_Integer is range -100 .. 100;
153
 
154
   package My_Complex_Package is new FC70A00   (My_Integer);
155
   package My_Matrix_Package  is new CC70A01_0 (My_Complex_Package);
156
 
157
   use My_Complex_Package,                                -- All user-defined
158
       My_Matrix_Package;                                 -- operators directly
159
                                                          -- visible.
160
 
161
   subtype Matrix_2x2 is Complex_Matrix_Type (1 .. 2, 1 .. 2);
162
   subtype Matrix_2x3 is Complex_Matrix_Type (1 .. 2, 1 .. 3);
163
 
164
   function C (Real, Imag : My_Integer) return Complex_Type renames Complex;
165
 
166
begin  -- Main program.
167
 
168
   Report.Test ("CC70A01", "Check that the visible part of a generic " &
169
                "formal package includes the first list of basic " &
170
                "declarative items of the package specification. Check " &
171
                "for a generic package where formal package has (<>) " &
172
                "actual part");
173
 
174
   declare
175
      Identity_2x2 : Matrix_2x2 := Identity_Matrix (Size => 2);
176
      Operand_2x3  : Matrix_2x3 := ( ( C(1, 2), C(3, 6), C(5, 1) ),
177
                                     ( C(0, 3), C(7, 9), C(3, 4) ) );
178
      Result_2x3   : Matrix_2x3 := ( others => ( others => Zero ) );
179
   begin
180
 
181
      begin -- Block #1.
182
         Result_2x3 := Identity_2x2 * Operand_2x3; -- Should return
183
                                                   -- Operand_2x3.
184
         if (Result_2x3 /= Operand_2x3) then
185
            Report.Failed ("Incorrect results from matrix multiplication");
186
         end if;
187
      exception
188
         when others =>
189
            Report.Failed ("Unexpected exception raised - Block #1");
190
      end;  -- Block #1.
191
 
192
 
193
      begin -- Block #2.
194
         Result_2x3 := Operand_2x3 * Identity_2x2;  -- Can't multiply 2x3
195
                                                    -- by 2x2.
196
         Report.Failed ("Exception Dimension_Mismatch not raised");
197
      exception
198
         when Dimension_Mismatch =>
199
            null;
200
         when others             =>
201
            Report.Failed ("Unexpected exception raised - Block #2");
202
      end;  -- Block #2.
203
 
204
   end;
205
 
206
   Report.Result;
207
 
208
end CC70A01;

powered by: WebSVN 2.1.0

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