cc70002.a

来自「linux下编程用 编译软件」· A 代码 · 共 242 行

-- 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;