Баг или моя ошибка?

[Paster Fob]

Вот такой код вылетает с ошибкой:

Код: Выделить всё

var
  s:string;

begin
  s:='   ';
  while (s[1]=' ') and (length(s)>0) do
    delete(s,1,1);
end.

меняю местами логические условия и тогда всё нормально.

Код: Выделить всё

var
  s:string;

begin
  s:='   ';
  while  (length(s)>0) and (s[1]=' ') do
    delete(s,1,1);
end.

Это баг или что?В FPC,TP,PascalABC оба варианта работают нормально.

[alexs]

второе верно. первое нет.
условия проверяются слева на право.

[Sergei I. Gorelkin]

Тип переменной S управляется опцией {$H+}, в FPC и TP она по умолчанию отключена и s имеет тип shortstring, в Lazarus - наоборот, включена, и s имеет тип ansistring.
Если тип s shortstring, то ее память постоянно выделена и обращение к элементам не вызывает ошибок. Если ansistring, то память выделена только если строка не пустая - соответственно попытка чтения символа из пустой строки приведет к падению.

[Paster Fob]

Ясно,спасибо что разъяснили.

[Vadim]

Paster Fob
Чтобы было ещё более понятно, можете результат Ваших действий визуализировать:

Код: Выделить всё

var
  s:string;

begin
  s:='   ';
  n:=0;
  while (s[1]=' ') and (length(s)>0) do
  Begin
    Inc(n);
    WriteLn('Действие ', n, ':');
    WriteLn('Длина строки до удаления: ', Length(s));
    delete(s,1,1);
    WriteLn('Длина строки после удаления: ', Length(s));
  End;
end.

[Paster Fob]

Программа подсчитывает кол-во слов в собственном коде.

Программа вылетает с ошибкой,в процедуре FindWord на строке if aword=p^.mword then begin .В Delphi , FPC всё работает.В чём проблема?

Код: Выделить всё

const
  Sym=['A'..'Z'];

type
  prec=^trec;
  trec=record
    mword:string;
    mcount:byte;
    mnext:prec;
  end;

var
  list:prec;

procedure AddToSortList(const aword:string);
var
  p,q:prec;
begin
  new(p);
  p^.mword:=aword;
  p^.mcount:=1;
  q:=list;
  if not assigned(list) then list:=p
  else begin
    while (assigned(q^.mnext)) and (q^.mnext^.mword<aword) do
      q:=q^.mnext;
    if q^.mword>aword then begin
      p^.mnext:=list;
      list:=p;
    end
    else begin
      p^.mnext:=q^.mnext;
      q^.mnext:=p;
    end;
  end;
end;

procedure FindWord(const aword:string);
var
  p:prec;
begin
  p:=list;
  while assigned(p) do begin
    if aword=p^.mword then begin
      inc(p^.mcount);
      break;
    end;
    p:=p^.mnext;
  end;
  if not (assigned(p)) then
    AddToSortList(aword)
end;

procedure ProcessLine(var arg:string);
var
  s:string;
  i:byte;
begin
  for i:=1 to length(arg) do
    arg[i]:=UpCase(arg[i]);
  while length(arg)>0 do begin
    s:='';
    while (length(arg)>0) and not (arg[1] in Sym) do
      delete(arg,1,1);
    while (length(arg)>0) and (arg[1] in Sym) do begin
      s:=s+arg[1];
      delete(arg,1,1);
    end;
    if length(s)>1 then
      FindWord(s);
  end;
end;

procedure PrintList;
var
  p:prec;
begin
  p:=list;
  while assigned(p) do begin
    writeln(p^.mword,p^.mcount:20-length(p^.mword) );
    p:=p^.mnext;
  end;
end;

var
  f:text;
  s,st:string;
  i:byte;

begin
  assign(f,'C:\Programm Pascal\my programs\P_55_1_1.pas');
  reset(f);
  list:=nil;
  while not eof(f) do begin
    readln(f,s);
    ProcessLine(s);
  end;
  close(f);
  PrintList;
  readln;
end. 

[SeZuka]

А попроще алгоритм нельзя было придумать?
И почему в конце не освобождаете память от того что туда напихали?
Ну а по сути, у вас не хватает инициализации поля в записи (указателя на следующую запись):
p^.mnext:=nil;
в процедуре AddToSortList

Код: Выделить всё

procedure AddToSortList(const aword:string);
var
  p,q:prec;
begin
  new(p);
  p^.mword:=aword;
  p^.mcount:=1;
  p^.mnext:=nil; // добавьте
  q:=list;