TestFS.pas

   1 unit TestFS;
   2
   3 INTERFACE
   4 IMPLEMENTATION
   5 USES ServerLoop,Chat,SysUtils,MemStream,NetAddr,opcode,Download,Store1,sha1;
   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,' miss=',job^.missc);
  20  if job^.state<>stActive then Rekt else
  21  Shedule(800,@Periodic);
  22 end;
  23
  24 procedure t.Rekt;
  25  begin
  26  writeln('TestFS: rekt');
  27  Job^.Free;
  28  UnShedule(@HardTimeout);
  29  UnShedule(@Periodic);
  30  FreeMem(@self,sizeof(self));
  31 end;
  32
  33 procedure t.HardTimeout;
  34  begin
  35  writeln('TestFS: hardtimeout');
  36  Rekt;
  37 end;
  38
  39 procedure init;
  40  var o:^t;
  41  var oi:word;
  42  var s:tMemoryStream;
  43  const opt='-test-fs';
  44  var fid:tFID;
  45  begin
  46  oi:=OptIndex(opt);
  47  if oi>0 then begin
  48   assert(OptParamCount(oi)=2,opt+'(rcpt:tNetAddr fid:sha1)');
  49   fid:=tFID(paramstr(oi+2));
  50   writeln('TestFS: rcpt '+paramstr(oi+1),' ',sha1print(fid));
  51   new(o); with o^ do begin
  52    //Shedule(15000,@HardTimeout);
  53    Shedule(20,@Periodic);
  54    job:=NewJob(paramstr(oi+1),fid);
  55    if job^.state=stStop then job^.Start;
  56   end;
  57  end;
  58 end;
  59
  60 BEGIN
  61  init;
  62 END.