Subversion Repositories openrisc_2011-10-31

-- CC70A01.A

--

--                             Grant of Unlimited Rights

--

--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,

--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained

--     unlimited rights in the software and documentation contained herein.

--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making

--     this public release, the Government intends to confer upon all

--     recipients unlimited rights  equal to those held by the Government.

--     These rights include rights to use, duplicate, release or disclose the

--     released technical data and computer software in whole or in part, in

--     any manner and for any purpose whatsoever, and to have or permit others

--     to do so.

--

--                                    DISCLAIMER

--

--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR

--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED

--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE

--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE

--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A

--     PARTICULAR PURPOSE OF SAID MATERIAL.

--*

--

-- OBJECTIVE:

--      Check that the visible part of a generic formal package includes the

--      first list of basic declarative items of the package specification.

--      Check for a generic package which declares a formal package with (<>)

--      as its actual part.

--

-- TEST DESCRIPTION:

--      The "first list of basic declarative items" of a package specification

--      is the visible part of the package. Thus, the declarations in the

--      visible part of the actual instance corresponding to a formal

--      package are available in the generic which declares the formal package.

--

--      Declare a generic package which simulates a complex integer abstraction

--      (foundation code).

--

--      Declare a second, library-level generic package which utilizes the

--      first generic package as a generic formal package (with a (<>)

--      actual_part). In the second generic package, declare objects, types,

--      and operations in terms of the objects, types, and operations declared

--      in the first generic package.

--

--      In the main program, instantiate the first generic package, then

--      instantiate the second generic package and pass the first instance

--      to it as a generic actual parameter. Check that the operations in

--      the second instance perform as expected.

--

--

-- CHANGE HISTORY:

--      06 Dec 94   SAIC    ACVC 2.0

--

--!

with FC70A00;         -- Generic complex integer operations.

generic               -- Generic complex matrix operations.

   with package Complex_Package is new FC70A00 (<>);

package CC70A01_0 is

   type Complex_Matrix_Type is                        -- 1st index is matrix

      array (Positive range <>, Positive range <>)    -- row, 2nd is column.

        of Complex_Package.Complex_Type;

   Dimension_Mismatch : exception;

   function Identity_Matrix (Size : Positive)         -- Create identity matrix

     return Complex_Matrix_Type;                      -- of specified size.

   function "*" (Left  : Complex_Matrix_Type;         -- Multiply two complex

                 Right : Complex_Matrix_Type)         -- matrices.

     return Complex_Matrix_Type;

end CC70A01_0;

     --==================================================================--

package body CC70A01_0 is  -- Generic complex matrix operations.

   use Complex_Package;

               --==============================================--

   function Inner_Product (Left, Right : Complex_Matrix_Type;

                           Row, Column : Positive)    -- Compute inner product

     return Complex_Package.Complex_Type is           -- for matrix-multiply.

      Result : Complex_Type := Zero;

      subtype Vector_Size is Positive range Left'Range(2);

   begin  -- Inner_Product.

      for I in Vector_Size loop

         Result := Result +                           -- Complex_Package."+".

                   (Left(Row, I) * Right(I, Column)); -- Complex_Package."*".

      end loop;

      return (Result);

   end Inner_Product;

               --==============================================--

   function Identity_Matrix (Size : Positive) return Complex_Matrix_Type is

      Result : Complex_Matrix_Type (1 .. Size, 1 .. Size) :=

               (others => (others => Zero));          -- Zeroes everywhere...

   begin

      for I in 1 .. Size loop

         Result (I, I) := One;                        -- Ones on the diagonal.

      end loop;

      return (Result);

   end Identity_Matrix;

               --==============================================--

   function "*" (Left  : Complex_Matrix_Type; Right : Complex_Matrix_Type)

     return Complex_Matrix_Type is

      subtype Rows    is Positive range Left'Range(1);

      subtype Columns is Positive range Right'Range(2);

      Result : Complex_Matrix_Type(Rows, Columns);

   begin

      if Left'Length(2) /= Right'Length(1) then       -- # columns of Left must

                                                      -- match # rows of Right.

         raise Dimension_Mismatch;

      else

         for I in Rows loop

            for J in Columns loop

                Result(I, J) := Inner_Product (Left, Right, I, J);

            end loop;

         end loop;

         return (Result);

      end if;

   end "*";

end CC70A01_0;

     --==================================================================--

with Report;

with FC70A00;    -- Generic complex integer operations.

with CC70A01_0;  -- Generic complex matrix operations.

procedure CC70A01 is

   type My_Integer is range -100 .. 100;

   package My_Complex_Package is new FC70A00   (My_Integer);

   package My_Matrix_Package  is new CC70A01_0 (My_Complex_Package);

   use My_Complex_Package,                                -- All user-defined

       My_Matrix_Package;                                 -- operators directly

                                                          -- visible.

   subtype Matrix_2x2 is Complex_Matrix_Type (1 .. 2, 1 .. 2);

   subtype Matrix_2x3 is Complex_Matrix_Type (1 .. 2, 1 .. 3);

   function C (Real, Imag : My_Integer) return Complex_Type renames Complex;

begin  -- Main program.

   Report.Test ("CC70A01", "Check that the visible part of a generic " &

                "formal package includes the first list of basic " &

                "declarative items of the package specification. Check " &

                "for a generic package where formal package has (<>) " &

                "actual part");

   declare

      Identity_2x2 : Matrix_2x2 := Identity_Matrix (Size => 2);

      Operand_2x3  : Matrix_2x3 := ( ( C(1, 2), C(3, 6), C(5, 1) ),

                                     ( C(0, 3), C(7, 9), C(3, 4) ) );

      Result_2x3   : Matrix_2x3 := ( others => ( others => Zero ) );

   begin

      begin -- Block #1.

         Result_2x3 := Identity_2x2 * Operand_2x3; -- Should return

                                                   -- Operand_2x3.

         if (Result_2x3 /= Operand_2x3) then

            Report.Failed ("Incorrect results from matrix multiplication");

         end if;

      exception

         when others =>

            Report.Failed ("Unexpected exception raised - Block #1");

      end;  -- Block #1.

      begin -- Block #2.

         Result_2x3 := Operand_2x3 * Identity_2x2;  -- Can't multiply 2x3

                                                    -- by 2x2.

         Report.Failed ("Exception Dimension_Mismatch not raised");

      exception

         when Dimension_Mismatch =>

            null;

         when others             =>

            Report.Failed ("Unexpected exception raised - Block #2");

      end;  -- Block #2.

   end;

   Report.Result;

end CC70A01;