Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/misc/dunit.src

Text File | 1988-05-03 | 29.3 KB | 1,046 lines

::::::::::
dunit.inc
::::::::::
-- Include files (in compilation order) for DIMENSIONAL_UNITS
-- by Do-While Jones
DUNITS.ADA
DUNITB.ADA
-- The following is a usage example
DUEX.ADA
-- The following is the prologue file for the ASR
DIM_UNIT.PRO
-- The following is the test program; link DU_TEST after these
-- files are compiled
DUTEST.ADA
DUTEST1.ADA
DUTEST2.ADA
DUTEST3.ADA
::::::::::
DUNITS.ADA
::::::::::
--            -- DUNITS.ada
--            -- VERSION 1

--            1 January 1986
--            Do-While Jones
--            324 Traci Lane
--            Ridgecrest, CA 93555
--            [phone]

package DIMENSIONAL_UNITS is

  -- This package provides useful parent types for derived
  -- dimensional units. That is, it makes it possible to
  -- do this:

  -- type Feet is new Integer_unit;
  -- type Radians is new Float_unit;

  -- PI           : constant Radians := 3.14159;
  -- TARGET_RANGE : Feet;
  -- ANGLE        : Radians;
  -- REVOLUTIONS  : integer;

  -- These derived data types will inherit all the operations
  -- in the package below. These are all the operations that
  -- make sense for dimensional quantities.

  -- The modulo operation for Float_units is provided to make
  -- it easy to normalize angular measurements.

  -- ANGLE := ANGLE mod (2.0 * PI);

  -- The division operator for Float_units which returns integers
  -- truncates toward zero (rather than rounding) to make it
  -- consistant with integer division, and it lets you do this:

  -- REVOLUTIONS := ANGLE / (2.0 * PI);

  type Integer_unit is private;

  function Type_convert(X : integer) return Integer_unit;
    -- Lets you assign values to dimensional objects.
    -- For example,

    -- TARGET_RANGE := Type_Convert(587);

  function "+"(RIGHT : Integer_unit)
    return Integer_unit;
  function "-"(RIGHT : Integer_unit)
    return Integer_unit;
  function "abs"(RIGHT : Integer_unit)
    return Integer_unit;
  function "+"(LEFT, RIGHT : Integer_unit)
    return Integer_unit;
  function "-"(LEFT, RIGHT : Integer_unit)
    return Integer_unit;
  function "*"(LEFT : integer; RIGHT : Integer_unit)
    return Integer_unit;
  function "*"(LEFT : Integer_unit; RIGHT : integer)
    return Integer_unit;
  function "/"(LEFT : Integer_unit; RIGHT : integer)
    return Integer_unit;
  function "/"(LEFT, RIGHT : Integer_unit)
    return integer;
  function "/"(LEFT, RIGHT : Integer_unit)
    return float;
  function "rem"(LEFT, RIGHT : Integer_unit)
    return Integer_unit;
  function "mod"(LEFT, RIGHT : Integer_unit)
    return Integer_unit;
  function Dimensionless(LEFT : Integer_unit)
    return integer;
  function Dimensionless(LEFT : Integer_unit)
    return float;

  -- "=" and "/=" are already defined for private types
  function "<"(LEFT, RIGHT : Integer_unit)
    return boolean;
  function "<="(LEFT, RIGHT : Integer_unit)
    return boolean;
  function ">"(LEFT, RIGHT : Integer_unit)
    return boolean;
  function ">="(LEFT, RIGHT : Integer_unit)
    return boolean;

  type Float_unit is private;

  function Type_Convert(X : float) return Float_unit;
    -- Lets you assign values to dimensional objects.
    -- For example,

    -- ANGLE := Type_Convert(3.14159);

  function "+"(RIGHT : Float_unit)
    return Float_unit;
  function "-"(RIGHT : Float_unit)
    return Float_unit;
  function "abs"(RIGHT : Float_unit)
    return Float_unit;
  function "+"(LEFT, RIGHT : Float_unit)
    return Float_unit;
  function "-"(LEFT, RIGHT : Float_unit)
    return Float_unit;
  function "*"(LEFT : integer; RIGHT : Float_unit)
    return Float_unit;
  function "*"(LEFT : Float_unit; RIGHT : integer)
    return Float_unit;
  function "*"(LEFT : float; RIGHT : Float_unit)
    return Float_unit;
  function "*"(LEFT : Float_unit; RIGHT : float)
    return Float_unit;
  function "/"(LEFT : Float_unit; RIGHT : integer)
    return Float_unit;
  function "/"(LEFT : Float_unit; RIGHT : float)
    return Float_unit;
  function "/"(LEFT, RIGHT : Float_unit)
    return integer; -- truncates toward zero
  function "/"(LEFT, RIGHT : Float_unit)
    return float;
  function "rem"(LEFT, RIGHT : Float_unit)
    return Float_unit;
  function "mod"(LEFT, RIGHT : Float_unit)
    return Float_unit;
  function Dimensionless(LEFT : Float_unit)
    return integer;
  function Dimensionless(LEFT : Float_unit)
    return float;

  -- "=" and "/=" are already defined for private types
  function "<"(LEFT, RIGHT : Float_unit)
    return boolean;
  function "<="(LEFT, RIGHT : Float_unit)
    return boolean;
  function ">"(LEFT, RIGHT : Float_unit)
    return boolean;
  function ">="(LEFT, RIGHT : Float_unit)
    return boolean;

