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