Subversion Repositories openrisc

-- CC70002.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 a formal package actual part may specify actual parameters

--      for a generic formal package. Check that these actual parameters may

--      be formal types, formal objects, and formal subprograms. Check that

--      the visible part of the generic formal package includes the first list

--      of basic declarative items of the package specification, and that if

--      the formal package actual part is (<>), it also includes the generic

--      formal part of the template for the formal package.

--

-- TEST DESCRIPTION:

--      Declare a generic package which defines a "signature" for mathematical

--      groups. Declare a second generic package which defines a

--      two-dimensional matrix abstraction. Declare a third generic package

--      which provides mathematical group operations for two-dimensional

--      matrices. Provide this third generic with two formal parameters: (1)

--      a generic formal package with the second generic as template and a

--      (<>) actual part, and (2) a generic formal package with the first

--      generic as template and an actual part that takes a formal type,

--      object, and subprogram from the first formal package as actuals.

--

--

-- CHANGE HISTORY:

--      06 Dec 94   SAIC    ACVC 2.0

--

--!

generic              -- Mathematical group signature.

   type Group_Type is private;

   Identity : in Group_Type;

   with function Operation (Left, Right : Group_Type) return Group_Type;

-- with function Inverse... (omitted for brevity).

package CC70002_0 is

   function Power (Left : Group_Type; Right : Integer) return Group_Type;

   -- ... Other group operations.

end CC70002_0;

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

package body CC70002_0 is

   -- The implementation of Power is purely artificial; the validity of its

   -- implementation in the context of the abstraction is irrelevant to the

   -- feature being tested.

   function Power (Left : Group_Type; Right : Integer) return Group_Type is

      Result : Group_Type := Identity;

   begin

      Result := Operation (Result, Left);  -- All this really does is add

      return Result;                       -- one to each matrix element.

   end Power;

end CC70002_0;

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

generic          -- 2D matrix abstraction.

   type Element_Type is range <>;

   type Abscissa is range <>;

   type Ordinate is range <>;

   type Matrix_2D is array (Abscissa, Ordinate) of Element_Type;

package CC70002_1 is

   Add_Ident : constant Matrix_2D := (Abscissa => (others => 1));

                                                          -- Artificial for

                                                          -- testing purposes.

   -- ... Other identity matrices.

   function "+" (A, B : Matrix_2D) return Matrix_2D;

   -- ... Other operations.

end CC70002_1;

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

package body CC70002_1 is

   function "+" (A, B : Matrix_2D) return Matrix_2D is

      C : Matrix_2D;

   begin

      for I in Abscissa loop

         for J in Ordinate loop

            C(I,J) := A(I,J) + B(I,J);

         end loop;

      end loop;

      return C;

   end "+";

end CC70002_1;

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

with CC70002_0;  -- Mathematical group signature.

with CC70002_1;  -- 2D matrix abstraction.

generic          -- Mathematical 2D matrix addition group.

   with package Matrix_Ops is new CC70002_1 (<>);

   -- Although the restriction of the formal package below to signatures

   -- describing addition groups, and then only for 2D matrices, is rather

   -- artificial in the context of this "application," the passing of types,

   -- objects, and subprograms as actuals to a formal package is not.

   with package Math_Sig is new CC70002_0

     (Group_Type => Matrix_Ops.Matrix_2D,

      Identity   => Matrix_Ops.Add_Ident,

      Operation  => Matrix_Ops."+");

package CC70002_2 is

   -- Add two matrices that are to be multiplied by coefficients:

   -- [ ] = CA*[ ] + CB*[ ].

   function Add_Matrices_With_Coefficients (A  : Matrix_Ops.Matrix_2D;

                                            CA : Integer;

                                            B  : Matrix_Ops.Matrix_2D;

                                            CB : Integer)

     return Matrix_Ops.Matrix_2D;

   -- ...Other operations.

end CC70002_2;

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

package body CC70002_2 is

   function Add_Matrices_With_Coefficients (A  : Matrix_Ops.Matrix_2D;

                                            CA : Integer;

                                            B  : Matrix_Ops.Matrix_2D;

                                            CB : Integer)

     return Matrix_Ops.Matrix_2D is

      Left, Right : Matrix_Ops.Matrix_2D;

   begin

      Left  := Math_Sig.Power (A, CA);      -- Multiply 1st array by its coeff.

      Right := Math_Sig.Power (B, CB);      -- Multiply 2nd array by its coeff.

      return (Matrix_Ops."+" (Left, Right));-- Add these two arrays.

   end Add_Matrices_With_Coefficients;

end CC70002_2;

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

with CC70002_0;  -- Mathematical group signature.

with CC70002_1;  -- 2D matrix abstraction.

with CC70002_2;  -- Mathematical 2D matrix addition group.

with Report;

procedure CC70002 is

   subtype Cell_Type     is Positive range 1 .. 3;

   subtype Category_Type is Positive range 1 .. 2;

   type Data_Points is new Natural range 0 .. 100;

   type Table_Type is array (Cell_Type, Category_Type) of Data_Points;

   package Data_Table_Support is new CC70002_1 (Data_Points,

                                                Cell_Type,

                                                Category_Type,

                                                Table_Type);

   package Data_Table_Addition_Group is new CC70002_0

     (Group_Type => Table_Type,

      Identity   => Data_Table_Support.Add_Ident,

      Operation  => Data_Table_Support."+");

   package Table_Add_Ops is new CC70002_2

     (Data_Table_Support, Data_Table_Addition_Group);

   Scores_Table : Table_Type := ( (  12,   0),

                                  (  21,  33),

                                  (  49,   9) );

   Expected     : Table_Type := ( (  26,   2),

                                  (  44,  68),

                                  ( 100,  20) );

begin

   Report.Test ("CC70002", "Check that a generic formal package actual " &

                "part may specify formal objects, formal subprograms, " &

                "and formal types");

   Scores_Table := Table_Add_Ops.Add_Matrices_With_Coefficients

                     (Scores_Table, 2,

                      Scores_Table, 1);

   if (Scores_Table /= Expected) then

      Report.Failed ("Incorrect result for multi-dimensional array");

   end if;

   Report.Result;

end CC70002;