home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SHDK_2.ZIP / TESTLSTR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-06-16  |  10.7 KB  |  359 lines
  1. {$I SHDEFINE.INC}
  2.  
  3. {$IFDEF Gen87}
  4.   {$N+,E+}
  5. {$ELSE}
  6.   {$N-}
  7. {$ENDIF}
  8.  
  9. {$IFNDEF EmulationOK}
  10.   {$E-}
  11. {$ENDIF}
  12.  
  13.  
  14. program TestLstr;
  15. {
  16.                        To test the ShLngStr unit
  17.  
  18.                   Copyright 1991 Madison & Associates
  19.                           All Rights Reserved
  20.  
  21.          This program source file and the associated executable
  22.          file may be  used and distributed  only in  accordance
  23.          with the  provisions  described  on  the title page of
  24.                   the accompanying documentation file
  25.                               SKYHAWK.DOC
  26.  
  27. }
  28.  
  29. uses
  30. {$IFDEF OverlaysOK}
  31.   OverLstr,
  32.   Overlay,
  33. {$ENDIF}
  34.  
  35.   TpDos,
  36.   TpCrt,
  37.   ShCrcChk,
  38.   ShUtilPk,
  39.   ShLngStr;
  40.  
  41. {$IFDEF OverlaysOK}
  42.   {$F+}
  43.   {$O SHLNGSTR.TPU}
  44.   {$O SHCRCCHK.TPU}
  45.   {$O TPDOS.TPU}
  46. {$ENDIF}
  47.  
  48. const
  49.   Msg : array[1..12] of string[68] =
  50.     (('The routines in this unit process strings of characters up to 65517'),
  51.      (' char- acters in length. All of the string manipulation features'   ),
  52.      (' which you are used to having available for use have their analog ' ),
  53.      ('in this unit.'   +    ' Every effort has been made to keep all call'),
  54.      ('ing sequences as intuitive as pos- sible. '  +  'The test sequence '),
  55.      ('about to begin tests every function and procedure in the unit. Some'),
  56.      (' of these tests are implicit; you will not necessarily see them inv'),
  57.      ('oked in the test, but they will have been invoked at a lower level.'),
  58.      (    +  ' Please notify Madison & Associates at the address, phone nu'),
  59.      ('mber, or CIS User ID given in the documentation if you have any pro'),
  60.      ('blems or suggestions regarding ShLngStr. --- NOTE: This message is,'),
  61.      (' itself, a word-wrapped LongString.'                                ));
  62.  
  63. var
  64.   A,
  65.   B,
  66.   C,
  67.   D   : LongString;
  68.   E,
  69.   F,
  70.   G   : text;
  71.   OT  : text;
  72.   W1  : word;
  73.   S1  : string;
  74.   TstO: string;
  75.  
  76. procedure AnyKey;
  77.   begin
  78.     if HandleIsConsole(1) then begin
  79.       Write('Any key to continue...');
  80.       if ReadKey = #0 then ;
  81.       WriteLn;
  82.       end;
  83.     end;
  84.  
  85. procedure DC(A : LongString; As : String; B : LongString; Bs : String);
  86.   begin
  87.     WriteLn(OT);
  88.     case lsComp(A, B) of
  89.       LESS    : WriteLn(OT, As + ' < ' + Bs);
  90.       EQUAL   : WriteLn(OT, As + ' = ' + Bs);
  91.       GREATER : WriteLn(OT, As + ' > ' + Bs);
  92.       end; {case}
  93.     end; {DC}
  94.  
  95. procedure WrapLs(C : LongString);
  96.   begin
  97.     W1 := 0;
  98.     repeat
  99.       S1 := lsGetNextStrF(C);
  100.       if W1 + Length(S1) >= 75 then begin
  101.         W1 := Length(S1);
  102.         WriteLn(OT);
  103.         end
  104.       else
  105.         inc(W1, Length(S1)+1);
  106.       Write(OT, S1, ' ');
  107.       until lsLength(C) = 0;
  108.     WriteLn(OT);
  109.     end; {WrapLs}
  110.  
  111. procedure TestTrims;
  112.   const
  113.     X = '       +/ +/ +/ +/ +/ + /+ABCDEFG= = = = =       ';
  114.   var
  115.     A : LongString;
  116.     CS: set of Char;
  117.   begin
  118.     WriteLn(OT, 'TESTING THE TRIM ROUTINES'); WriteLn(OT);
  119.     CS := lsDelimSet + ['+','/','='];
  120.     if not lsInit(A, 40) then halt;
  121.     lsStr2LongString(X, A);
  122.     WriteLn(OT, 'The original string is |',X,'|');
  123.     lsWriteLn(OT, A);
  124.     WriteLn(OT, 'Trimming the lead,');
  125.     lsWriteLn(OT, lsTrimLeadF(A));
  126.     WriteLn(OT, 'Trimming the tail,');
  127.     lsWriteLn(OT, lsTrimTrailF(A));
  128.     WriteLn(OT, 'Trimming the whole string,');
  129.     lsWriteLn(OT, lsTrimF(A));
  130.     WriteLn(OT);
  131.     lsWriteLn(OT, A);
  132.     WriteLn(OT, 'The trimmable set is [#0..#32,''+'',''/'',''='']');
  133.     WriteLn(OT, 'Set-Trimming the lead,');
  134.     lsWriteLn(OT, lsTrimLeadSetF(A, CS));
  135.     WriteLn(OT, 'Set-Trimming the tail,');
  136.     lsWriteLn(OT, lsTrimTrailSetF(A, CS));
  137.     WriteLn(OT, 'Set-Trimming the whole string,');
  138.     lsWriteLn(OT, lsTrimSetF(A, CS));
  139.     WriteLn(OT); WriteLn(OT, 'END OF TRIM ROUTINES TEST');
  140.     lsDispose(A);
  141.     end; {TestTrims}
  142.  
  143. begin
  144.   if not OpenStdDev(OT, 1) then begin
  145.     WriteLn('Can''t open console device.');
  146.     Halt(1);
  147.     end;
  148.   lsSysInit;
  149.   WriteLn(OT);
  150.   lsWriteLn(OT, lsCharStrF(#205, 75));
  151.   WriteLn
  152.     (OT, '           ShLngStr -- A LongString Processing Unit'           );
  153.   WriteLn(OT); WriteLn
  154.     (OT, '                             from'                             );
  155.   WriteLn(OT); WriteLn
  156.     (OT, '              W. G. Madison and Associates, Ltd.'              );
  157.   WriteLn(OT); WriteLn
  158.     (OT, '          Copyright 1991  Madison & Associates, Ltd.'          );
  159.   WriteLn
  160.     (OT, '                     All rights reserved.'                     );
  161.   WriteLn(OT);
  162.   assign(F, 'TESTLSTR.DAT');
  163.   Reset(F);
  164.   TstO := UniqueFileName('',true);
  165.   Assign(G, TstO);
  166.   Rewrite(G);
  167.   if not lsInit(A, 512) then WriteLn(OT, 'Bad declaration on A');
  168.   if not lsInit(B, 600) then WriteLn(OT, 'Bad declaration on B');
  169.   if not lsInit(C, 2048) then WriteLn(OT, 'Bad declaration on C');
  170.   if not lsInit(D, 2048) then WriteLn(OT, 'Bad declaration on D');
  171.   for W1 := 1 to 12 do
  172.     lsTransfer(lsConcatStr2LsF(D, Msg[W1]), D);
  173.   WrapLs(D);
  174.   lsWriteLn(OT, lsCharStrF(#205, 75));
  175.   AnyKey;
  176.   WriteLn(OT);
  177.   TestTrims;
  178.   AnyKey;
  179.   D^.Length := 0;
  180.   lsIoff;
  181.   WriteLn(OT, 'BEGINNING FILE COPYING TEST.');
  182.   while not eof(F) do begin
  183.     lsReadLn(F, A);
  184.     if lsIoResult <> 0 then begin
  185.       WriteLn(OT, 'OOPS on reading. ',W1);
  186.       Halt;
  187.       end;
  188.     lsWriteLn(G, A);
  189.     if lsIoResult <> 0 then begin
  190.       WriteLn(OT, 'OOPS on writing. ',W1);
  191.       Halt;
  192.       end;
  193.     end; {while}
  194.   Close(F);
  195.   Close(G);
  196.   WriteLn(OT, 'Copying successful.');
  197.   WriteLn(OT);
  198.   WriteLn(OT, 'COMPARE THE ORIGINAL WITH THE COPIED FILE.');
  199.   if not HandleIsConsole(1) then begin
  200.     WriteLn(OT, 'Comparison test uses CRC check on redirected output.');
  201.     if (CrcCalc('TESTLSTR.DAT') = CrcCalc(TstO)  ) and
  202.        (TextFileSize(F)         = TextFileSize(G)) then begin
  203.       WriteLn(OT, 'Files compare OK.');
  204.       end
  205.     end
  206.   else begin
  207.     WriteLn(OT, 'Comparison test uses Dos COMP check on console output.');
  208.     assign(E, 'COMPARE.BAT');
  209.     Rewrite(E);
  210.     WriteLn(E, 'COMP TESTLSTR.DAT ' + TstO);
  211.     Close(E);
  212.     if ExecDos('COMPARE', true, nil) = 0 then ;
  213.     Erase(E);  {The batch file}
  214.     end;
  215.   WriteLn(OT);
  216.   Erase(G);  {The output file}
  217.   lsIon;
  218.  
  219.   Reset(F);
  220.   WriteLn(OT, 'BEGINNING RepAll, DelAll TEST.');
  221.   lsReadLn(F, A);
  222.   WriteLn(OT, '   The original LongString');
  223.   lsWriteLn(OT, A);
  224.   lsRepAllStr(A, 'abc', '12345', C);
  225.   lsTransfer(lsRepAllStrF(A, 'abc', '12345'), B);
  226.   WriteLn(OT, ^M^J'''abc'' replaced by ''12345''.');
  227.   lsWriteLn(OT, B);
  228.   DC(C, 'lsRepAllStr(A, ''abc'', ''12345'', C)',
  229.     B, 'lsRepAllStrF(A, ''abc'', ''12345'')');
  230.   AnyKey;
  231.  
  232.   lsRepAllStrUC(A, 'abc', '12345', C);
  233.   WriteLn(OT, ^M^J'Case insensitive replacement of ''abc'' by ''12345''.');
  234.   lsWriteLn(OT, C);
  235.   DC(C, 'lsRepAllStrUC(A, ''abc'', ''12345'', C)',
  236.     lsRepAllStrUCF(A, 'abc', '12345'), 'lsRepAllStrUCF(A, ''abc'', ''12345'')');
  237.   AnyKey;
  238.  
  239.   lsDelAllStr(A, 'abc', B);
  240.   WriteLn(OT, ^M^J'''abc'' deleted.');
  241.   lsWriteLn(OT, B);
  242.   DC(B, 'lsDelAllStr(A, ''abc'', B)', lsDelAllStrF(A, 'abc'),
  243.     'lsDelAllStrF(A, ''abc'')');
  244.   DC(B, 'lsDelAllStr(A, ''abc'', B)', lsDelAllF(A, lsStr2LongStringF('abc')),
  245.     'lsDelAllF(A, lsStr2LongStringF(''abc''))');
  246.   AnyKey;
  247.  
  248.   WriteLn(OT, ^M^J'CENTERED IN A FIELD 560 WIDE.');
  249.   lsCenter(A, 560, B);
  250.   lsWriteLn(OT, B);
  251.   DC(B, 'lsCenter(A, 560, B)', lsCenterF(A, 560), 'lsCenterF(A, 560)');
  252.   DC(B, 'lsCenter(A, 560, B)',
  253.          lsCenterChF(A, ' ', 560), 'lsCenterChF(A, '' '', 560)');
  254.   W1 := 560 - ((560 - lsLength(A)) shr 1);
  255.   lsPad(lsLeftPadF(A, W1), 560, C);
  256.   DC(B, 'lsCenter(A, 560, B)',
  257.      C, ^M^J' lsPad(lsLeftPadF(A, 560 - ((560 - lsLength(A)) shr 1)), 560, C)');
  258.   AnyKey;
  259.  
  260.   WriteLn(OT, ^M^J'RESTORE BY TRIMMING, PADDING.');
  261.   lsTrimTrail(lsTrimLeadF(B), C);
  262.   lsTrim(B, B);
  263.   lsLeftPad(B, lsLength(A), B);
  264.   lsLeftPad(C, lsLength(A), C);
  265.   lsWriteLn(OT, B);
  266.   DC(B, 'lsTrim(B, B); lsLeftPad(B, lsLength(A), B)',
  267.         lsLeftPadF(lsTrimF(B), lsLength(A)),
  268.         'lsLeftPadF(lsTrimF(B), lsLength(A))');
  269.   DC(B, 'lsTrim(B, B); lsLeftPad(B, lsLength(A), B)',
  270.      C, ^M^J' lsTrimTrail(lsTrimLeadF(B), C); lsLeftPad(C, lsLength(A), C)');
  271.   AnyKey;
  272.  
  273.   WriteLn(OT, ^M^J'UPCASE TEST');
  274.   lsWriteLn(OT, lsUpcaseF(B));
  275.   lsUpcase(B, C);
  276.   DC(lsUpcaseF(B), 'lsUpcaseF(B)', C, 'lsUpcase(B, C)');
  277.   AnyKey;
  278.  
  279.   WriteLn(OT, ^M^J'LOCASE TEST');
  280.   lsWriteLn(OT, lsLocaseF(B));
  281.   lsLocase(B, C);
  282.   DC(lsLocaseF(B), 'lsLocaseF(B)', C, 'lsLocase(B, C)');
  283.   AnyKey;
  284.  
  285.   WriteLn(OT, ^M^J'COPY TEST');
  286.   WriteLn(OT, 'Copy first upper case alphabet from the following string.');
  287.   lsWriteLn(OT, A);
  288.   lsCopy(A, lsPosStr('A', A), 26, B);
  289.   WriteLn(OT);
  290.   lsWriteLn(OT, lsCopyF(A, lsPosStr('A', A), 26));
  291.   DC(B, 'lsCopy(A, lsPosStr(''A'', A), 26, B)',
  292.     lsCopyF(A, lsPosStr('A', A), 26),
  293.     'lsCopyF(A, lsPosStr(''A'', A), 26)');
  294.   AnyKey;
  295.  
  296.   WriteLn(OT, ^M^J'INSERT TEST');
  297.   WriteLn(OT, 'Insert upper case alphabet preceeding ''k'' in original LongString.');
  298.   lsWriteLn(OT, A);
  299.   WriteLn(OT);
  300.   lsWriteLn(OT, B);
  301.   WriteLn(OT);
  302.   lsWriteLn(OT, lsInsertStrF(A, lsLongString2Str(B), lsPosStr('k', A)));
  303.   lsInsertStr(A, lsLongString2Str(B), lsPosStr('k', A), C);
  304.   DC(C, 'lsInsertStr(A, lsLongString2Str(B), lsPosStr(''k'', A), C)',
  305.       lsInsertStrF(A, lsLongString2Str(B), lsPosStr('k', A)),
  306.       ^M^J'     lsInsertStrF(A, lsLongString2Str(B), lsPosStr(''k'', A))');
  307.   AnyKey;
  308.  
  309.   WriteLn(OT, ^M^J'DELETE TEST');
  310.   WriteLn(OT, 'Delete the inserted upper case alphabet from the above.');
  311.   WriteLn(OT, '   This should return the LongString to its original form.');
  312.   lsWriteLn(OT, lsDeleteF(C, lsPosStr('A', C), 26));
  313.   DC(A, 'A', lsDeleteF(C, lsPosStr('A', C), 26),
  314.             'lsDeleteF(C, lsPosStr(''A'', C), 26)');
  315.   AnyKey;
  316.  
  317.   {Prepare for concatenation, GetNext tests}
  318.   Reset(F);
  319.   repeat
  320.     lsReadLn(F, A);
  321.     until lsPosStrUC('WHEN', A) <> 0;
  322.   lsTransfer(A, C);
  323.   lsTransfer(A, D);
  324.   repeat
  325.     lsReadLn(F, A);
  326.     lsConcat(C, A, C);
  327.     lsTransfer(lsConcatF(D, A), D);
  328.     until eof(F);
  329.  
  330.   WriteLn(OT, ^M^J'CONCATENATION TEST');
  331.   lsWriteLn(OT, C);
  332.   DC(C, 'lsConcat(C, A, C)', D, 'lsTransfer(lsConcatF(D, A), D)');
  333.   AnyKey;
  334.  
  335.   WriteLn(OT, ^M^J'GETNEXT TEST, DOING A WORD WRAP ON THE ABOVE.');
  336.   WrapLs(C);
  337.   Close(F);
  338.   lsDispose(A);
  339.   lsDispose(B);
  340.   lsDispose(C);
  341.   lsDispose(D);
  342.   lsSysDeinit;
  343.  
  344.   WriteLn(OT, ^M^J'I/O ERROR HANDLING TEST.');
  345.   lsIoff;
  346.   Assign(E, 'FOO.BAZ');
  347.   WriteLn
  348.     (OT, 'The next line displayed should be ''104 (File not open for input)''');
  349.   lsReadLn(E, A);
  350.   WriteLn(OT, lsIoResult,' (File not open for input)');
  351.   Flush(OT);
  352.   WriteLn
  353.     (^M^J^J'The next event should be a runtime error and termination of the'+
  354.      ^M^J' test of ShLngStr.');
  355.   lsReadLn(E, A);
  356.   lsReadLn(E, A);
  357.   lsIon;
  358.   end.
  359.