Связанный список, не работает вывод

Code:

type
tlink=^trec;
trec=record
s: string;
next: tlink;
end;
//...
procedure build(lst: tlink);
begin
new(lst);
lst.s:='';
lst.next:=nil;
end;
//...
procedure AddToList(s: string;var lst: tlink);
var ptr: tlink;
begin
new(ptr);
ptr^.s:=s;
ptr^.next:=lst;
lst:=p;
end;
//...
procedure prn(lst: tlink);
var ptr: tlink;
begin
new(ptr);
p:=lst;
repeat begin
writeln(ptr^.s);
ptr^:=ptr^.next;
end;
until p^.next=nil;
end;

Сначала вызываю build, потом при помощи AddToList добавляю несколько элементов и последней процедурой пытаюсь вывести, но происходит access violation, причем если сделать вывод через ShowMessage (т.е. посмотреть, выводит ли оно), вывод идет, а в конце exception.

 

где-то косяки с указателями отсюда и access violation, если не сильно принципиально, то проще TList юзать, если, все таки, связанный список, то примерно вот так:

Code:

type
  PMyList = ^TMyList;
  TMyList = record
    s: String;
    Next: PMyList;
  end;

procedure AddToList(const S: String; var L: PMyList);
var
  P: PMyList;
begin
  new(P);
  P^.s:= S;
  P^.Next:= L;
  L:= P;
end;

var
  Ps: PMyList;

procedure SetList;
begin
  Ps:= nil;
  AddToList('string 1', Ps);
  AddToList('string 2', Ps);
  AddToList('string 3', Ps);
  AddToList('string 4', Ps);
end;

procedure Print;
begin
  while True do begin
    if (Ps^.Next = nil) then begin
      WriteLn(Ps^.s);
      Break;
    end else begin
      WriteLn(Ps^.s);
      Ps:= Ps^.Next;
    end;
  end;
end;

ps: ну и чистить за собой не забывать

 

Спасибо.
Правда логика работы вроде такая же, так и не понял, чем принципиально отличается мой код и, соответственно, что вызывает ошибку.

А как это делать?

 

щас попробовал- все равно чото не пашет, не пойму даже, в чем причина.

 

про "чистить за собой" имелось ввиду освобождение выделенной памяти new\Dispose GetMem\FreeMem etc.
а вот что и почему у тебя там не получается, хз, информативнее надо быть)

 

А, собственно, информации почти никакой нет, просто происходит access violation.
Такое впечатление, что условие выхода с цикла не выполняется, т.е. указатель бежит дальше.

 

Почему не используешь ООП? Для списка куда удобнее!

Откуда в prn процедуре взялась переменная "p"? Поправил:

Code:

procedure prn(lst: tlink);
var ptr: tlink;
begin
    ptr:= lst;
    while ptr <> nil
    begin
        writeln(ptr^.s);
        ptr:= ptr^.next;
    end;    
end;

У меня со второго курса остался пример реализации стека. Списка нету, извини.

Code:

unit Unit2;

interface

uses
    SysUtils, Windows, Forms, Messages;

type
  TStackEl = ^StackEl;
  StackEl = record
    el: char;
    Prev: TStackEl;
  end;
  TStack = class
  private
    StackTop: TStackEl;
  public
    function EmptyStack: Boolean;
    procedure AddToStack(elem: char);
    procedure DelFromStack;
    function LastOfStack: char;
  end;

implementation

function TStack.EmptyStack: boolean;
begin
  if StackTop = nil then result:= True
  else
  result:= False;
end;

procedure TStack.AddToStack(elem: char);
var
  tmp: TStackEl;
begin
  New(tmp);
  tmp^.el:= elem;
  tmp^.Prev:= StackTop;
  StackTop:= tmp;
end;

procedure TStack.DelFromStack;
var
  tmp: TStackEl;
begin
  if StackTop <> nil then
  begin
    New(tmp);
    tmp:= StackTop;
    StackTop:= StackTop^.Prev;
    Dispose(tmp)
  end
  else Application.MessageBox('Stack is empty!', 'Error...');
end;

function TStack.LastOfStack: char;
begin
  if StackTop <> nil then result:= StackTop^.el
  else Application.MessageBox('Stack is empty!', 'Error...');
end;

end.