-- The following don't have any application to dimensional
-- problems. I almost hid them in the package body, but I
-- thought that since I needed them to derive some of the
-- Float_unit operations someone else might need them, too.

  function "/"(LEFT, RIGHT : float) return integer;
    -- divide and truncate toward zero

  function "rem"(LEFT, RIGHT : float) return float;

  function "mod"(LEFT, RIGHT : float) return float;

private

  type Integer_unit is new integer;
  type Float_unit is new float;

end DIMENSIONAL_UNITS;
::::::::::
DUNITB.ADA
::::::::::

--            -- DUNITB.ada
--            -- VERSION 1.0

--            9 March 1986
--            Do-While Jones
--            324 Traci Lane
--            Ridgecrest, CA 93555
--            [phone]

package body DIMENSIONAL_UNITS is

  function Type_convert(X : integer) return Integer_unit is
  begin
    return Integer_unit(X);
  end Type_Convert;

  function "+"(RIGHT : Integer_unit)
    return Integer_unit is
  begin
    return RIGHT;
  end "+";

  function "-"(RIGHT : Integer_unit)
    return Integer_unit is
      X : integer;
  begin
    X := integer(RIGHT);
    return Integer_unit(-X);
  end "-";

  function "abs"(RIGHT : Integer_unit)
    return Integer_unit is
  begin
    return Integer_unit(abs(integer(RIGHT)));
  end "abs";

  function "+"(LEFT, RIGHT : Integer_unit)
    return Integer_unit is
  begin
    return Integer_unit(integer(LEFT) + integer(RIGHT));
  end "+";

  function "-"(LEFT, RIGHT : Integer_unit)
    return Integer_unit is
  begin
    return Integer_unit(integer(LEFT) - integer(RIGHT));
  end "-";

  function "*"(LEFT : integer; RIGHT : Integer_unit)
    return Integer_unit is
  begin
    return Integer_unit(LEFT * integer(RIGHT));
  end "*";

  function "*"(LEFT : Integer_unit; RIGHT : integer)
    return Integer_unit is
  begin
    return Integer_unit(integer(LEFT) * RIGHT);
  end "*";

  function "/"(LEFT : Integer_unit; RIGHT : integer)
    return Integer_unit is
  begin
    return Integer_unit(integer(LEFT) / RIGHT);
  end "/";

  function "/"(LEFT, RIGHT : Integer_unit)
    return integer is
  begin
    return integer(LEFT) / integer(RIGHT);
  end "/";

  function "/"(LEFT, RIGHT : Integer_unit)
    return float is
      EXACT_QUOTIENT : float;
  begin
    EXACT_QUOTIENT := float(LEFT) / float(RIGHT);
    return EXACT_QUOTIENT;
  end "/";

  function "rem"(LEFT, RIGHT : Integer_unit)
    return Integer_unit is
  begin
    return Integer_unit(integer(LEFT) rem integer(RIGHT));
  end "rem";

  function "mod"(LEFT, RIGHT : Integer_unit)
    return Integer_unit is
  begin
    return Integer_unit(integer(LEFT) mod integer(RIGHT));
  end "mod";

  function Dimensionless(LEFT : Integer_unit)
    return integer is
  begin
    return integer(LEFT);
  end Dimensionless;

  function Dimensionless(LEFT : Integer_unit)
    return float is
  begin
    return float(LEFT);
  end Dimensionless;

  function "<"(LEFT, RIGHT : Integer_unit)
    return boolean is
  begin
    return integer(LEFT) < integer(RIGHT);
  end "<";

  function "<="(LEFT, RIGHT : Integer_unit)
    return boolean is
  begin
    return integer(LEFT) <= integer(RIGHT);
  end "<=";

  function ">"(LEFT, RIGHT : Integer_unit)
    return boolean is
  begin
    return integer(LEFT) > integer(RIGHT);
  end ">";

  function ">="(LEFT, RIGHT : Integer_unit)
    return boolean is
  begin
    return integer(LEFT) >= integer(RIGHT);
  end ">=";

  function Type_convert(X : float) return Float_unit is
  begin
    return Float_unit(X);
  end Type_Convert;

  function "+"(RIGHT : Float_unit)
    return Float_unit is
  begin
    return RIGHT;
  end "+";

  function "-"(RIGHT : Float_unit)
    return Float_unit is
      X : float;
  begin
    X := float(RIGHT);
    return Float_unit(-X);
  end "-";

  function "abs"(RIGHT : Float_unit)
    return Float_unit is
  begin
    return Float_unit(abs(float(RIGHT)));
  end "abs";

  function "+"(LEFT, RIGHT : Float_unit)
    return Float_unit is
  begin
    return Float_unit(float(LEFT) + float(RIGHT));
  end "+";

  function "-"(LEFT, RIGHT : Float_unit)
    return Float_unit is
  begin
    return Float_unit(float(LEFT) - float(RIGHT));
  end "-";

  function "*"(LEFT : integer; RIGHT : Float_unit)
    return Float_unit is
  begin
    return Float_unit(float(LEFT) * float(RIGHT));
  end "*";

  function "*"(LEFT : Float_unit; RIGHT : integer)
    return Float_unit is
  begin
    return Float_unit(float(LEFT) * float(RIGHT));
  end "*";

  function "*"(LEFT : float; RIGHT : Float_unit)
    return Float_unit is
  begin
    return Float_unit(LEFT * float(RIGHT));
  end "*";

  function "*"(LEFT : Float_unit; RIGHT : float)
    return Float_unit is
  begin
    return Float_unit(float(LEFT) * RIGHT);
  end "*";

  function "/"(LEFT : Float_unit; RIGHT : integer)
    return Float_unit is
      EXACT_QUOTIENT : float;
  begin
    EXACT_QUOTIENT := float(LEFT) / float(RIGHT);
    return Float_unit(EXACT_QUOTIENT);
  end "/";

  function "/"(LEFT : Float_unit; RIGHT : float)
    return Float_unit is
      EXACT_QUOTIENT : float;
  begin
    EXACT_QUOTIENT := float(LEFT) / RIGHT;
    return Float_unit(EXACT_QUOTIENT);
  end "/";

  function "/"(LEFT, RIGHT : Float_unit)
    return integer is
      TRUNCATED_QUOTIENT : integer;
  begin
    TRUNCATED_QUOTIENT := float(LEFT) / float(RIGHT);
    -- using special "/" operation below
    return TRUNCATED_QUOTIENT;
  end "/";

  function "/"(LEFT, RIGHT : Float_unit)
    return float is
      EXACT_QUOTIENT : float;
  begin
    EXACT_QUOTIENT := float(LEFT) / float(RIGHT);
    return EXACT_QUOTIENT;
  end "/";

  function "rem"(LEFT, RIGHT : Float_unit)
    return Float_unit is
  begin
    return Float_unit(float(LEFT) rem float(RIGHT));
  end "rem";

  function "mod"(LEFT, RIGHT : Float_unit)
    return Float_unit is
  begin
    return Float_unit(float(LEFT) mod float(RIGHT));
  end "mod";

  function Dimensionless(LEFT : Float_unit)
    return integer is
  begin
    return integer(LEFT);
  end Dimensionless;

  function Dimensionless(LEFT : Float_unit)
    return float is
  begin
    return float(LEFT);
  end Dimensionless;

  function "<"(LEFT, RIGHT : Float_unit)
    return boolean is
  begin
    return float(LEFT) < float(RIGHT);
  end "<";

  function "<="(LEFT, RIGHT : Float_unit)
    return boolean is
  begin
    return float(LEFT) <= float(RIGHT);
  end "<=";

  function ">"(LEFT, RIGHT : Float_unit)
    return boolean is
  begin
    return float(LEFT) > float(RIGHT);
  end ">";

  function ">="(LEFT, RIGHT : Float_unit)
    return boolean is
  begin
    return float(LEFT) >= float(RIGHT);
  end ">=";

