home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / sk210f.zip / TESTDRVR.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-10  |  18KB  |  561 lines
  1. unit TestDrvr;
  2. {
  3.                            Test suite driver
  4.                                 for the
  5.                       SkyHawk Developer's ToolKit.
  6.  
  7.                   Copyright 1991 Madison & Associates
  8.                           All Rights Reserved
  9.  
  10.          This program source file and the associated executable
  11.          file may be  used and distributed  only in  accordance
  12.          with the  provisions  described  on  the title page of
  13.                   the accompanying documentation file
  14.                               SKYHAWK.DOC
  15. }
  16.  
  17. interface
  18.  
  19. uses
  20.   Dos,
  21.  
  22.   TestBetw,   TestCmpx,   TestColr,   TestCrc,    TestDate,
  23.   TestFin,    TestList,   TestUtil,
  24.  
  25.   ShClrDef,   ShCmplx,    ShCrcChk,   ShDatPk,    ShFinanc,
  26.   ShList,     ShUtilPk,
  27.  
  28.   TpString,   TpCrt,      TpCmd,      TpDos,      TpEdit,
  29.   TpMemChk,   TpWindow,   TpMenu,
  30.  
  31.   ShErrMsg;
  32.  
  33. {$IFNDEF DPMI}
  34. type
  35.   InitExecFunc  = function(LastToSave : pointer;
  36.                            SwapFileName : string) : boolean;
  37.  
  38.   ExecSwapFunc  = function(Path, CmdLine : string) : word;
  39.  
  40. var
  41.   InitExecF  : InitExecFunc;
  42.   ExecSwapF  : ExecSwapFunc;
  43. {$ENDIF}
  44.  
  45. procedure DoTests;
  46.  
  47. implementation
  48.  
  49. var
  50.   Xsave,
  51.   Ysave   : byte;
  52.   WinBuf : pointer;
  53.  
  54. procedure DoTests;
  55.  
  56.   const
  57.     MaxItems  = 12;
  58.     HelpLine  : array[1..MaxItems] of string[40] =
  59.                ('Tests of BETWEEN routines in ShUtilPk.'  ,
  60.                 'Tests of Color Selection unit.'          ,
  61.                 'Tests of Command Line Parsing unit.'     ,
  62.                 'Tests of Complex Arithmetic unit.'       ,
  63.                 'Tests of File CRC unit.'                 ,
  64.                 'Tests of Date Manipulation unit.'        ,
  65.                 'Tests of Error Message unit.'            ,
  66.                 'Tests of List Processing unit.'          ,
  67.                 'Tests of Long String Processing unit.'   ,
  68.                 'Tests of remainder of ShUtilPk.'         ,
  69.                 'Sequences through the entire test suite.',
  70.                 'Tests of Financial unit.'
  71.                );
  72.  
  73.   var
  74.     O   : text;
  75.     SMA,
  76.     SXA : LongInt;
  77.  
  78.   procedure InitMenu(var M : Menu);
  79.     const
  80.       Color1 : MenuColorArray = (
  81.                     YellowOnBlack,    {Frame Color}
  82.                     YellowOnBlack,    {Menu Header Color}
  83.                     LtCyanOnBlue,     {Body Color}
  84.                     WhiteOnBrown,     {Selected Item Color}
  85.                     WhiteOnBlue,      {Pick Character Color}
  86.                     YellowOnBlack,    {Help Row Color}
  87.                     CyanOnBlue,       {Disabled Item Color}
  88.                     DkGrayOnLtGray    {Shadow Color}
  89.                                 );
  90.       Frame1 : FrameArray = '╔╚╗╝═║';
  91.     var
  92.       C1 : char;
  93.       T1 : byte;
  94.  
  95.     begin
  96.       C1 := 'A';
  97.       T1 := 1;
  98.       {Customize this call for special exit characters and custom item
  99.        displays}
  100.       M := NewMenu([], nil);
  101.  
  102.       SubMenu(24,5,4,Vertical,Frame1,Color1,' SKYHAWK TEST MENU ');
  103.         MenuItem(C1+': Perform all tests' ,T1, 1,11,
  104.                   Center(HelpLine[11], 72));
  105.                   inc(C1); inc(T1);
  106.         MenuItem(C1+': Test BetwS, BetwU' ,T1, 1, 1,
  107.                   Center(HelpLine[ 1], 72));
  108.                   inc(C1); inc(T1);
  109.         MenuItem(C1+': Test ShClrDef'     ,T1, 1, 2,
  110.                   Center(HelpLine[ 2], 72));
  111.                   inc(C1); inc(T1);
  112.         MenuItem(C1+': Test ShCmdLin'     ,T1, 1, 3,
  113.                   Center(HelpLine[ 3], 72));
  114.                   inc(C1); inc(T1);
  115.         MenuItem(C1+': Test ShCmplx'      ,T1, 1, 4,
  116.                   Center(HelpLine[ 4], 72));
  117.                   inc(C1); inc(T1);
  118.         MenuItem(C1+': Test ShCrcChk'     ,T1, 1, 5,
  119.                   Center(HelpLine[ 5], 72));
  120.                   inc(C1); inc(T1);
  121.         MenuItem(C1+': Test ShDatPk'      ,T1, 1, 6,
  122.                   Center(HelpLine[ 6], 72));
  123.                   inc(C1); inc(T1);
  124.         MenuItem(C1+': Test ShErrMsg'     ,T1, 1, 7,
  125.                   Center(HelpLine[ 7], 72));
  126.                   inc(C1); inc(T1);
  127.         MenuItem(C1+': Test ShFinanc'     ,T1, 1,12,
  128.                   Center(HelpLine[12], 72));
  129.                   inc(C1); inc(T1);
  130.         MenuItem(C1+': Test ShList'       ,T1, 1, 8,
  131.                   Center(HelpLine[ 8], 72));
  132.                   inc(C1); inc(T1);
  133.         MenuItem(C1+': Test ShLngStr'     ,T1, 1, 9,
  134.                   Center(HelpLine[ 9], 72));
  135.                   inc(C1); inc(T1);
  136.         MenuItem(C1+': Test ShUtilPk'     ,T1, 1,10,
  137.                   Center(HelpLine[10], 72));
  138.                   inc(C1); inc(T1);
  139.         MenuItem(   'X: Exit to DOS'      ,T1, 1,99,
  140.                   Center('Exit from the test program.', 72));
  141.         PopSublevel;
  142.  
  143.       ResetMenu(M);
  144.     end; {InitMenu}
  145.  
  146.   procedure TestHeader(B : byte);
  147.     begin
  148.       SMA := MemAvail;
  149.       SXA := MaxAvail;
  150.       GoToXYabs(1, ScreenHeight);
  151.       WriteLn(O,Center(CharStr('*',60), 72));
  152.       WriteLn(O,Center(CharStr('*',60), 72));
  153.       WriteLn(O,Center(CenterCh('  '+HelpLine[B]+'  ','*',60), 72));
  154.       WriteLn(O,Center(CharStr('*',60), 72));
  155.       WriteLn(O,Center(CharStr('*',60), 72));
  156.       WriteLn(O);
  157.       Flush(O);
  158.       end; {TestHeader}
  159.  
  160.   procedure TestTrailer(B : byte);
  161.     var
  162.       MA,
  163.       XA  : LongInt;
  164.       S1  : string;
  165.     begin {TestTrailer}
  166.       MA := MemAvail;
  167.       XA := MaxAvail;
  168.       WriteLn(O,^M^J,Center(CharStr('*',60), 72));
  169.       S1 := '  End of '+HelpLine[B]+'  ';
  170.       WriteLn(O, Center(CenterCh(S1,'*',60), 72));
  171.       S1 := '  '+Long2Str(SMA)+' ** MemAvail ** '+Long2Str(MA)+'  ';
  172.       WriteLn(O, Center(CenterCh(S1,'*',60),72));
  173.       S1 := '  '+Long2Str(SXA)+' ** MaxAvail ** '+Long2Str(XA)+'  ';
  174.       WriteLn(O, Center(CenterCh(S1,'*',60),72));
  175.       WriteLn(O, Center(CharStr('*',60), 72));
  176.       if not HandleIsConsole(1) then
  177.         WriteLn(O,^L)
  178.       else begin
  179.         WriteLn(O);
  180.         WriteLn(O);
  181.         end;
  182.       Flush(O);
  183.       end; {TestTrailer}
  184.  
  185.   procedure AnyKey;
  186.     begin
  187.       if HandleIsConsole(1) then begin
  188.         Write('Any key to continue... ');
  189.         if ReadKey = #0 then ;
  190.         GoToXY(1, WhereY);
  191.         DelLine;
  192.         end;
  193.       end;
  194.  
  195.   var
  196.     XSwpOK  : boolean;
  197.     XSwpErr : word;
  198.  
  199.     M       : Menu;
  200.     Ch      : Char;
  201.     Key     : MenuKey;
  202.  
  203.  
  204.   procedure BetwFunctionsTest;
  205.     begin {BetwFunctionsTest}
  206.       TestHeader(Key);
  207.       BetwTest;
  208.       TestTrailer(Key);
  209.       end; {BetwFunctionsTest}
  210.  
  211.   procedure ColorSelectionTest;
  212.     begin {ColorSelectionTest}
  213.       TestHeader(Key);
  214.       if HandleIsConsole(1) then
  215.         ColrTest
  216.       else
  217.         WriteLn(O, 'Test not available under redirection.');
  218.       TestTrailer(Key);
  219.       end; {ColorSelectionTest}
  220.  
  221.   procedure CommandLineTest;
  222.     const
  223.       A : array[1..2] of string[ 9] =
  224.              ('a:''14.26''',
  225.               'a: 14.26 '  );
  226.       B : array[1..1] of string[ 5] =
  227.              (';b=17');
  228.       T : array[1..3] of string[13] =
  229.              ('/30:''thirty'' ',
  230.               '/30:''thi"rty''',
  231.               '/30:"thi''rty"' );
  232.       C : array[1..4] of string[ 8] =
  233.              ('-c:''40a ' ,
  234.               '-c:''40a''',
  235.               '-c: 40a"'  ,
  236.               '-c: 40a '  );
  237.       D : array[1..2] of string[32] =
  238.              (';d=This is a packable arg.'        ,
  239.               ';d=''This is a non-packable arg.''');
  240.  
  241.     begin {CommandLineTest}
  242.       TestHeader(Key);
  243. {$IFDEF DPMI}
  244.       XSwpErr := ExecDos('TESTCMDL ' +
  245.                                           A[1] +
  246.                                           B[1] +
  247.                                           T[1] +
  248.                                           C[1] +
  249.                                           D[1], true, nil);
  250.       if XSwpErr <> 0 then
  251.         WriteLn('ExecDOS Error = ', XSwpErr);
  252.       XSwpErr := ExecDos('TESTCMDL ' +
  253.                                           A[2] +
  254.                                           B[1] +
  255.                                           T[1] +
  256.                                           C[2] +
  257.                                           D[2], true, nil);
  258.       if XSwpErr <> 0 then
  259.         WriteLn('ExecDOS Error = ', XSwpErr);
  260.       XSwpErr := ExecDos('TESTCMDL ' +
  261.                                           A[1] +
  262.                                           B[1] +
  263.                                           T[1] +
  264.                                           C[4] +
  265.                                           D[1], true, nil);
  266.       if XSwpErr <> 0 then
  267.         WriteLn('ExecDOS Error = ', XSwpErr);
  268.       XSwpErr := ExecDos('TESTCMDL ' +
  269.                                           A[2] +
  270.                                           B[1] +
  271.                                           T[2] +
  272.                                           C[3] +
  273.                                           D[2], true, nil);
  274.       if XSwpErr <> 0 then
  275.         WriteLn('ExecDOS Error = ', XSwpErr);
  276.       XSwpErr := ExecDos('TESTCMDL ' +
  277.                                           A[1] +
  278.                                           B[1] +
  279.                                           T[2] +
  280.                                           C[4] +
  281.                                           D[1], true, nil);
  282.       if XSwpErr <> 0 then
  283.         WriteLn('ExecDOS Error = ', XSwpErr);
  284.       XSwpErr := ExecDos('TESTCMDL ' +
  285.                                           A[1] +
  286.                                           B[1] +
  287.                                           T[3] +
  288.                                           C[4] +
  289.                                           D[2], true, nil);
  290.       if XSwpErr <> 0 then
  291.         WriteLn('ExecDOS Error = ', XSwpErr);
  292. {$ELSE}
  293.       SwapVectors;
  294.       XSwpErr := ExecSwapF('TESTCMDL.EXE',
  295.                                           A[1] +
  296.                                           B[1] +
  297.                                           T[1] +
  298.                                           C[1] +
  299.                                           D[1] );
  300.       if XSwpErr <> 0 then
  301.         WriteLn('Exec Swap Error = ', XSwpErr);
  302.       XSwpErr := ExecSwapF('TESTCMDL.EXE',
  303.                                           A[2] +
  304.                                           B[1] +
  305.                                           T[1] +
  306.                                           C[2] +
  307.                                           D[2] );
  308.       if XSwpErr <> 0 then
  309.         WriteLn('Exec Swap Error = ', XSwpErr);
  310.       XSwpErr := ExecSwapF('TESTCMDL.EXE',
  311.                                           A[1] +
  312.                                           B[1] +
  313.                                           T[1] +
  314.                                           C[4] +
  315.                                           D[1] );
  316.       if XSwpErr <> 0 then
  317.         WriteLn('Exec Swap Error = ', XSwpErr);
  318.       XSwpErr := ExecSwapF('TESTCMDL.EXE',
  319.                                           A[2] +
  320.                                           B[1] +
  321.                                           T[2] +
  322.                                           C[3] +
  323.                                           D[2] );
  324.       if XSwpErr <> 0 then
  325.         WriteLn('Exec Swap Error = ', XSwpErr);
  326.       XSwpErr := ExecSwapF('TESTCMDL.EXE',
  327.                                           A[1] +
  328.                                           B[1] +
  329.                                           T[2] +
  330.                                           C[4] +
  331.                                           D[1] );
  332.       if XSwpErr <> 0 then
  333.         WriteLn('Exec Swap Error = ', XSwpErr);
  334.       XSwpErr := ExecSwapF('TESTCMDL.EXE',
  335.                                           A[1] +
  336.                                           B[1] +
  337.                                           T[3] +
  338.                                           C[4] +
  339.                                           D[2] );
  340.       if XSwpErr <> 0 then
  341.         WriteLn('Exec Swap Error = ', XSwpErr);
  342.       SwapVectors;
  343. {$ENDIF}
  344.       TestTrailer(Key);
  345.       end; {CommandLineTest}
  346.  
  347.   procedure ComplexArithmeticTest;
  348.     begin {ComplexArithmeticTest}
  349.       TestHeader(Key);
  350.       CmpxTest;
  351.       TestTrailer(Key);
  352.       end; {ComplexArithmeticTest}
  353.  
  354.   procedure CrcCalculationTest;
  355.     begin {CrcCalculationTest}
  356.       TestHeader(Key);
  357.       CrcTest;
  358.       TestTrailer(Key);
  359.       end; {CrcCalculationTest}
  360.  
  361.   procedure DateManipulationTest;
  362.     begin {DateManipulationTest}
  363.       TestHeader(Key);
  364.       DateTest;
  365.       TestTrailer(Key);
  366.       end; {DateManipulationTest}
  367.  
  368.   procedure ErrorMessagesTest;
  369.     begin {ErrorMessagesTest}
  370.       TestHeader(Key);
  371.       if HandleIsConsole(1) then begin
  372. {$IFDEF DPMI}
  373.         repeat
  374.           WriteLn;
  375.           XSwpErr := ExecDos('TESTERR', true, nil);
  376.           if XSwpErr <> 0 then WriteLn('ExecDOS Error = ', XSwpErr);
  377.           until not YesOrNo('Again? ... ', WhereY, WhereX, $07, 'Y');
  378. {$ELSE}
  379.         SwapVectors;
  380.         repeat
  381.           WriteLn;
  382.           XSwpErr := ExecSwapF('TESTERR.EXE', '');
  383.           if XSwpErr <> 0 then WriteLn('Exec Swap Error = ', XSwpErr);
  384.           until not YesOrNo('Again? ... ', WhereY, WhereX, $07, 'Y');
  385.         SwapVectors;
  386. {$ENDIF}
  387.         end
  388.       else
  389.         WriteLn(O, 'Test not available under redirection.');
  390.       TestTrailer(Key);
  391.       end; {ErrorMessagesTest}
  392.  
  393.   procedure FinancialCalculationsTest;
  394.     begin {FinancialCalculationsTest}
  395.       TestHeader(Key);
  396.       TestFinance;
  397.       TestTrailer(Key);
  398.       end; {FinancialCalculationsTest}
  399.  
  400.   procedure GenericListProcessorTest;
  401.     begin {GenericListProcessorTest}
  402.       TestHeader(Key);
  403.       ListTest;
  404.       TestTrailer(Key);
  405.       end; {GenericListProcessorTest}
  406.  
  407.   procedure LongStringManipulationTest;
  408.     begin {LongStringManipulationTest}
  409.       TestHeader(Key);
  410. {$IFDEF DPMI}
  411.       XSwpErr := ExecDos('TESTLSTR', true, nil);
  412.       if XSwpErr <> 0 then WriteLn('ExecDOS Error = ', XSwpErr);
  413. {$ELSE}
  414.       SwapVectors;
  415.       XSwpErr := ExecSwapF('TESTLSTR.EXE', '');
  416.       if XSwpErr <> 0 then WriteLn('Exec Swap Error = ', XSwpErr);
  417.       SwapVectors;
  418. {$ENDIF}
  419.       AnyKey;
  420.       TestTrailer(Key);
  421.       end; {LongStringManipulationTest}
  422.  
  423.   procedure LowLevelUtilitiesTest;
  424.     begin {LowLevelUtilitiesTest}
  425.       TestHeader(Key);
  426.       UtilTest;
  427.       TestTrailer(Key);
  428.       end; {LowLevelUtilitiesTest}
  429.  
  430.   begin {Main Program}
  431.     Xsave := WhereX;
  432.     Ysave := WhereY;
  433.     if not SaveWindow(1, 1, ScreenWidth, ScreenHeight, true, WinBuf) then ;
  434.     ClrScr;
  435.     if OpenStdDev(O, 1) then ;
  436.  
  437.     Key := -1;
  438. {$IFDEF DPMI}
  439.     XSwpOK := true;
  440. {$ELSE}
  441.     XSwpOK := InitExecF(HeapPtr, 'SHTEST.$$$');
  442. {$ENDIF}
  443.  
  444.     repeat
  445.       InitMenu(M);
  446.  
  447.       if not XSwpOK then begin
  448.         DisableMenuItem(M, 3);      {Command Line}
  449.         DisableMenuItem(M, 7);      {Error Messages}
  450.         DisableMenuItem(M, 9);      {LongString Manipulation}
  451.         end;
  452.  
  453.       if HandleIsConsole(1) then begin
  454.         if Key = -1 then
  455.           Key := 1;
  456.         end {if HandleIsConsole}
  457.  
  458.       else {if not HandleIsConsole} begin
  459.         if Key = -1 then
  460.           Key := 11;
  461.         DisableMenuItem(M, 2);      {Color Selection}
  462.         DisableMenuItem(M, 7);      {Error Messages}
  463.         end;
  464.  
  465.       SelectMenuItem(M, Key);
  466.       Key := MenuChoice(M, Ch);
  467.       EraseMenu(M, false);
  468.       DisposeMenu(M);
  469.  
  470.       case Key of
  471.          1  : begin
  472.                 BetwFunctionsTest;
  473.                 end;
  474.  
  475.          2  : begin
  476.                 ColorSelectionTest;
  477.                 end;
  478.  
  479.          3  : begin
  480.                 CommandLineTest;
  481.                 end;
  482.  
  483.          4  : begin
  484.                 ComplexArithmeticTest;
  485.                 end;
  486.  
  487.          5  : begin
  488.                 CrcCalculationTest;
  489.                 end;
  490.  
  491.          6  : begin
  492.                 DateManipulationTest;
  493.                 end;
  494.  
  495.          7  : begin
  496.                 ErrorMessagesTest;
  497.                 end;
  498.  
  499.          8  : begin
  500.                 GenericListProcessorTest;
  501.                 end;
  502.  
  503.          9  : begin
  504.                 LongStringManipulationTest;
  505.                 end;
  506.  
  507.         10  : begin
  508.                 LowLevelUtilitiesTest;
  509.                 end;
  510.  
  511.         11  : begin
  512.                 Key := 1;
  513.                 BetwFunctionsTest;
  514.  
  515.                 Key := 2;
  516.                 ColorSelectionTest;
  517.  
  518.                 Key := 3;
  519.                 CommandLineTest;
  520.  
  521.                 Key := 4;
  522.                 ComplexArithmeticTest;
  523.  
  524.                 Key := 5;
  525.                 CrcCalculationTest;
  526.  
  527.                 Key := 6;
  528.                 DateManipulationTest;
  529.  
  530.                 Key := 7;
  531.                 ErrorMessagesTest;
  532.  
  533.                 Key := 12;
  534.                 FinancialCalculationsTest;
  535.  
  536.                 Key := 8;
  537.                 GenericListProcessorTest;
  538.  
  539.                 Key := 9;
  540.                 LongStringManipulationTest;
  541.  
  542.                 Key := 10;
  543.                 LowLevelUtilitiesTest;
  544.  
  545.                 Key := 99;
  546.                 end;
  547.  
  548.         12  : begin
  549.                 FinancialCalculationsTest;
  550.                 end;
  551.  
  552.         99  : begin
  553.                 RestoreWindow(1, 1, ScreenWidth, ScreenHeight, true, WinBuf);
  554.                 GoToXYabs(Xsave, Ysave);
  555.                 Halt;
  556.                 end;
  557.         end; {case}
  558.       until false;
  559.     end; {Main Program}
  560.   end.
  561.