home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / DPSX / TOOL-PAS.ZIP / BUFTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-04  |  2.9 KB  |  141 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * test driver for BUFIO and MDOSIO units
  15.  *
  16.  *)
  17.  
  18. {$r-,s-}
  19. {$m 8000,0,0}
  20.  
  21. uses mdosio,bufio;
  22.  
  23. const
  24.    nbuf = 600;
  25.    nout = 1000;
  26.    siz = 400;
  27.    fn1 = 't1';
  28.    fn2 = 't2';
  29.  
  30. type
  31.    rec = array[1..siz] of byte;
  32.  
  33. var
  34.    inf:     buffered_file;
  35.    outf:    buffered_file;
  36.    v:       rec;
  37.    i,j:     integer;
  38.  
  39. procedure iocheck;
  40. begin
  41.    if dos_write_err then
  42.    begin
  43.       writeln(^G'Write failure!  (disk full?) AX=',dos_regs.ax,' CX=',dos_regs.cx);
  44.       halt;
  45.    end;
  46. end;
  47.  
  48. begin
  49.    for i := 1 to siz do
  50.       v[i] := 0;
  51.  
  52.    writeln('sequential write:');
  53.    bcreate(fn1);
  54.    bopen(outf,fn1,nbuf,sizeof(rec));
  55.    for j := 1 to nout do
  56.    begin
  57.       bwrite(outf,v);
  58.       iocheck;
  59.    end;
  60.    bclose(outf);
  61.  
  62.    writeln('sequential seek write:');
  63.    bopen(outf,fn1,nbuf,sizeof(rec));
  64.    for j := 1 to nout do
  65.    begin
  66.       bseek(outf,j-1);
  67.       bwrite(outf,v);
  68.       iocheck;
  69.    end;
  70.    bclose(outf);
  71.  
  72.    writeln('sequential read:');
  73.    bopen(inf,fn1,nbuf,sizeof(rec));
  74.    j := 0;
  75.    while not beof(inf) do
  76.    begin
  77.       inc(j);
  78.       bread(inf,v);
  79.    end;
  80.    writeln('   ',j,' records');
  81.    bclose(inf);
  82.  
  83.    writeln('sequential seek read:');
  84.    bopen(inf,fn1,nbuf,sizeof(rec));
  85.    for j := 1 to nout do
  86.    begin
  87.       bseek(inf,j-1);
  88.       bread(inf,v);
  89.    end;
  90.    bclose(inf);
  91.  
  92.    writeln('sequential copy:');
  93.    bcreate(fn2);
  94.    bopen(outf,fn2,nbuf,sizeof(rec));
  95.    bopen(inf,fn1,nbuf,sizeof(rec));
  96.    j := 0;
  97.    while not beof(inf) do
  98.    begin
  99.       inc(j);
  100.       bread(inf,v);
  101.       bwrite(outf,v);
  102.       iocheck;
  103.    end;
  104.    writeln('   ',j,' records');
  105.    bclose(inf);
  106.    bclose(outf);
  107.  
  108.    writeln('sequential seek copy:');
  109.    bopen(outf,fn2,nbuf,sizeof(rec));
  110.    bopen(inf,fn1,nbuf,sizeof(rec));
  111.    for j := 1 to nout do
  112.    begin
  113.       bseek(inf,j-1);
  114.       bread(inf,v);
  115.       if btell(inf) <> j then writeln('tell error 1');
  116.       bseek(outf,j-1);
  117.       bwrite(outf,v);
  118.       iocheck;
  119.       if btell(outf) <> j then writeln('tell error 2');
  120.    end;
  121.    bclose(inf);
  122.    bclose(outf);
  123.  
  124.    writeln('reverse sequential seek copy:');
  125.    bopen(outf,fn2,nbuf,sizeof(rec));
  126.    bopen(inf,fn1,nbuf,sizeof(rec));
  127.    for j := nout downto 1 do
  128.    begin
  129.       bseek(inf,j-1);
  130.       bread(inf,v);
  131.       if btell(inf) <> j then writeln('tell error 1');
  132.       bseek(outf,nout-j);
  133.       bwrite(outf,v);
  134.       iocheck;
  135.       if btell(outf) <> (nout-j+1) then writeln('tell error 2');
  136.    end;
  137.    bclose(inf);
  138.    bclose(outf);
  139. end.
  140.  
  141.