diff --git a/.gitattributes b/.gitattributes index bab6af5e04..802bf09b0a 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 53ea19348f..a98a092d3d 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -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 } diff --git a/tests/webtbs/tw10933.pp b/tests/webtbs/tw10933.pp new file mode 100644 index 0000000000..52dee42294 --- /dev/null +++ b/tests/webtbs/tw10933.pp @@ -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.