please tell me, what's wrong?
var g:array[1..25000,1..25000] of integer; v,i,j,n,f,un,uk,t,k,s,x:longint;
Q:array[1..100000] of integer;
p:array[1..25000] of integer;
begin
assign(input,'input.txt');
assign(output,'output.txt');
reset(input);rewrite(output);
readln(t);
for i:=1 to t do
begin
readln(n);k:=0;
fillchar(g,sizeof(g),0);
for j:=1 to n do begin read(s);
if s=0 then begin f:=j; k:=k+1;g[j,j]:=0;end
else begin g[j,s]:=1;g[s,j]:=1;end;
if k>1 then break;
end;
readln;
if k<>1 then begin Writeln('NO');end else
begin
for j:=1 to n do p[j]:=-1;
fillchar(Q,sizeof(Q),0);
un:=1;
uk:=2;
Q[1]:=f;
p[f]:=0;
x:=0;
while un<>uk do
begin
v:=Q[un]; un:=un+1;
for j:=1 to n do
if (g[v,j]<>0) and (p[j]=-1) then begin
Q[uk]:=j;
uk:=uk+1;
p[j]:=p[v]+1;
end;
end;
for j:=1 to n do
if p[j]=-1 then begin x:=1;break;end;
if x=0 then writeln('YES') else writeln('NO');
end;
end;
end.