-- The following don't have any application to dimensional
-- problems. I almost hid them in the package body, but I
-- thought that since I needed them to derive some of the
-- Float_unit operations someone else might need them, too.

  function "/"(LEFT, RIGHT : float) return integer is
    -- divide and truncate toward zero
    EXACT : float;
    ROUNDED, TRUNCATED : integer;
  begin
    EXACT := LEFT / RIGHT;
    ROUNDED := integer(EXACT);
    if float(abs(ROUNDED)) > abs(EXACT) then
      if ROUNDED > 0 then
        TRUNCATED := ROUNDED-1;
      else
        TRUNCATED := ROUNDED+1;
      end if;
    else
      TRUNCATED := ROUNDED;
    end if;
    return TRUNCATED;
  end "/";

  function "rem"(LEFT, RIGHT : float) return float is
    COMPLETE_CYCLES : integer;
    REMAINDER       : float;
  begin
    COMPLETE_CYCLES := LEFT / RIGHT;
    REMAINDER := LEFT - float(COMPLETE_CYCLES) * RIGHT;
    return REMAINDER;
  end "rem";

  function "mod"(LEFT, RIGHT : float) return float is
    REMAINDER : float;
  begin
    REMAINDER := LEFT rem RIGHT;
    if LEFT * RIGHT > 0.0 then
      return REMAINDER;
    elsif REMAINDER = 0.0 then
      return REMAINDER;
    else
      return REMAINDER + RIGHT;
    end if;
  end "mod";

