Forráskód Böngészése

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

git-svn-id: trunk@35495 -
maciej-izak 8 éve
szülő
commit
16a11c8b7a
3 módosított fájl, 30 hozzáadás és 2 törlés
  1. 1 0
      .gitattributes
  2. 5 2
      compiler/pexpr.pas
  3. 24 0
      tests/webtbs/tw10933.pp

+ 1 - 0
.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

+ 5 - 2
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 }

+ 24 - 0
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.