home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / pascal / shdk_1.zip / TESTLIST.PAS < prev    next >
Pascal/Delphi Source File  |  1992-03-24  |  10KB  |  345 lines
  1. program TestList;
  2. {
  3.                         To test the ShList 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.   TpCrt,
  18.   TpDos,
  19.   ShList;
  20.  
  21. type
  22.   Str6  = string[6];
  23.  
  24. const
  25.   NumLines = 7;
  26.   Dat   : array[1..NumLines] of Str6 = (
  27.                                         'abcd-1',
  28.                                         'bcda-2',
  29.                                         'dcba-3',
  30.                                         'adcb-4',
  31.                                         'cdab-5',
  32.                                         'badc-6',
  33.                                         'dabc-7'
  34.                                        );
  35.  
  36. var
  37.   sL1,           {Load by PUSHing}
  38.   sL2,           {Load by APPENDing}
  39.   sL3  : slList; {Load by INSERTing the first element, PUSHing the second,
  40.                  and INSERTing the remainder.}
  41.  
  42.   dL0,           {Load by INSERTing the first two elements and
  43.                  INSERTPREVing the remainder.}
  44.   dL1,           {Load by PUSHing}
  45.   dL2,           {Load by APPENDing}
  46.   dL3,           {Load by INSERTing the first element, PUSHing the second,
  47.                  and INSERTing the remainder.}
  48.   dL4  : dlList; {Load by InsertSorted}
  49.  
  50.   OT  : text;
  51.   S1  : Str6;
  52.   T1,
  53.   T2  : byte;
  54.  
  55. procedure slBombOut;
  56.   begin
  57.     WriteLn(OT, ' slBomb out');
  58.     halt;
  59.     end;
  60.  
  61. procedure dlBombOut;
  62.   begin
  63.     WriteLn(OT, ' dlBomb out');
  64.     end;
  65.  
  66. procedure AnyKey;
  67.   begin
  68.     if HandleIsConsole(1) then begin
  69.       Write('Any key to continue...');
  70.       if ReadKey = #0 then ;
  71.       WriteLn;
  72.       end;
  73.     end;
  74.  
  75. {$F+}
  76. function Less(var DRec1, DRec2) : boolean;
  77.   begin
  78.     Less := (Str6(DRec1) <= Str6(DRec2));
  79.     end; {Less}
  80. {$F-}
  81.  
  82. begin
  83.   if not OpenStdDev(OT, 1) then begin
  84.     WriteLn('Can''t open console device.');
  85.     Halt(1);
  86.     end;
  87.   if HandleIsConsole(1) then begin
  88.     WriteLn(OT,'This program produces extensive output, which you may wish');
  89.     WriteLn(OT,'to study in detail. For this reason, console output can be');
  90.     WriteLn(OT,'redirected to a file or to the printer. If you wish to'    );
  91.     WriteLn(OT,'use this option, <Ctrl><Break> out at the following pause,');
  92.     WriteLn(OT,'and re-invoke the program with the desired redirection.'   );
  93.     WriteLn(OT);
  94.     AnyKey;
  95.     end;
  96.   WriteLn(OT);
  97.   WriteLn(OT,'BEGINNING THE slList TEST SUITE');
  98.   T1 := 0;
  99.   WriteLn(OT,MemAvail);WriteLn(OT);
  100.   slListInit(sL1, SizeOf(S1));
  101.   slListInit(sL2, SizeOf(S1));
  102.   slListInit(sL3, SizeOf(S1));
  103.  
  104.   for T1 := 1 to NumLines do begin
  105.     S1 := Dat[T1];
  106.     WriteLn(OT,'sL1 ',S1:6, slCount(sL1):4, slSpaceUsed(sL1):5);
  107.     if not slPush(sL1, S1) then slBombOut;
  108.     WriteLn(OT,'sL1 ',S1:6, slCount(sL1):4, slSpaceUsed(sL1):5);
  109.     WriteLn(OT,'sL2 ',S1:6, slCount(sL2):4, slSpaceUsed(sL2):5);
  110.     if not slAppend(sL2, S1) then slBombOut;
  111.     WriteLn(OT,'sL2 ',S1:6, slCount(sL2):4, slSpaceUsed(sL2):5);
  112.     WriteLn(OT,'sL3 ',S1:6, slCount(sL3):4, slSpaceUsed(sL3):5);
  113.     if T1 = 2 then begin
  114.       if not slPush(sL3, S1) then slBombOut
  115.       end
  116.     else begin
  117.       if not slPut(sL3, S1) then slBombOut
  118.       end;
  119.     WriteLn(OT,'sL3 ',S1:6, slCount(sL3):4, slSpaceUsed(sL3):5);
  120.     WriteLn(OT,'Data string ',T1,' loaded.'); WriteLn(OT);
  121.     end; {for T1}
  122.  
  123.   WriteLn(OT);
  124.   WriteLn(OT,'GetFirst check, using sL1');
  125.   S1 := '';
  126.   if not slGetFirst(sL1, S1) then slBombOut;
  127.   WriteLn(OT,S1:8);
  128.  
  129.   WriteLn(OT);
  130.   WriteLn(OT,'GetLast check, using sL1');
  131.   S1 := '';
  132.   if not slGetLast(sL1, S1) then slBombOut;
  133.   WriteLn(OT,S1:8);
  134.  
  135.   WriteLn(OT);
  136.   WriteLn(OT,'Tail Check on sL1, sL2, sL3.');
  137.   WriteLn(OT,'sL1, ',(sL1.Tail^.Next = nil),
  138.      '     sL2, ',(sL2.Tail^.Next = nil),
  139.      '     sL3, ',(sL3.Tail^.Next = nil));
  140.   AnyKey;
  141.   WriteLn(OT);
  142.  
  143.   WriteLn(OT,'GetNext check, using sL1. 7..1');
  144.   WriteLn(OT,slGetFirst(sL1, S1):6, S1:7);
  145.   for T2 := 2 to 2*sL1.Count do begin
  146.     WriteLn(OT,slGetNext(sL1, S1):6, S1:7);
  147.     end;
  148.   AnyKey;
  149.  
  150.   WriteLn(OT);
  151.   WriteLn(OT,'GetNext check, using sL2. 1..7');
  152.   WriteLn(OT,slGetFirst(sL2, S1):6, S1:7);
  153.   for T2 := 2 to 2*sL2.Count do begin
  154.     WriteLn(OT,slGetNext(sL2, S1):6, S1:7);
  155.     end;
  156.   AnyKey;
  157.  
  158.   WriteLn(OT);
  159.   WriteLn(OT,'GetNext check, using sL3. 2..7, 1');
  160.   WriteLn(OT,slGetFirst(sL3, S1):6, S1:7);
  161.   for T2 := 2 to 2*sL3.Count do begin
  162.     WriteLn(OT,slGetNext(sL3, S1):6, S1:7);
  163.     end;
  164.   AnyKey;
  165.  
  166.   WriteLn(OT);
  167.   WriteLn(OT,'Tail Check on sL1, sL2, sL3.');
  168.   WriteLn(OT,'sL1, ',(sL1.Tail^.Next = nil),
  169.      '     sL2, ',(sL2.Tail^.Next = nil),
  170.      '     sL3, ',(sL3.Tail^.Next = nil));
  171.   AnyKey;
  172.  
  173.   WriteLn(OT);
  174.   WriteLn(OT,'Pop test, using sL1. 7..1');
  175.   while slPop(sL1, S1) do
  176.     WriteLn(OT,S1);
  177.   WriteLn(OT,'sL1 ', slCount(sL1):3, slSpaceUsed(sL1):3);
  178.   AnyKey;
  179.  
  180.   WriteLn(OT);
  181.   WriteLn(OT,'Free test, using sL2, sL3.');
  182.   slFree(sL2); slFree(sL3);
  183.   WriteLn(OT,'sL2 ', slCount(sL2):3, slSpaceUsed(sL2):3);
  184.   WriteLn(OT,'sL3 ', slCount(sL3):3, slSpaceUsed(sL3):3);
  185.   WriteLn(OT,MemAvail);
  186.   AnyKey;
  187.  
  188.   WriteLn(OT);
  189.   WriteLn(OT,'BEGINNING THE dlList TEST SUITE');
  190.   WriteLn(OT,MemAvail); WriteLn(OT);
  191.   dlListInit(dL0, SizeOf(S1));
  192.   dlListInit(dL1, SizeOf(S1));
  193.   dlListInit(dL2, SizeOf(S1));
  194.   dlListInit(dL3, SizeOf(S1));
  195.   dlListInit(dL4, SizeOf(S1));
  196.  
  197.   for T1 := 1 to NumLines do begin
  198.     S1 := Dat[T1];
  199.     if T1 < 3 then begin
  200.       if not dlPut(dL0, S1) then dlBombOut;
  201.       end
  202.     else begin
  203.       if not dlPutPrev(dL0, S1) then dlBombOut;
  204.       end;
  205.     WriteLn(OT,'dL0 ',S1:6, dlCount(dL0):4, dlSpaceUsed(dL0):5);
  206.     if not dlPush(dL1, S1) then dlBombOut;
  207.     WriteLn(OT,'dL1 ',S1:6, dlCount(dL1):4, dlSpaceUsed(dL1):5);
  208.     if not dlAppend(dL2, S1) then dlBombOut;
  209.     WriteLn(OT,'dL2 ',S1:6, dlCount(dL2):4, dlSpaceUsed(dL2):5);
  210.     if T1 = 2 then begin
  211.       if not dlPush(dL3, S1) then dlBombOut
  212.       end
  213.     else begin
  214.       if not dlPut(dL3, S1) then dlBombOut
  215.       end;
  216.     WriteLn(OT,'dL3 ',S1:6, dlCount(dL3):4, dlSpaceUsed(dL3):5);
  217.     if not dlPutSorted(dL4, S1, Less) then dlBombOut;
  218.     WriteLn(OT,'dL4 ',S1:6, dlCount(dL4):4, dlSpaceUsed(dL4):5);
  219.     WriteLn(OT,'Data string ',T1,' loaded.'); WriteLn(OT);
  220.     end; {for T1}
  221.  
  222.   WriteLn(OT);
  223.   WriteLn(OT,'GetFirst check, using dL1.');
  224.   S1 := '';
  225.   if not dlGetFirst(dL1, S1) then dlBombOut;
  226.   WriteLn(OT,S1:8);
  227.  
  228.   WriteLn(OT);
  229.   WriteLn(OT,'GetLast check, using dL1.');
  230.   S1 := '';
  231.   if not dlGetLast(dL1, S1) then dlBombOut;
  232.   WriteLn(OT,S1:8);
  233.  
  234.   WriteLn(OT);
  235.   WriteLn(OT,'Tail Check on dL1, dL2, dL3.');
  236.   WriteLn(OT,'dL1, ',(dL1.Tail^.Next = nil),
  237.      '     dL2, ',(dL2.Tail^.Next = nil),
  238.      '     dL3, ',(dL3.Tail^.Next = nil));
  239.   AnyKey;
  240.  
  241.   WriteLn(OT);
  242.   WriteLn(OT,'GetNext check, using dL0. 1, 7..2');
  243.   WriteLn(OT,dlGetFirst(dL0, S1):6, S1:7);
  244.   for T2 := 2 to 2*dL0.Count do begin
  245.     WriteLn(OT,dlGetNext(dL0, S1):6, S1:7);
  246.     end;
  247.   AnyKey;
  248.  
  249.   WriteLn(OT);
  250.   WriteLn(OT,'GetNext check, using dL1. 7..1');
  251.   WriteLn(OT,dlGetFirst(dL1, S1):6, S1:7);
  252.   for T2 := 2 to 2*dL1.Count do begin
  253.     WriteLn(OT,dlGetNext(dL1, S1):6, S1:7);
  254.     end;
  255.   AnyKey;
  256.  
  257.   WriteLn(OT);
  258.   WriteLn(OT,'GetNext check, using dL1. 7..1');
  259.   WriteLn(OT,dlGetFirst(dL1, S1):6, S1:7);
  260.   for T2 := 2 to 2*dL1.Count do begin
  261.     WriteLn(OT,dlGetNext(dL1, S1):6, S1:7);
  262.     end;
  263.   AnyKey;
  264.  
  265.   WriteLn(OT);
  266.   WriteLn(OT,'GetNext check, using dL2. 1..7');
  267.   WriteLn(OT,dlGetFirst(dL2, S1):6, S1:7);
  268.   for T2 := 2 to 2*dL2.Count do begin
  269.     WriteLn(OT,dlGetNext(dL2, S1):6, S1:7);
  270.     end;
  271.   AnyKey;
  272.  
  273.   WriteLn(OT);
  274.   WriteLn(OT,'GetNext check, using dL3. 2..7, 1');
  275.   WriteLn(OT,dlGetFirst(dL3, S1):6, S1:7);
  276.   for T2 := 2 to 2*dL3.Count do begin
  277.     WriteLn(OT,dlGetNext(dL3, S1):6, S1:7);
  278.     end;
  279.   AnyKey;
  280.  
  281.   WriteLn(OT);
  282.   WriteLn(OT,'GetNext check, using dL4. 1, 4, 6, 2, 5, 7, 3');
  283.   WriteLn(OT,dlGetFirst(dL4, S1):6, S1:7);
  284.   for T2 := 2 to 2*dL4.Count do begin
  285.     WriteLn(OT,dlGetNext(dL4, S1):6, S1:7);
  286.     end;
  287.   AnyKey;
  288.  
  289.   WriteLn(OT);
  290.   WriteLn(OT,'Tail Check on dL0, dL1, dL2, dL3.');
  291.   WriteLn(OT,'dL0, ',(dL0.Tail^.Next = nil),
  292.      '     dL1, ',(dL1.Tail^.Next = nil),
  293.      '     dL2, ',(dL2.Tail^.Next = nil),
  294.      '     dL3, ',(dL3.Tail^.Next = nil));
  295.   AnyKey;
  296.  
  297.   WriteLn(OT);
  298.   WriteLn(OT,'Head Check on dL0, dL1, dL2, dL3.');
  299.   WriteLn(OT,'dL0, ',(dL0.Head^.Prev = nil),
  300.      '     dL1, ',(dL1.Head^.Prev = nil),
  301.      '     dL2, ',(dL2.Head^.Prev = nil),
  302.      '     dL3, ',(dL3.Head^.Prev = nil));
  303.   AnyKey;
  304.  
  305.   WriteLn(OT);
  306.   WriteLn(OT,'Read reverse using dL0, dL1, dL2, dL3.');
  307.   WriteLn(OT,'   Read from tail to head, ''Bomb Out'', Read from tail.');
  308.   if dlGetLast(dL0, S1) then Write(OT, S1:7) else dlBombOut;
  309.   if dlGetLast(dL1, S1) then Write(OT, S1:7) else dlBombOut;
  310.   if dlGetLast(dL2, S1) then Write(OT, S1:7) else dlBombOut;
  311.   if dlGetLast(dL3, S1) then WriteLn(OT,S1:7) else dlBombOut;
  312.   for T2 := 2 to 2*dL0.Count do begin
  313.     if dlGetPrev(dL0, S1) then Write(OT, S1:7) else dlBombOut;
  314.     if dlGetPrev(dL1, S1) then Write(OT, S1:7) else dlBombOut;
  315.     if dlGetPrev(dL2, S1) then Write(OT, S1:7) else dlBombOut;
  316.     if dlGetPrev(dL3, S1) then WriteLn(OT,S1:7) else dlBombOut;
  317.     end;
  318.   AnyKey;
  319.  
  320.   WriteLn(OT);
  321.   WriteLn(OT,'Pop test, using dL1.');
  322.   while dlPop(dL1, S1) do
  323.     WriteLn(OT,S1);
  324.   WriteLn(OT,'dL1 ', dlCount(dL1):3, dlSpaceUsed(dL1):3);
  325.   AnyKey;
  326.  
  327.   WriteLn(OT);
  328.   WriteLn(OT,'Pop test, using dL4.');
  329.   while dlPop(dL4, S1) do
  330.     WriteLn(OT,S1);
  331.   WriteLn(OT,'dL4 ', dlCount(dL4):3, dlSpaceUsed(dL4):3);
  332.   AnyKey;
  333.  
  334.   WriteLn(OT);
  335.   WriteLn(OT,'Free test, using dL0, dL2, dL3, dL4.');
  336.   dlFree(dL0); dlFree(dL2); dlFree(dL3); dlFree(dL3);
  337.   WriteLn(OT,'dL0 ', dlCount(dL0):3, dlSpaceUsed(dL0):3);
  338.   WriteLn(OT,'dL2 ', dlCount(dL2):3, dlSpaceUsed(dL2):3);
  339.   WriteLn(OT,'dL3 ', dlCount(dL3):3, dlSpaceUsed(dL3):3);
  340.   WriteLn(OT,'dL4 ', dlCount(dL4):3, dlSpaceUsed(dL4):3);
  341.   WriteLn(OT,MemAvail);
  342.  
  343.   Close(OT);
  344.   end.
  345.