testgoto.out

格式化源码的最新板

unit testgoto;

interface

function jumpallaround: integer;
procedure forloop;
procedure untilloop;

implementation

uses SysUtils, Dialogs;

label
  fred;

function jumpallaround: integer;
label
  procstart, procmid, procend;
begin
  Result := 0;
  goto procmid;
  procstart:
    Inc(Result);
  procmid:
    Result := Result + random(10) - random(9);
  if Result < 10 then
    goto procstart;
  if Result > 20 then
    goto procend
  else
    goto procmid;
  procend: ;
end;

procedure forloop;
label
  loopstart;
var
  liloop: integer;
label
  loopend;
const
  loopmax = 20;
begin
  liloop := 0;
  loopstart:
  begin
    ShowMessage('Loop # ' + IntToStr(liloop));
    Inc(liloop);
    if liloop > loopmax then
      goto loopend
    else
      goto loopstart;
  end;
  loopend: ;
end;

procedure untilloop;
label
  loopstart;
var
  liloop: integer;
const
  loopmax = 20;
begin
  liloop := 0;
  loopstart:
    ShowMessage('Loop # ' + IntToStr(liloop));
  Inc(liloop);
  if (liloop < loopmax) or (random(10) = 3) then
    gotoloopstart;
end;

procedure testlabeluntil;
var
  i: integer;
  b: boolean;
label
  lbl;
begin
  repeat
    if b then
      goto lbl;
    lbl:
  until b;
end;

label
  jim;
begin
  goto jim;
  fred:
    ShowMessage('Fred was here ');
  jim: ;
end.