Bug fix for getting pointer to function result (mantis #10933 #19861)

git-svn-id: trunk@35495 -
This commit is contained in:
maciej-izak 2017-03-01 13:23:02 +00:00
parent 07cfb2f43a
commit 16a11c8b7a
3 changed files with 30 additions and 2 deletions

1
.gitattributes vendored
View File

@ -14156,6 +14156,7 @@ tests/webtbs/tw1092.pp svneol=native#text/plain
tests/webtbs/tw10920.pp svneol=native#text/plain
tests/webtbs/tw10927.pp svneol=native#text/plain
tests/webtbs/tw10931.pp svneol=native#text/plain
tests/webtbs/tw10933.pp svneol=native#text/pascal
tests/webtbs/tw1096.pp svneol=native#text/plain
tests/webtbs/tw10966.pp svneol=native#text/plain
tests/webtbs/tw1097.pp svneol=native#text/plain

View File

@ -1012,8 +1012,11 @@ implementation
end;
end;
{ only need to get the address of the procedure? }
if getaddr then
{ only need to get the address of the procedure? Check token because
in the case of opening parenthesis is possible to get pointer to
function result (lack of checking for token was the reason of
tw10933.pp test failure) }
if getaddr and (token<>_LKLAMMER) then
begin
{ for now we don't support pointers to generic functions, but since
this is only temporary we use a non translated message }

24
tests/webtbs/tw10933.pp Normal file
View File

@ -0,0 +1,24 @@
program tw10933;
{$MODE DELPHI}
var
s: string[3] = 'ABC';
procedure Foo(buf: PAnsiChar; expected: AnsiChar);
begin
WriteLn(buf^);
if buf^ <> expected then
Halt(1);
end;
function ClassNameShort(): PShortString;
begin
Result := @s;
end;
begin
Foo(@ClassNameShort()^[1], 'A');
Foo(@ClassNameShort()^[2], 'B');
Foo(@ClassNameShort()^[3], 'C');
end.