Строка: Проверка на корректную расстановку скобок - Pascal ABC

Формулировка задачи:

Дана строка, содержащая латинские буквы и скобки трех видов ( ), { }, [ ]. Если скобки расставлены правильно (то есть каждой открывающей соответствует закрывающая скобка того же вида), то вывести 0. В противном случае вывести или номер позиции, в которой расположена первая ошибочная скобка или, если закрывающих скобок не хватает, число -1. Неправильно работает, например, при вводе {] выводит -1, а должна номер ошибочной скобки.

program lab7;
uses crt;
var
S,P:string;
r:integer;
i:integer; 
begin
Write('Введите строку: ');
readln(S);
r:=0;    
P:='';
for i:=1 to length(S) do 
begin
 
if S[i]='(' then
P:=P+'('; 
if (S[i]=')')then
begin
if (P[length(P)]='(') then
delete(P,length(P),1) 
else
begin
r:=i;
break;
end;
end;
 
if S[i]='{' then
P:=P+'{'; 
if (S[i]='}')then
begin
if (P[length(P)]='{') then
delete(P,length(P),1) 
else
begin
r:=i;
break;
end;
end;
 
if S[i]='[' then
P:=P+'[';
if (S[i]=']')then
begin
if (P[length(P)]='[') then
delete(P,length(P),1) 
else
begin
r:=i;
break;
end;
end;
end;
 
if (length(P) > 0)and(i=length(S)) then
r:=-1; 
Writeln('Ответ: ',r);
end.

Решение задачи: «Строка: Проверка на корректную расстановку скобок»

textual
                            Листинг программы 
                        

                            program task;
const
    open = [ '{', '[', '(' ];
    close = [ '}', ']', ')' ];
    n = 10;
type
    str = packed array[ 1..n ] of char;
    stack = ^chain;
    chain = record
        item: char;
        next: stack
    end;
var
    st: str;
    s: stack;
    ok: boolean;
    i: integer;
    c, c1: char;
    
procedure clearstack( var s: stack );
begin
    if s <> nil then begin
        clearstack( s^.next );
        dispose( s );
        s := nil;
    end;
end;
 
function isempty( s: stack ): boolean;
begin
    isempty := s = nil;
end;
 
procedure pop( var s: stack; var c: char );
var
    q: stack;
begin
    c := s^.item;
    q := s;
    s := s^.next;
    dispose( q );
end;
 
procedure push( var s: stack; c: char );
var
    q: stack;
begin
    q := s;
    new( s );
    s^.item := c;
    s^.next := q;
end;
 
procedure readstr( var st: str );
var
    i: integer;
begin
    for i := 1 to n do read( st[ i ] );
end;
 
begin
s := nil;
ok := true;
i := 1;
readstr( st );
while ok and ( i < n + 1 ) do begin
    c := st[ i ];
    if c in open then push( s, c ) 
    else
        if c in close then 
            if isempty( s ) then begin
                ok := false;
                writeln( i );
            end
            else begin
                pop( s, c1 );
                ok := ( c1 = '(' ) and ( c = ')' ) or
                    ( c1 = '{' ) and ( c = '}' ) or ( c1 = '[' ) and ( c = ']' );
                if not ok then writeln( i );
            end;    
    i := i + 1;         
end;
if ok then
    if not isempty( s ) then writeln( -1 )
    else writeln( 0 );
clearstack( s );
end.
                        