end DIMENSIONAL_UNITS;
::::::::::
DUEX.ADA
::::::::::

--            DUEX.ada
-- This is an example of how the use of dimensional units as data
-- types improves program clarity.

-------------------    Compilation Unit 1  ------------------------

with DIMENSIONAL_UNITS; use DIMENSIONAL_UNITS;
package SPEED_GUN_UNITS is

  type Miles_per_hour is new Integer_unit;
  type Hertz is new Float_unit;
  type Miles_per_second is new Float_unit;

  function Type_Convert(X : Miles_per_second)
   return Miles_per_hour;

  function "*"(LEFT : Miles_per_second; RIGHT : float)
   return Miles_per_hour;

end SPEED_GUN_UNITS;

with SPEED_GUN_UNITS; use SPEED_GUN_UNITS;
package HARDWARE_CIRCUITS is

  function Xmit_Frequency_Measurement return Hertz;

  function Doppler_Frequency_Measurement return Hertz;
  procedure put(X : Miles_per_hour);

end HARDWARE_CIRCUITS;

with HARDWARE_CIRCUITS; use HARDWARE_CIRCUITS;
with SPEED_GUN_UNITS; use SPEED_GUN_UNITS;
procedure Speed_Gun is
  TRANSMIT_FREQUENCY, DOPPLER_FREQUENCY : Hertz;
  SPEED : Miles_per_hour;
  C : constant Miles_per_second
   := Type_Convert(186_280.0); -- speed of light
begin
  TRANSMIT_FREQUENCY := Xmit_Frequency_Measurement;
  DOPPLER_FREQUENCY := Doppler_Frequency_Measurement;
  SPEED := (C/2.0) * (DOPPLER_FREQUENCY / TRANSMIT_FREQUENCY);
  put(SPEED);
end Speed_Gun;

package body SPEED_GUN_UNITS is

  function Type_Convert(X : Miles_per_second)
   return Miles_per_hour is
    F : float;
  begin
    F := Dimensionless(X) * 60.0 * 60.0;
    return Type_Convert(integer(F));
  end Type_Convert;

  function "*"(LEFT : Miles_per_second; RIGHT : float)
   return Miles_per_hour is
  begin
    return Type_Convert(LEFT * RIGHT);
  end "*";

end SPEED_GUN_UNITS;

with TEXT_IO; use TEXT_IO;
package body HARDWARE_CIRCUITS is
  -- The statements below are standing in for code which would
  -- read the frequency directly from hardware circuits and
  -- would display speed on an LCD or LED display. Since I'm
  -- using a terminal as a substitute IO device I used TEXT_IO
  -- to get and put data.

  package INT_IO is new INTEGER_IO(integer); use INT_IO;
  package F_IO is new FLOAT_IO(float); use F_IO;

  function Xmit_Frequency_Measurement return HErtz is
    F : float;
  begin
    put("What is the Transmit Frequency (in Hertz)? ");
    get(F);
    -- skip_line; -- TEXT_IO quirk
    return Type_Convert(F);
  end Xmit_Frequency_Measurement;

  function Doppler_Frequency_Measurement return Hertz is
    F : float;
  begin
    put("What is the Doppler Frequency (in Hertz)?");
    get(F);
    -- skip_line; -- TEXT_IO quirk
    return Type_Convert(F);
  end Doppler_Frequency_Measurement;

  procedure put(X : Miles_per_hour) is
    I : integer;
  begin
    I := Dimensionless(X);
    put("The speed is "); put(I); put_line(" MPH.");
  end put;

