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