What's wrong?

Program:

var
  n,i,j,x,y,sum:integer;
  a:array[1..100,1..100] of boolean;
  b:array[1..100] of shortint;
begin
  readln(n);
  fillchar(a,sizeof(a),false);
  fillchar(b,sizeof(b),0);
  for i:=1 to n do begin
    read(x);
    while x<>0 do begin
      a[i,x]:=true;
      inc(b[x]);
      read(x);
    end;
    readln;
  end;

  sum:=0;

  repeat
    for i:=1 to n do
      if b[i]=0 then begin
        write(i,' ');
        inc(sum);
        b[i]:=-1;
        for j:=1 to n do
          if a[i,j] then
            begin a[i,j]:=false; dec(b[j]);end;
        if sum=n-1 then break;
      end;
  until sum=n-1;
  for i:=1 to n do if b[i]=0 then
    begin writeln(i);halt;end;
end.

1
1
1
1
1
1
1
1
1
1
0

My AC Answer is 1
Your answer if nothing!

If you can't i will give my AC.

gvar
   n:integer;
   i,j,c:integer;
   a:array[1..100,1..100] of boolean;
   b:array[1..100] of boolean;
   s:array[1..100] of integer;

procedure ds(x:integer);
var
    i:integer;
begin
   b[x]:=false;
   for I:=1 to n do
      if (a[x,i]) and (b[i]) then ds(i);
   dec(c);
   s[c]:=x;
end;

begin
   for I:=1 to 100 do for J:=1 to 100 do a[i,j]:=false;
   for i:=1 to 100 do b[i]:=true;

   readln(n);

   for I:=1 to n do begin
      repeat
          read(c);
         if c<>0 then a[i,c]:=true;
      until c=0
   end;

   c:=n+1;

   for I:=1 to n do if b[i] then ds(i);
   for i:=1 to n do begin
      write(s[i]);
      if i<n then write(' ');
   end;

end.