end HARDWARE_CIRCUITS;
::::::::::
DIM_UNIT.PRO
::::::::::


-------- SIMTEL20 Ada Software Repository Prologue ------------
--
-- Unit name    : DIMENSIONAL_UNITS
-- Version      : 1.0
-- Author       : Do-While Jones
--              : 324 Traci Lane
--              : Ridgecrest, CA 93555
--              : [phone]
-- DDN Address  :
-- Copyright    : (c)
-- Date created :
-- Release date : 1 May 1987
-- Last update  :
-- Machine/System Compiled/Run on :
--  DEC Ada on VAX
--  APLEX (Telegen 2) on Gould 32/97 running MPX
--  Does not run on Alsys on AT because of a bug in Alsys.
--  (The DUTEST program will tell you if it works on your system.)
--
---------------------------------------------------------------
--
-- Keywords     : Dimensional Units
--
-- Abstract     :
--   This package provides useful parent types for derived
--   dimensional units. That is, it makes it possible to
--   do this:
--      type Feet is new Integer_Unit;
--      type Radians is new Float_Unit;
--   Objects of type Feet can be added together, but can't be
--   multiplied together to get a result in feet.
--
--  See Dr. Dobb's Journal of Software Tools issue #127
--  (May 1987) page 50 for a complete description of how to
--  use this package.
--
--  Unfortunately Dr. Dobb failed to publish the package body and
--  the test routines.
--
--  The complete set of files consists of:
--    DUNITS.ADA (DIMENSIONAL_UNITS package specification)
--    DUNITB.ADA (DIMENSIONAL_UNITS package body)
--    DUEX.ADA   (procedure Speed_Gun example program)
--    DUTEST.ADA (Exhaustive test program with 3 subunits)
--    DUTEST1.ADA (subunit 1)
--    DUTEST2.ADA (subunit 2)
--    DUTEST3.ADA (subunit 3)
--
------------------ Revision history ---------------------------
--
-- DATE         VERSION    AUTHOR                  HISTORY
--
------------------ Distribution and Copyright -----------------
--
-- This prologue must be included in all copies of this software.
--
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--
------------------ Disclaimer ---------------------------------
--
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--
-------------------END-PROLOGUE--------------------------------
::::::::::
DUTEST.ADA
::::::::::

--            DUTEST.ADA
--            Version 1.0
--            1 January 1986

--            Do-While Jones
--            324 Traci Lane
--            Ridgecrest, CA 93555
--            [phone]

with DIMENSIONAL_UNITS; use DIMENSIONAL_UNITS;
with TEXT_IO; use TEXT_IO;
procedure DU_Test is
  procedure Test_1 is separate;
  procedure Test_2 is separate;
  procedure Test_3 is separate;
begin
  new_line;
  put_line("Dimensional Units Test - Version 1.0");
  put_line("1 January 1986 by Do-While Jones");
  new_line;
  Test_1; -- checks valid integer operations
  Test_2; -- checks valid float operations
  Test_3; -- checks extra operations
  put_line("Dimensional Unit test complete.");
  new_line;
end DU_Test;
::::::::::
DUTEST1.ADA
::::::::::
--            DUTEST1.ADA
--            Version 1.0
--            3 January 1986
--            Do-While Jones

separate(DU_Test)
procedure Test_1 is

  type Feet is new Integer_unit;

  X, Y, Z : Feet;
  F       : float;
  TEST_A_PASSED, TEST_B_PASSED, TEST_C_PASSED, TEST_D_PASSED,
  TEST_E_PASSED, TEST_F_PASSED, TEST_G_PASSED, TEST_H_PASSED,
  TEST_I_PASSED, TEST_J_PASSED, TEST_K_PASSED, TEST_L_PASSED,
  TEST_M_PASSED, TEST_N_PASSED, TEST_O_PASSED, TEST_P_PASSED,
  TEST_Q_PASSED, TEST_R_PASSED : boolean := FALSE;
