home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / pascal / shdk_1.zip / TESTUTIL.PAS < prev   
Pascal/Delphi Source File  |  1992-03-23  |  5KB  |  171 lines
  1. program TestUtil;
  2. {
  3.                        To test the ShUtilPk unit
  4.  
  5.                   Copyright 1991 Madison & Associates
  6.                           All Rights Reserved
  7.  
  8.          This program source file and the associated executable
  9.          file may be  used and distributed  only in  accordance
  10.          with the  provisions  described  on  the title page of
  11.                   the accompanying documentation file
  12.                               SKYHAWK.DOC
  13. }
  14.  
  15. uses
  16.   TpCrt,
  17.   TpString,
  18.   TpDos,
  19.   ShUtilPk;
  20.  
  21. const
  22.   S1  : string = '  Now is  the        time  for all good gorps.   ';
  23.  
  24. var
  25.   S2,
  26.   O1,
  27.   O2  : string;
  28.   T1  : LongInt;
  29.   T2  : integer;
  30.   W1,
  31.   W2  : word;
  32.   F1  : file;
  33.  
  34. procedure AnyKey;
  35.   begin
  36.     if HandleIsConsole(1) then begin
  37.       Write('Any key to continue...');
  38.       if ReadKey = #0 then ;
  39.       WriteLn;
  40.       end;
  41.     end;
  42.  
  43. begin
  44.   WriteLn('The functions BETWU and BETWS require such a large amount' );
  45.   WriteLn('of output to test them properly that it is not feasible to');
  46.   WriteLn('include them in this current test suite. The tests for'    );
  47.   WriteLn('these two functions will be found in the file TESTBETW, in');
  48.   WriteLn('both source and executable form.'                          );
  49.   WriteLn;
  50.   AnyKey;
  51.   WriteLn;
  52.   WriteLn(Center('REPALL, DELALL TEST', 75));
  53.   S2 := 'aabcbcabcd';
  54.   WriteLn(S2);
  55.   WriteLn('Replacing ''abc'' by ''12345''');
  56.   O1 := 'abc';
  57.   O2 := '12345';
  58.   WriteLn(RepAllF(S2, O1, O2));
  59.   WriteLn;
  60.   WriteLn(S2);
  61.   WriteLn('Deleting all ''abc''');
  62.   WriteLn(DelAllF(S2, O1));
  63.   WriteLn('  Note: Did not delete strings caused by the DelAll process.');
  64.   WriteLn;
  65.   WriteLn('Deleting all (including incidental) ''abc''');
  66.   repeat
  67.     DelAll(S2, O1, S2);
  68.     until Pos(O1, S2) = 0;
  69.   WriteLn(S2);
  70.   AnyKey;
  71.   WriteLn;
  72.   WriteLn;
  73.   WriteLn(Center('GETNEXT TEST', 75));
  74.   WriteLn('|',S1,'|');
  75.   T1 := 0;
  76.   repeat
  77.     inc(T1);
  78.     GetNext(S1, S2);
  79.     WriteLn(T1);
  80.     WriteLn('|',S2,'|');
  81.     WriteLn('|',S1,'|');
  82.     WriteLn;
  83.     AnyKey;
  84.     until S1 = '';
  85.   WriteLn;
  86.   WriteLn;
  87.   WriteLn(Center('HEX TEST', 75));
  88.   WriteLn('Inside a loop, you will be asked to enter a number. When you want');
  89.   WriteLn('to break out of the loop, enter an alpha string instead.');
  90.   WriteLn;
  91.   repeat
  92.     Write('Enter an integer-type number » ');
  93.     {$I-}ReadLn(T1);{$I+}
  94.     T2 := IoResult;
  95.     if T2 = 0 then begin
  96.       WriteLn('   The HEX equivalent is ',HEX(T1));
  97.       WriteLn;
  98.       end;
  99.     until T2 <> 0;
  100.   AnyKey;
  101.   WriteLn;
  102.   WriteLn;
  103.   WriteLn(Center('HIWORD, LOWORD, LI TEST', 75));
  104.   T1 := $DCBA9876;
  105.   WriteLn(Hex(T1),',   ',T1);
  106.   W1 := HiWord(T1);
  107.   W2 := LoWord(T1);
  108.   WriteLn('':3,'HiWord(T1) = ',Hex(W1));
  109.   WriteLn('':3,'LoWord(T1) = ',Hex(W2));
  110.   WriteLn('Re-assembling in reverse order:');
  111.   T1 := LI(W1, W2);
  112.   WriteLn(Hex(T1),',   ',T1);
  113.   AnyKey;
  114.   WriteLn;
  115.   WriteLn;
  116.   WriteLn(Center('PMOD TEST', 75));
  117.   WriteLn;
  118.   T1 := -7;
  119.   T2 := 13;
  120.   WriteLn('For X = ',T1,'   and M = ',T2);
  121.   WriteLn('':5,'(X mod M) = ',(T1 mod T2));
  122.   WriteLn('':2,'but');
  123.   WriteLn('':5,'Pmod(X,M) = ',Pmod(T1, T2));
  124.   AnyKey;
  125.   WriteLn;
  126.   WriteLn;
  127.   WriteLn(Center('POSSET TEST', 75));
  128.   WriteLn('Str = ''XIY2C3Z4B'',    A = [''A'', ''B'', ''C'']');
  129.   WriteLn('     PosSet(A, Str) returns ',PosSet(['A', 'B', 'C'], 'XIY2C3Z4B'));
  130.   AnyKey;
  131.   WriteLn;
  132.   WriteLn;
  133.   WriteLn(Center('SEARCHENVIRONMENT TEST', 75));
  134.   WriteLn(^G'You will need to set up this test yourself, since there is no');
  135.   WriteLn('way for us to know what environment strings you have set up.');
  136.   AnyKey;
  137.   WriteLn;
  138.   WriteLn;
  139.   WriteLn(Center('STARSTRING TEST', 75));
  140.   S2 := 'ABCDEFG';
  141.   O1 := '*B*EFG';
  142.   O2 := '*B*EGF';
  143.   WriteLn('if');
  144.   WriteLn('':3,'S2 := ''ABCDEFG''');
  145.   WriteLn('':3,'O1 := ''*B*EFG''');
  146.   WriteLn('':3,'O2 := ''*B*EGF''');
  147.   WriteLn('     StarString(O1, S2) = ', StarString(O1, S2));
  148.   WriteLn('     StarString(O2, S2) = ', StarString(O2, S2));
  149.   AnyKey;
  150.   WriteLn;
  151.   WriteLn;
  152.   WriteLn(Center('UNIQUEFILENAME TEST', 75));
  153.   S2 := UniqueFileName('', false);
  154.   WriteLn('A unique file name in this directory will be ',S2);
  155.   WriteLn('    This file will be temporarily created with a $$$ extension.');
  156.   assign(F1, S2);
  157.   Rewrite(F1);
  158.   Close(F1);
  159.   S2 := UniqueFileName('', true);
  160.   WriteLn('A unique name with an extension will be ',S2);
  161.   Erase(F1);
  162.   AnyKey;
  163.   WriteLn;
  164.   WriteLn;
  165.   WriteLn(Center('WHOAMI TEST', 75));
  166.   if Hi(DosVersion) >= $03 then
  167.     WriteLn('The currently executing file is ',WhoAmI)
  168.   else
  169.     WriteLn('This function requires Dos version 3.0 or higher.');
  170.   end.
  171.