неправильная работа программы...

[fkty]

Дан список из n целых чисел a1,a2,...,an.Определить,является ли он симметричным.
Программа всегда выдает,что список не симметричен...
Uses Crt;

type
Plist = ^TList;
TList = record
info: integer;
pred,next : PList;
end;

Var
Head : PList;
n : integer;

{создание двусвязного списка со сторожем}
Procedure MakeList(Var head: PList; n:integer);
var
p,q:PList;
i,k:integer;

Begin {MakeList}

new(head);
head^.next:=nil;
head^.pred:=nil;
p:=head;
writeln('введите элементы списка до 0');
read(k);
while k<>0 do
begin
new(q);
q^.info:=k;
q^.pred:=p;
q^.next:=nil;
p^.next:=q;
p:=q;
inc(n);
read(k);
end;
head^.pred:=p;
writeln('количество элементов списка*: ',n);
writeln;
end;{MakeList}

{вывод списка на экран**}
Procedure PrintList(head : PList);
Var
p: PList;

Begin {PrintList}
writeln('данный список: ');
p:=head^.next;
while p<>nil do
begin
write(p^.info:4);
p:=p^.next;
end;
writeln;
end;{PrintList}

{проверка симметрии списка*}
Procedure SimList(head: PList; n:integer);
Var
p,q:PList;
c:integer;

Begin {SimList}
writeln;
writeln('проверяем симметрию:');
p:=head^.pred;
q:=head^.next;
while (p<>q) and (p^.next <>q) do
begin
write(p^.info:4);
write(q^.info:4);

{ if p^.info=q^.info then inc(c); }

p:=p^.pred;
q:=q^.next;
if p=q then inc(c);
end;
writeln;

if c=(n div 2) then
writeln('список симметричен')
else
writeln('список не симметричен*');
end;{SimList}


Begin {program}
ClrScr;
MakeList(head,n);
PrintList(head);
SimList(head,n);
readkey;
end.{program}

[eoln]

 {создание двусвязного списка со сторожем}
 Procedure MakeList(Var head: PList; var n:integer);//передавать по ссылке

Иначе локальная n перекроет глобальную. А глобальную n вообще лучше убрать и сделать локальной.

 writeln('проверяем симметрию:');
 p:=head^.pred;
 q:=head^.next;
 c:=0;//инициализируем переменную нулём
...
 if p^.info=q^.info then inc(c);//сравниваем не указатели, а информационную часть

[fkty]

Так?

Uses Crt;

type
Plist = ^TList;
TList = record
info: integer;
pred,next : PList;
end;

Var
Head : PList;
n : integer;

Procedure MakeList(Var head: PList; Var n:integer);
var
p,q:PList;
i,k:integer;

Begin {MakeList}

new(head);
head^.next:=nil;
head^.pred:=nil;
p:=head;
writeln('введите элементы списка до 0');
read(k);
while k<>0 do
begin
new(q);
q^.info:=k;
q^.pred:=p;
q^.next:=nil;
p^.next:=q;
p:=q;
read(k);
end;
head^.pred:=p;
writeln('количество элементов*: ',n);
writeln;
end;{MakeList}

Procedure PrintList(head : PList);
Var
p: PList;

Begin {PrintList}
writeln('данный список: ');
p:=head^.next;
while p<>nil do
begin
write(p^.info:4);
p:=p^.next;
end;
writeln;
end;{PrintList}

Procedure SimList(head: PList; n:integer);
Var
p,q:PList;
c:integer;

Begin {SimList}
writeln;
writeln('проверяем симметрию:');
p:=head^.pred;
q:=head^.next;
c:=0;
while (p<>q) and (p^.next <>q) do
begin
write(p^.info:4);
write(q^.info:4);

p:=p^.pred;
q:=q^.next;
if p^.info=q^.info then inc(c);
end;
writeln;

if c=(n div 2) then
writeln('симметричен')
else
writeln('не симметричен*');
end;


Begin
ClrScr;
writeln('введите количество элементов');
readln(n);
MakeList(head,n);
PrintList(head);
SimList(head,n);
readkey;
end.

[eoln]

Сообщение от fkty

Так?

Нет, не так. Я привёл список изменений для первого поста (там, кстати, один элемент в списке не используется и не содержит информационной части).
А тут уже неизвестно зачем спрашивается кол-во элементов.
И код надо форматировать (кнопка со значком решётки #)

[fkty]

убрала переменную i и строчку writeln('количество элементов:',n)...