begin
  X := Type_Convert(3);
  Y := Type_Convert(2);
  Z := Type_Convert(5);
  TEST_A_PASSED := X + Y = Z;
  if not TEST_A_PASSED then
    put_line("ADDITION_OPERATOR DOES NOT WORK!");
  end if;
  TEST_B_PASSED := Z - Y = X;
  if not TEST_B_PASSED then
    put_line("SUBTRACTION OPERATOR DOES NOT WORK!");
  end if;
  Z := Type_Convert(6);
  TEST_C_PASSED := 2 * X = Z;
  if not TEST_C_PASSED then
    put_line("LEFT INTEGER MULTIPLICATION FAILED!");
  end if;
  TEST_D_PASSED := X * 2 = Z;
  if not TEST_D_PASSED then
    put_line("RIGHT INTEGER MULTIPLICATION FAILED!");
  end if;
  TEST_E_PASSED := Z / 2 = X;
  if not TEST_E_PASSED then
    put_line("INTEGER DIVISION FAILED!");
  end if;
  TEST_F_PASSED := Z / X = 2;
  if not TEST_F_PASSED then
    put_line("DIMENSIONAL DIVISION WITH INTEGER RESULT FAILED!");
  end if;
  F := X / Z;
  TEST_G_PASSED := abs(F - 0.5) < 0.001;
  if not TEST_G_PASSED then
    put_line("DIMENSIONAL DIVISION WITH FLOAT RESULT FAILED!");
  end if;
  Z := Type_Convert(5);
  TEST_H_PASSED := Z rem X = Y;
  if not TEST_H_PASSED then
    put_line("INTEGER_UNIT REM OPERATION FAILED!");
  end if;
  TEST_I_PASSED := Z mod X = Y;
  if not TEST_I_PASSED then
    put_line("INTEGER_UNIT MOD OPERATION FAILED!");
  end if;
  TEST_J_PASSED := Dimensionless(Z) = 5;
  if not TEST_J_PASSED then
    put_line("DIMENSIONLESS INTEGER_UNIT INTEGER RESULT FAILED!");
  end if;
  F := Dimensionless(Z);
  TEST_K_PASSED := abs(F - 5.0) < 0.001;
  if not TEST_K_PASSED then
    put_line("DIMENSIONLESS INTEGER_UNIT FLOAT RESULT FAILED!");
  end if;
  X := Type_Convert(1);
  Y := Type_Convert(2);
  Z := Y;
  TEST_L_PASSED := X < Y and not(Y < X);
  if not TEST_L_PASSED then
    put_line("INTEGER_UNIT < FAILED!");
  end if;
  TEST_M_PASSED := X < Y and Y <= Z and not (Z <= X);
  if not TEST_M_PASSED then
    put_line("INTEGER_UNIT <= FAILED!");
  end if;
  TEST_N_PASSED := Y > X and not (X > Y);
  if not TEST_N_PASSED then
    put_line("INTEGER_UNIT > FAILED!");
  end if;
  TEST_O_PASSED := Z >= X and Z >= Y and not (X >= Z);
  if not TEST_O_PASSED then
    put_line("INTEGER_UNIT >= FAILED!");
  end if;
  TEST_P_PASSED := Y = Z and not (X = Z);
  if not TEST_P_PASSED then
    put_line("INTEGER_UNIT = FAILED!");
  end if;
  TEST_Q_PASSED := X = +X;
  if not TEST_Q_PASSED then
    put_line("INTEGER_UNIT UNARY + FAILED!");
  end if;
  TEST_R_PASSED := -X = -1 * X;
  if not TEST_R_PASSED then
    put_line("INTEGER_UNIT UNARY - FAILED!");
  end if;
  if TEST_A_PASSED and TEST_B_PASSED and
     TEST_C_PASSED and TEST_D_PASSED and
     TEST_E_PASSED and TEST_F_PASSED and
     TEST_G_PASSED and TEST_H_PASSED and
     TEST_I_PASSED and TEST_J_PASSED and
     TEST_K_PASSED and TEST_L_PASSED and
     TEST_M_PASSED and TEST_N_PASSED and
     TEST_O_PASSED and TEST_P_PASSED and
     TEST_Q_PASSED and TEST_R_PASSED then
    put_line("All valid integer operations work.");
  end if;
  put_line("Test 1 Complete.");
end Test_1;
::::::::::
DUTEST2.ADA
::::::::::
--            DUTEST2.ADA
--            Version 1.0
--            3 January 1986
--            Do-While Jones

separate(DU_Test)
procedure Test_2 is

  type Feet is new Float_unit;

  X, Y, Z : Feet;
  F       : float;
  TEST_A_PASSED, TEST_B_PASSED, TEST_C_PASSED, TEST_D_PASSED,
  TEST_E_PASSED, TEST_F_PASSED, TEST_G_PASSED, TEST_H_PASSED,
  TEST_I_PASSED, TEST_J_PASSED, TEST_K_PASSED, TEST_L_PASSED,
  TEST_M_PASSED, TEST_N_PASSED, TEST_O_PASSED, TEST_P_PASSED,
  TEST_Q_PASSED, TEST_R_PASSED, TEST_S_PASSED, TEST_T_PASSED,
  TEST_U_PASSED, TEST_V_PASSED, TEST_W_PASSED, TEST_X_PASSED,
  TEST_Y_PASSED, TEST_Z_PASSED : boolean := FALSE;
