Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/SHDK_2.ZIP/TESTUTIL.PAS

Pascal/Delphi Source File | 1992-05-13 | 5.1 KB | 191 lines

{$I SHDEFINE.INC}

{$I SHUNITSW.INC}

unit TestUtil;
{
                       To test the ShUtilPk unit

                  Copyright 1991 Madison & Associates
                          All Rights Reserved

         This program source file and the associated executable
         file may be  used and distributed  only in  accordance
         with the  provisions  described  on  the title page of
                  the accompanying documentation file
                              SKYHAWK.DOC
}

interface

uses
  TpCrt,
  TpString,
  TpDos,
  ShUtilPk;

procedure UtilTest;

implementation

procedure UtilTest;

const
  S1  : string = '  Now is  the        time  for all good gorps.   ';

var
  S2,
  O1,
  O2  : string;
  T1  : LongInt;
  T2  : integer;
  W1,
  W2  : word;
  F1  : file;

  O   : text;

procedure AnyKey;
  begin
    if HandleIsConsole(1) then begin
      Write(O, 'Any key to continue...');
      if ReadKey = #0 then ;
      WriteLn(O);
      end;
    end;

begin
  if OpenStdDev(O, 1) then ;
  WriteLn(O, 'The functions BETWU and BETWS require such a large amount' );
  WriteLn(O, 'of output to test them properly that it is not feasible to');
  WriteLn(O, 'include them in this current test suite. The tests for'    );
  WriteLn(O, 'these two functions will be found in the file TESTBETW, in');
  WriteLn(O, 'both source and executable form.'                          );
  WriteLn(O);
  AnyKey;
  WriteLn(O);
  WriteLn(O, Center('REPALL, DELALL TEST', 75));
  S2 := 'aabcbcabcd';
  WriteLn(O, S2);
  WriteLn(O, 'Replacing ''abc'' by ''12345''');
  O1 := 'abc';
  O2 := '12345';
  WriteLn(O, RepAllF(S2, O1, O2));
  WriteLn(O);
  WriteLn(O, S2);
  WriteLn(O, 'Deleting all ''abc''');
  WriteLn(O, DelAllF(S2, O1));
  WriteLn(O, '  Note: Did not delete strings caused by the DelAll process.');
  WriteLn(O);
  WriteLn(O, 'Deleting all (including incidental) ''abc''');
  repeat
    DelAll(S2, O1, S2);
    until Pos(O1, S2) = 0;
  WriteLn(O, S2);
  AnyKey;
  WriteLn(O);
  WriteLn(O);
  WriteLn(O, Center('GETNEXT TEST', 75));
  WriteLn(O, '|',S1,'|');
  T1 := 0;
  repeat
    inc(T1);
    GetNext(S1, S2);
    WriteLn(O, T1);
    WriteLn(O, '|',S2,'|');
    WriteLn(O, '|',S1,'|');
    WriteLn(O);
    AnyKey;
    until S1 = '';
  WriteLn(O);
  WriteLn(O);
  WriteLn(O, Center('HEX TEST', 75));
  WriteLn(O, 'Inside the following loop, enter a number. When you want');
  WriteLn(O, 'to break out of the loop, enter an alpha string instead.');
  WriteLn(O);
  if HandleIsConsole(1) then
    repeat
      Write(O, 'Enter an integer-type number » ');
      {$I-}ReadLn(T1);{$I+}
      T2 := IoResult;
      if T2 = 0 then begin
        WriteLn(O, '   The HEX equivalent is ',HEX(T1));
        WriteLn(O);
        end;
      until T2 <> 0
  else
    WriteLn(O, 'HEX test not available under redirection.');
  AnyKey;
  WriteLn(O);
  WriteLn(O);
  WriteLn(O, Center('HIWORD, LOWORD, LI TEST', 75));
  T1 := $DCBA9876;
  WriteLn(O, Hex(T1),',   ',T1);
  W1 := HiWord(T1);
  W2 := LoWord(T1);
  WriteLn(O, '':3,'HiWord(T1) = ',Hex(W1));
  WriteLn(O, '':3,'LoWord(T1) = ',Hex(W2));
  WriteLn(O, 'Re-assembling in reverse order:');
  T1 := LI(W1, W2);
  WriteLn(O, Hex(T1),',   ',T1);
  AnyKey;
  WriteLn(O);
  WriteLn(O);
  WriteLn(O, Center('PMOD TEST', 75));
  WriteLn(O);
  T1 := -7;
  T2 := 13;
  WriteLn(O, 'For X = ',T1,'   and M = ',T2);
  WriteLn(O, '':5,'(X mod M) = ',(T1 mod T2));
  WriteLn(O, '':2,'but');
  WriteLn(O, '':5,'Pmod(X,M) = ',Pmod(T1, T2));
  AnyKey;
  WriteLn(O);
  WriteLn(O);
  WriteLn(O, Center('POSSET TEST', 75));
  WriteLn(O, 'Str = ''XIY2C3Z4B'',    A = [''A'', ''B'', ''C'']');
  WriteLn(O, '     PosSet(A, Str) returns ',PosSet(['A', 'B', 'C'], 'XIY2C3Z4B'));
  AnyKey;
  WriteLn(O);
  WriteLn(O);
  WriteLn(O, Center('SEARCHENVIRONMENT TEST', 75));
  WriteLn(O, ^G'You will need to set up this test yourself, since there is no');
  WriteLn(O, 'way for us to know what environment strings you have set up.');
  AnyKey;
  WriteLn(O);
  WriteLn(O);
  WriteLn(O, Center('STARSTRING TEST', 75));
  S2 := 'ABCDEFG';
  O1 := '*B*EFG';
  O2 := '*B*EGF';
  WriteLn(O, 'if');
  WriteLn(O, '':3,'S2 := ''ABCDEFG''');
  WriteLn(O, '':3,'O1 := ''*B*EFG''');
  WriteLn(O, '':3,'O2 := ''*B*EGF''');
  WriteLn(O, '     StarString(O1, S2) = ', StarString(O1, S2));
  WriteLn(O, '     StarString(O2, S2) = ', StarString(O2, S2));
  AnyKey;
  WriteLn(O);
  WriteLn(O);
  WriteLn(O, Center('UNIQUEFILENAME TEST', 75));
  S2 := UniqueFileName('', false);
  WriteLn(O, 'A unique file name in this directory will be ',S2,' and');
  WriteLn(O, '    this file will be temporarily created with a $$$ extension.');
  assign(F1, S2);
  Rewrite(F1);
  Close(F1);
  S2 := UniqueFileName('', true);
  WriteLn(O, 'Another unique name with an extension will be ',S2);
  Erase(F1);
  AnyKey;
  WriteLn(O);
  WriteLn(O);
  WriteLn(O, Center('WHOAMI TEST', 75));
  if Hi(DosVersion) >= $03 then
    WriteLn(O, 'The currently executing file is ',WhoAmI)
  else
    WriteLn(O, 'This function requires Dos version 3.0 or higher.');
  Flush(O);
  end; {UtilTest}
end.