ca11021.a

来自「Mac OS X 10.4.9 for x86 Source Code gcc」· A 代码 · 共 246 行

-- CA11021.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 body of the generic parent package can depend on one of 
--      its own private generic children.
--      
-- TEST DESCRIPTION:
--      A scenario is created that demonstrates the potential of adding a
--      public generic child during code maintenance without distubing a large 
--      subsystem.  After child is added to the subsystem, a maintainer
--      decides to take advantage of the new functionality and rewrites
--      the parent's body.
--
--      Declare a generic package which declares high level operations for a
--      complex number abstraction.  Declare a private generic child package 
--      of this package which defines low level complex operations. In the 
--      parent body, instantiate the private child.  Use the low level
--      operation to complete the high level operation.
--
--      In the main program, instantiate the parent generic package.
--      Check that the operations in both packages perform as expected.
--
--
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--
--!

generic               -- Complex number abstraction.
   type Int_Type is range <>;

package CA11021_0 is
 
   -- Simulate a generic complex number support package. Complex numbers
   -- are treated as coordinates in the Cartesian plane.

   type Complex_Type is private;

   Zero : constant Complex_Type;                      -- Real number (0,0).

   function Real_Part (Complex_No : Complex_Type)
     return Int_Type;

   function Imag_Part (Complex_No : Complex_Type)
     return Int_Type;

   function Complex (Real, Imag : Int_Type)           
     return Complex_Type;                             

   -- High level operation for complex number.
   function "*" (Factor : Int_Type; 
                 C      : Complex_Type) return Complex_Type;

   -- ... and other complicated ones.

private
   type Complex_Type is record
      Real : Int_Type;
      Imag : Int_Type;
   end record;

   Zero : constant Complex_Type := (Real => 0, Imag => 0);

end CA11021_0;

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

-- Private generic child of Complex_Number.  

private

generic               

-- No parameter.

package CA11021_0.CA11021_1 is
 
   -- ... Other declarations.

   -- Low level operation on complex number. 
   function "+" (Left, Right : Complex_Type)              
     return Complex_Type;                     

   function "-" (Right : Complex_Type)                
     return Complex_Type;                             

   -- ... Various other operations in real application.

end CA11021_0.CA11021_1;

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

package body CA11021_0.CA11021_1 is

   function "+" (Left, Right : Complex_Type)              
     return Complex_Type is

   begin
      return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) );
   end "+";

               --------------------------------------------------

   function "-" (Right : Complex_Type) return Complex_Type is
   begin
      return (-Right.Real, -Right.Imag);
   end "-";

end CA11021_0.CA11021_1;

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

with CA11021_0.CA11021_1;    -- Private generic child package.

package body CA11021_0 is

   -----------------------------------------------------
   -- Parent's body depends on private generic child. --
   -----------------------------------------------------

   -- Instantiate the private child.

   package Complex_Ops is new CA11021_1;  
   use Complex_Ops;                    -- All user-defined operators 
                                       -- directly visible.        

               --------------------------------------------------

   function "*" (Factor : Int_Type; 
                 C      : Complex_Type) return Complex_Type is
      Result : Complex_Type := Zero;   

   begin
      for I in 1 .. abs (Factor) loop
         Result := Result + C;         -- Private generic child "+".
      end loop;

      if Factor < 0 then
         Result := - Result;           -- Private generic child "-".
      end if;

      return Result;
   end "*";

               --------------------------------------------------

   function Real_Part (Complex_No : Complex_Type) return Int_Type is
   begin
      return (Complex_No.Real);
   end Real_Part;

               --------------------------------------------------

   function Imag_Part (Complex_No : Complex_Type) return Int_Type is
   begin
      return (Complex_No.Imag);
   end Imag_Part;

               --------------------------------------------------

   function Complex (Real, Imag : Int_Type) return Complex_Type is
   begin
      return (Real, Imag);
   end Complex;

end CA11021_0;

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

with CA11021_0;                        -- Complex number abstraction.

with Report;

procedure CA11021 is

   type My_Integer is range -100 .. 100;

               --------------------------------------------------

-- Declare instance of the generic complex package for one particular 
-- integer type.  

   package My_Complex_Pkg is new 
     CA11021_0 (Int_Type => My_Integer);

   use My_Complex_Pkg;                 -- All user-defined operators 
                                       -- directly visible.

               --------------------------------------------------

   Complex_One, Complex_Two : Complex_Type;

   My_Literal               : My_Integer := -3;

begin

   Report.Test ("CA11021", "Check that body of the generic parent package " &
                "can depend on its private generic child");

   Complex_One := Complex (11, 6);          

   Complex_Two := 5 * Complex_One; 

   if Real_Part (Complex_Two) /= 55         
     and Imag_Part (Complex_Two) /= 30     
        then
           Report.Failed ("Incorrect results from complex operation");
   end if;

   Complex_One := Complex (-4, 7);          

   Complex_Two := My_Literal * Complex_One; 

   if Real_Part (Complex_Two) /= 12         
     and Imag_Part (Complex_Two) /= -21     
        then
           Report.Failed ("Incorrect results from complex operation");
   end if;

   Report.Result;

end CA11021;