begin
  X := Type_Convert(3.0);
  Y := Type_Convert(2.0);
  Z := Type_Convert(5.0);
  TEST_A_PASSED := X + Y = Z;
  if not TEST_A_PASSED then
    put_line("ADDITION_OPERATOR DOES NOT WORK!");
  end if;
  TEST_B_PASSED := Z - Y = X;
  if not TEST_B_PASSED then
    put_line("SUBTRACTION OPERATOR DOES NOT WORK!");
  end if;
  Z := Type_Convert(6.0);
  TEST_C_PASSED := 2 * X = Z;
  if not TEST_C_PASSED then
    put_line("LEFT INTEGER MULTIPLICATION FAILED!");
  end if;
  TEST_D_PASSED := X * 2 = Z;
  if not TEST_D_PASSED then
    put_line("RIGHT INTEGER MULTIPLICATION FAILED!");
  end if;
  TEST_E_PASSED := Z / 2 = X;
  if not TEST_E_PASSED then
    put_line("INTEGER DIVISION FAILED!");
  end if;
  TEST_F_PASSED := Z / X = 2;
  if not TEST_F_PASSED then
    put_line("DIMENSIONAL DIVISION WITH INTEGER RESULT FAILED!");
  end if;
  F := X / Z;
  TEST_G_PASSED := abs(F - 0.5) < 0.001;
  if not TEST_G_PASSED then
    put_line("DIMENSIONAL DIVISION WITH FLOAT RESULT FAILED!");
  end if;
  Z := Type_Convert(5.0);
  TEST_H_PASSED := Z rem X = Y;
  if not TEST_H_PASSED then
    put_line("FLOAT_UNIT REM OPERATION FAILED!");
  end if;
  TEST_I_PASSED := Z mod X = Y;
  if not TEST_I_PASSED then
    put_line("FLOAT_UNIT MOD OPERATION FAILED!");
  end if;
  TEST_J_PASSED := Dimensionless(Z) = 5;
  if not TEST_J_PASSED then
    put_line("DIMENSIONLESS FLOAT_UNIT INTEGER RESULT FAILED!");
  end if;
  F := Dimensionless(Z);
  TEST_K_PASSED := abs(F - 5.0) < 0.001;
  if not TEST_K_PASSED then
    put_line("DIMENSIONLESS FLOAT_UNIT FLOAT RESULT FAILED!");
  end if;
  X := Type_Convert(1.0);
  Y := Type_Convert(2.0);
  Z := Y;
  TEST_L_PASSED := X < Y and not(Y < X);
  if not TEST_L_PASSED then
    put_line("FLOAT_UNIT < FAILED!");
  end if;
  TEST_M_PASSED := X <= Y and Y <= Z and not (Z <= X);
  if not TEST_M_PASSED then
    put_line("FLOAT_UNIT <= FAILED!");
  end if;
  TEST_N_PASSED := Y > X and not (X > Y);
  if not TEST_N_PASSED then
    put_line("FLOAT_UNIT > FAILED!");
  end if;
  TEST_O_PASSED := Z >= X and Z >= Y and not (X >= Z);
  if not TEST_O_PASSED then
    put_line("FLOAT_UNIT >= FAILED!");
  end if;
  TEST_P_PASSED := Y = Z and not (X = Z);
  if not TEST_P_PASSED then
    put_line("FLOAT_UNIT = FAILED!");
  end if;
  TEST_Q_PASSED := X = +X;
  if not TEST_Q_PASSED then
    put_line("FLOAT_UNIT UNARY + FAILED!");
  end if;
  TEST_R_PASSED := -X = -1 * X;
  if not TEST_R_PASSED then
    put_line("FLOAT_UNIT UNARY - FAILED!");
  end if;
  X := Type_Convert(6.0);
  Y := Type_Convert(2.0);
  Z := Type_Convert(3.0);
  TEST_S_PASSED := X = 3.0 * Y;
  if not TEST_S_PASSED then
    put_line("FLOAT * FLOAT_UNIT FAILED!");
  end if;
  TEST_T_PASSED := X = Y * 3.0;
  if not TEST_T_PASSED then
    put_line("FLOAT_UNIT * FLOAT FAILED!");
  end if;
  TEST_U_PASSED := Z = X / 2.0;
  if not TEST_U_PASSED then
    put_line("FLOAT_UNIT / FLOAT FAILED");
  end if;
  if TEST_A_PASSED and TEST_B_PASSED and
     TEST_C_PASSED and TEST_D_PASSED and
     TEST_E_PASSED and TEST_F_PASSED and
     TEST_G_PASSED and TEST_H_PASSED and
     TEST_I_PASSED and TEST_J_PASSED and
     TEST_K_PASSED and TEST_L_PASSED and
     TEST_M_PASSED and TEST_N_PASSED and
     TEST_O_PASSED and TEST_P_PASSED and
     TEST_Q_PASSED and TEST_R_PASSED and
     TEST_S_PASSED and TEST_T_PASSED and
     TEST_U_PASSED then
    put_line("All valid float operations work.");
  end if;
  put_line("Test 2 Complete.");
