浏览代码

* don't call procvars passed to formal parameters (mantis #11861)

git-svn-id: trunk@11592 -
Jonas Maebe 17 年之前
父节点
当前提交
6d0326a55b
共有 4 个文件被更改,包括 43 次插入3 次删除
  1. 1 0
      .gitattributes
  2. 2 2
      compiler/htypechk.pas
  3. 1 1
      compiler/ncal.pas
  4. 39 0
      tests/webtbs/tw11861.pp

+ 1 - 0
.gitattributes

@@ -8542,6 +8542,7 @@ tests/webtbs/tw11619.pp svneol=native#text/plain
 tests/webtbs/tw1181.pp svneol=native#text/plain
 tests/webtbs/tw1181.pp svneol=native#text/plain
 tests/webtbs/tw11848.pp svneol=native#text/plain
 tests/webtbs/tw11848.pp svneol=native#text/plain
 tests/webtbs/tw11852.pp svneol=native#text/plain
 tests/webtbs/tw11852.pp svneol=native#text/plain
+tests/webtbs/tw11861.pp svneol=native#text/plain
 tests/webtbs/tw1203.pp svneol=native#text/plain
 tests/webtbs/tw1203.pp svneol=native#text/plain
 tests/webtbs/tw1204.pp svneol=native#text/plain
 tests/webtbs/tw1204.pp svneol=native#text/plain
 tests/webtbs/tw1207.pp svneol=native#text/plain
 tests/webtbs/tw1207.pp svneol=native#text/plain

+ 2 - 2
compiler/htypechk.pas

@@ -1998,8 +1998,8 @@ implementation
                internalerror(200212092);
                internalerror(200212092);
 
 
               { Convert tp procvars when not expecting a procvar }
               { Convert tp procvars when not expecting a procvar }
-              if (def_to.typ<>procvardef) and
-                 (currpt.left.resultdef.typ=procvardef) and
+             if (currpt.left.resultdef.typ=procvardef) and
+                not(def_to.typ in [procvardef,formaldef]) and
                  { Only convert to call when there is no overload or the return type
                  { Only convert to call when there is no overload or the return type
                    is equal to the expected type. }
                    is equal to the expected type. }
                  (
                  (

+ 1 - 1
compiler/ncal.pas

@@ -604,7 +604,7 @@ implementation
                here to make the change permanent. in the overload
                here to make the change permanent. in the overload
                choosing the changes are only made temporary }
                choosing the changes are only made temporary }
              if (left.resultdef.typ=procvardef) and
              if (left.resultdef.typ=procvardef) and
-                (parasym.vardef.typ<>procvardef) then
+                not(parasym.vardef.typ in [procvardef,formaldef]) then
                begin
                begin
                  if maybe_call_procvar(left,true) then
                  if maybe_call_procvar(left,true) then
                    resultdef:=left.resultdef;
                    resultdef:=left.resultdef;

+ 39 - 0
tests/webtbs/tw11861.pp

@@ -0,0 +1,39 @@
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+type
+
+  { TMyObj }
+
+  TMyObj = class
+    procedure Proc(A1 : TObject; A2: Integer);
+  end;
+
+type
+   TProc = procedure(AObject : TObject; A2: Integer) of object;
+
+  
+var X: TMyObj;
+    P1: TProc;
+
+procedure foo(const AMethod1);
+begin
+  if pointer(AMethod1) <> pointer(@P1) then
+    halt(1);
+end;
+
+   
+{ TMyObj }
+
+procedure TMyObj.Proc(A1 : TObject; A2: Integer);
+begin
+end;
+
+
+begin
+  X := TMyObj.Create;
+  P1 := X.Proc;
+  foo(P1);
+end.
+