I got CRASH , and I can't find my failed test . Please give me the
tests if you can . Thank you
  My source :
{$B-}

CONST
     INP                =               '1067.in1';
     OUT                =               '1067.out';
     chk                =               '1067.ou1';
     maxtro             =               30001 ;
     maxk               =               10 ;
     maxl               =               maxtro div maxk ;

TYPE
     st1                =               string[9] ;
     tdad               =               array[0..maxtro] of integer ;
     ar1                =               array[0..maxtro div 10] of
st1 ;

VAR
  last,tro,n     :       integer;
  s     :       string ;
  rec   :       array[0..9] of ^ar1 ;
  dad   :       ^tdad ;

PROCEDURE              newvari ;
  var
    i           :       integer ;
  begin
    for i:=0 to maxk - 1 do
      begin
        new (rec[i] ) ;
        fillchar (rec[i]^,sizeof(rec[i]^),0) ;
      end ;
    new (dad) ;
    fillchar (dad^,sizeof(dad^),0) ;
  end ;

PROCEDURE               ReadInput;
  begin
    newvari;
{    assign (input,inp);
    reset(input);
    assign (output,out) ;
    rewrite (output) ;}

    readln ( n) ;
  end;

PROCEDURE               readbuf ;
  begin
    readln (s) ;
    while  (s[length(s)] in [#10,#13] ) do delete(s,length(s),1) ;
  end ;

PROCEDURE               get (var dir : st1 ) ;
  begin
    dir:='';
    while s[1] = '\' do delete (s,1,1) ;
    while (s[1] <> '\') and (s <> '') do
      begin
        dir:=dir + s[1] ;
        delete(s,1,1) ;
      end ;
  end ;

FUNCTION                recognize ( i: integer ) : boolean ;
  begin
    recognize:=false ;
    if last <> 0 then
      begin
        if dad^[i] = last then recognize:=true ;
      end
    else
      recognize:=true ;
  end ;

FUNCTION                getpos ( dir : st1 ) : integer ;
  var
    i,l,r,mid           :       integer ;
  begin
    getpos:=0 ;
    l:=1 ; r:=tro ; mid:=0 ;
    while l <= r do
      begin
        mid:= (l+r) div 2 ;
        if (rec[mid div maxl]^[mid mod maxl] = dir)  then break ;
        if dir > rec[mid div maxl]^[mid mod maxl] then l:=mid+1
        else r:=mid-1 ;
      end ;

    l:=mid ;
    if l = 0 then exit ;
    while (rec[l div maxl]^[l mod maxl] = dir) and (l > 0) do
    begin
      if recognize ( l ) then
        begin
          getpos:=l ; exit ;
        end ;
      dec (l) ;
    end ;

    l:=mid ;
    while (l <= tro) and (rec[l div maxl]^[l mod maxl] = dir)  do
    begin
      if recognize ( l ) then
        begin
          getpos:=l ; exit ;
        end ;
      inc(l) ;
    end ;
  end ;

FUNCTION                findcache ( dir : st1 ) : integer ;
  var
    l,r,mid             :       integer ;
  begin
    l:=1 ; r:=tro ;
    while l <= r do
      begin
        mid := (l+r) div 2 ;
        if dir > rec[mid div maxl]^[mid mod maxl] then l:=mid+1
        else r:=mid-1 ;
      end ;
    findcache:=(l+r) div 2 ;
  end ;

FUNCTION                newpos ( dir : st1 ) : integer ;
  var
    i,j           :       integer ;
  begin
    j:= findcache ( dir ) ;
    for i:=1 to tro do
      if dad^[i] > j then inc(dad^[i]) ;
    if last > j then inc (last) ;

    for i:=tro downto j+1 do
      begin
        rec[(i+1) div maxl]^[(i+1) mod maxl]:=rec[i div maxl]^[i mod
maxl] ;
        dad^[i+1]:=dad^[i] ;
      end ;
    rec[(j+1) div maxl]^[(j+1) mod maxl]:=dir ;
    dad^[j+1]:=0 ;
    newpos:=j+1 ;
    inc (tro) ;
  end ;

PROCEDURE               makelink ( j : integer ) ;
  begin
    if last <> 0 then
      begin
        dad^[j]:=last ;
      end ;
    last:=j ;
  end ;

PROCEDURE               analys ;
  var
    dir         :       st1 ;
    j           :       integer ;
  begin

  There's just task there , no tests . If you have the tests , could
you please show me ?
  Thanks .

You can find everything there.

Sorry to Mr. Admin.

Edited by author 09.08.2004 22:23