end Test_2;
::::::::::
DUTEST3.ADA
::::::::::

--            DUTEST3.ADA
--            Version 1.0
--            31 August 1986
--            Do-While Jones

separate(DU_Test)
procedure Test_3 is

  type Radians is new Float_unit;
  type Feet is new Integer_unit;

  DISTANCE    : Feet;
  ANGLE       : Radians;
  PI          : constant Radians := Type_Convert(3.14159);
  REVOLUTIONS : integer;


  TEST_A_PASSED, TEST_B_PASSED, TEST_C_PASSED, TEST_D_PASSED,
  TEST_E_PASSED, TEST_F_PASSED, TEST_G_PASSED, TEST_H_PASSED,
  TEST_I_PASSED, TEST_J_PASSED, TEST_K_PASSED, TEST_L_PASSED,
  TEST_M_PASSED, TEST_N_PASSED, TEST_O_PASSED, TEST_P_PASSED,
  TEST_Q_PASSED, TEST_R_PASSED : boolean := FALSE;
begin
  TEST_A_PASSED := 7.0 / 3.0 = 2;
  TEST_B_PASSED := -7.0 / 3.0 = -2;
  TEST_C_PASSED := 7.0 / (-3.0) = -2;
  TEST_D_PASSED := -7.0 / (-3.0) = 2;
  if not (TEST_A_PASSED and TEST_B_PASSED and TEST_C_PASSED
   and TEST_D_PASSED) then
    put_line("EXTRA DIVISION FAILED!");
  end if;
  TEST_E_PASSED := 7.0 rem 3.0 = 1.0;
  TEST_F_PASSED := (-7.0) rem 3.0 = -1.0;
  TEST_G_PASSED := 7.0 rem (-3.0) = 1.0;
  TEST_H_PASSED := (-7.0) rem (-3.0) = -1.0;
  if not (TEST_E_PASSED and TEST_F_PASSED and TEST_G_PASSED
   and TEST_H_PASSED) then
    put_line("EXTRA REM FAILED!");
  end if;
  TEST_I_PASSED := 7.0 mod 3.0 = 1.0;
  TEST_J_PASSED := (-7.0) mod 3.0 = 2.0;
  TEST_K_PASSED := 7.0 mod (-3.0) = -2.0;
  TEST_L_PASSED := (-7.0) mod (-3.0) = -1.0;
  if not (TEST_I_PASSED and TEST_J_PASSED and TEST_K_PASSED
   and TEST_L_PASSED) then
    put_line("EXTRA MOD FAILED!");
  end if;
  if TEST_A_PASSED and TEST_B_PASSED and
     TEST_C_PASSED and TEST_D_PASSED and
     TEST_E_PASSED and TEST_F_PASSED and
     TEST_G_PASSED and TEST_H_PASSED and
     TEST_I_PASSED and TEST_J_PASSED and
     TEST_K_PASSED and TEST_L_PASSED then
    put_line("All valid extra operations work.");
  end if;

-- and here are a few extra tests I forgot

  ANGLE := Type_Convert(7.0);
  ANGLE := ANGLE mod (2.0 * PI);
  TEST_M_PASSED := abs(ANGLE-Type_Convert(0.71682))
   < Type_Convert(0.001);
  DISTANCE := Type_Convert(-87);
  TEST_N_PASSED := abs(DISTANCE) = Type_Convert(87);
  ANGLE := Type_Convert(14.0);
  REVOLUTIONS := ANGLE / (2.0 * PI);
  TEST_O_PASSED := REVOLUTIONS = 2;
  if TEST_M_PASSED and TEST_N_PASSED and TEST_O_PASSED then
    put_line("The forgotten tests worked, too!");
  else
    put_line("OOPS! At least one forgotten test FAILED!");
  end if;
  put_line("Test 3 Complete.");
end Test_3;