TestFS.pas

   1 unit TestFS;
   2
   3 INTERFACE
   4 IMPLEMENTATION
   5 USES ServerLoop,Chat,SysUtils,MemStream,NetAddr,opcode,Download,Store1;
   6
   7 type t=object
   8  job:^tDownloadJob;
   9  //procedure UserInput
  10  procedure Periodic;
  11  procedure Rekt;
  12  procedure HardTimeout;
  13 end;
  14
  15 procedure t.Periodic;
  16  begin
  17  write('TestFS: ',job^.state);
  18  if job^.state=stError then write(job^.error,'-',job^.error2);
  19  writeln(' total=',job^.total,' done=',job^.done);
  20  Shedule(800,@Periodic);
  21 end;
  22
  23 procedure t.Rekt;
  24  begin
  25  writeln('TestFS: rekt');
  26  UnShedule(@HardTimeout);
  27  UnShedule(@Periodic);
  28  FreeMem(@self,sizeof(self));
  29 end;
  30
  31 procedure t.HardTimeout;
  32  begin
  33  writeln('TestFS: hardtimeout');
  34  //ch.DisposeHook:=@Rekt;
  35  //ch.Close;
  36 end;
  37
  38 procedure init;
  39  var o:^t;
  40  var oi:word;
  41  var s:tMemoryStream;
  42  const opt='-test-fs';
  43  var fid:tFID;
  44  begin
  45  oi:=OptIndex(opt);
  46  if oi>0 then begin
  47   assert(OptParamCount(oi)=1,opt+'(rcpt:tNetAddr)');
  48   writeln('TestFS: rcpt '+paramstr(oi+1));
  49   new(o); with o^ do begin
  50    Shedule(20000,@HardTimeout);
  51    Shedule(20,@Periodic);
  52    FillChar(fid,sizeof(fid),0);
  53    job:=NewJob(paramstr(oi+1),fid);
  54    if job^.state=stStop then job^.Start;
  55   end;
  56  end;
  57 end;
  58
  59 BEGIN
  60  init;
  61 END.