* use myexit to restore block_type

git-svn-id: trunk@1062 -
This commit is contained in:
peter 2005-09-08 05:48:17 +00:00
parent 14fca113bf
commit 26f25c89ee
3 changed files with 30 additions and 5 deletions

1
.gitattributes vendored
View File

@ -6212,6 +6212,7 @@ tests/webtbs/tw4277.pp svneol=native#text/plain
tests/webtbs/tw4294.pp svneol=native#text/plain
tests/webtbs/tw4308.pp svneol=native#text/plain
tests/webtbs/tw4336.pp svneol=native#text/plain
tests/webtbs/tw4350.pp svneol=native#text/plain
tests/webtbs/ub1873.pp svneol=native#text/plain
tests/webtbs/ub1883.pp svneol=native#text/plain
tests/webtbs/uw0555.pp svneol=native#text/plain

View File

@ -54,7 +54,8 @@ implementation
{$endif fpc}
{ this procedure reads typed constants }
procedure readtypedconst(const t:ttype;sym : ttypedconstsym;writable : boolean);
label
myexit;
type
setbytes = array[0..31] of byte;
Psetbytes = ^setbytes;
@ -732,7 +733,7 @@ implementation
if (po_methodpointer in tprocvardef(t.def).procoptions) then
asmlist[cural].concat(Tai_const.Create_sym(nil));
consume(_NIL);
exit;
goto myexit;
end;
{ you can't assign a value other than NIL to a typed constant }
{ which is a "procedure of object", because this also requires }
@ -747,14 +748,14 @@ implementation
if codegenerror then
begin
p.free;
exit;
goto myexit;
end;
{ let type conversion check everything needed }
inserttypeconv(p,t);
if codegenerror then
begin
p.free;
exit;
goto myexit;
end;
{ remove typeconvs, that will normally insert a lea
instruction which is not necessary for us }
@ -812,7 +813,7 @@ implementation
begin
p.free;
Message(parser_e_illegal_expression);
exit;
goto myexit;
end;
end
else
@ -1026,6 +1027,7 @@ implementation
end;
else Message(parser_e_type_const_not_possible);
end;
myexit:
block_type:=old_block_type;
end;
{$ifdef fpc}

22
tests/webtbs/tw4350.pp Executable file
View File

@ -0,0 +1,22 @@
{$mode delphi}
unit tw4350;
interface
uses
Classes;
type
TIdStackSocketHandle = integer ;// class end;
TIdServeFile = function(ASocket: TIdStackSocketHandle; AFileName: string): cardinal;
TIdStackBSDBase = Class
end;
var
GServeFileProc: TIdServeFile = nil; // comment either, and the other line works?
GBSDStack: TIdStackBSDBase = nil;
implementation
end.