Не  могу пройти 1 тест, помогите
Послано 
fotol 12 май 2013 19:51
var x,n,m,y,i1,i,code:integer;
a,k:array[1..100] of integer;
c:array[1..100] of string;
s:string;
t:boolean;
begin
repeat
readln(n);
until (n>0) and (n<1001);
for i:=1 to n do  begin
 readln(a[i]);
 if a[i]<=0 Then t:=true;
 end;
i:=2;     x:=1;
If t=false Then begin
For i:=2 to n do begin
 
                   if a[i-1]=a[i] Then           x:=x+1
                   else begin write(x,' ',a[i-1],' ');
                   x:=1;    end;
                                     end;
 
if n<>1 THEN  write(x,' ',a[i])
ELSE    write(x,' ',a[i-1]);
  end
 
end.