Стек, Помогите исправить программу Опции

[Neon6868]

Задание: С клавиатуры вводится текст, содержащий 4 вида скобок: (, {, [, <
Надо проверить, правильно ли расставлены скобки.Для этого, сначала надо проверить, чтобы после открывающейся скобки обязательно была закрывающаяся и чтобы соблюдались вложения скобок(т.е. например вот так (----{--)--} нельзя!). Если обнаружена скобка, то она записывается в стек.В конце програмы выводится сообщение, правильно или неправильно расставлены скобки.Если скобок в тексте нет, то вывести сообщение скобок нет.

Программа:

 
Program Stek;
  const
  n=1;
  type
    tes=1..n;
    stackl=^node;
    node=record
         data:tes;
         next:stackl
         end;
  var
    str:string;
  Function EmptyStack(var ST:stackl):boolean;
    Begin
      Emptystack:=st^.data=0
    End;
  Procedure PushSC(var STCL:stackl;x:TES);
  var
    P:stackl;
  Begin
    new(p);
    p^.data:=x;
    if emptyStack(STCL) then STCL:=p
      else p^.next:=stcl^.next;
    stcl^.next:=p;
  End;
  Begin
    writeln('Vvedite stroku:');
    readln(str);
    if str='(' or '{' or '[' or '<' then pushSC();
  End.
 

[klem4]

Ну во первых ты память забываешь освободить, стек ведь в конце программы не всегда пустой, а вот мой вариант:

{$B-}
const
  close  = ')]}>';
  open   = '([{<';
type
  PTStack = ^TStack;
  TStack = Record
    _break: Char;
    next: PTStack;
  end;

procedure Push(var T: PTStack; const _break: Char);
var
  temp: PTStack;
begin
  New(temp);
  temp^._break := _break; temp^.next := nil;

  if T = nil then T := temp else begin
    temp^.next := T; T := temp;
  end;
end;

function Pop(var T: PTStack): Char;
var
  temp: PTStack;
begin
  Pop := T^._break; temp := T;
  T := T^.next; Dispose(temp);
end;

procedure Destroy(var T: PTStack);
var
  temp: PTStack;
begin
  while (T <> nil) do begin
    temp := T;
    T := T^.next;
    Dispose(T);
  end;
end;

var
  T: PTStack;
  S: String;
  i: Integer;
  stop: Boolean;
begin
  write('s = '); readln(s);

  T := nil; i := 1; stop := false;

  repeat
    if Pos(s[i], open) <> 0 then Push(T, close[pos(s[i], open)]);
    stop := (Pos(s[i], close) <> 0) and ((T = nil) or (s[i] <> Pop(T)));
    inc(i);
  until (i > Length(s)) or (stop);

  if not(stop) and (T = nil) then writeln('good') else writeln('bad');

  Destroy(T);
end.