Browse Source

* when looking for a procdef matching a procvardef in an objectdef,
also check in parent objectdef in case of overload and nothing
found in the current objectdef (mantis #18706)

git-svn-id: trunk@19736 -

Jonas Maebe 13 years ago
parent
commit
f62e118f8e
3 changed files with 93 additions and 17 deletions
  1. 1 0
      .gitattributes
  2. 43 17
      compiler/symsym.pas
  3. 49 0
      tests/webtbs/tw18706.pp

+ 1 - 0
.gitattributes

@@ -11820,6 +11820,7 @@ tests/webtbs/tw1863.pp svneol=native#text/plain
 tests/webtbs/tw1867.pp svneol=native#text/plain
 tests/webtbs/tw1867.pp svneol=native#text/plain
 tests/webtbs/tw18690.pp svneol=native#text/plain
 tests/webtbs/tw18690.pp svneol=native#text/plain
 tests/webtbs/tw18702.pp svneol=native#text/pascal
 tests/webtbs/tw18702.pp svneol=native#text/pascal
+tests/webtbs/tw18706.pp svneol=native#text/plain
 tests/webtbs/tw1873.pp svneol=native#text/plain
 tests/webtbs/tw1873.pp svneol=native#text/plain
 tests/webtbs/tw18767a.pp svneol=native#text/pascal
 tests/webtbs/tw18767a.pp svneol=native#text/pascal
 tests/webtbs/tw18767b.pp svneol=native#text/pascal
 tests/webtbs/tw18767b.pp svneol=native#text/pascal

+ 43 - 17
compiler/symsym.pas

@@ -752,6 +752,8 @@ implementation
         bestpd,
         bestpd,
         pd : tprocdef;
         pd : tprocdef;
         eq,besteq : tequaltype;
         eq,besteq : tequaltype;
+        sym: tsym;
+        ps: tprocsym;
       begin
       begin
         { This function will return the pprocdef of pprocsym that
         { This function will return the pprocdef of pprocsym that
           is the best match for procvardef. When there are multiple
           is the best match for procvardef. When there are multiple
@@ -759,23 +761,47 @@ implementation
         result:=nil;
         result:=nil;
         bestpd:=nil;
         bestpd:=nil;
         besteq:=te_incompatible;
         besteq:=te_incompatible;
-        for i:=0 to ProcdefList.Count-1 do
-          begin
-            pd:=tprocdef(ProcdefList[i]);
-            eq:=proc_to_procvar_equal(pd,d,false);
-            if eq>=te_convert_l1 then
-              begin
-                { multiple procvars with the same equal level }
-                if assigned(bestpd) and
-                   (besteq=eq) then
-                  exit;
-                if eq>besteq then
-                  begin
-                    besteq:=eq;
-                    bestpd:=pd;
-                  end;
-              end;
-          end;
+        ps:=self;
+        repeat
+          for i:=0 to ps.ProcdefList.Count-1 do
+            begin
+              pd:=tprocdef(ps.ProcdefList[i]);
+              eq:=proc_to_procvar_equal(pd,d,false);
+              if eq>=te_convert_l1 then
+                begin
+                  { multiple procvars with the same equal level }
+                  if assigned(bestpd) and
+                     (besteq=eq) then
+                    exit;
+                  if eq>besteq then
+                    begin
+                      besteq:=eq;
+                      bestpd:=pd;
+                    end;
+                end;
+            end;
+          { maybe TODO: also search class helpers? -- this code is similar to
+            what happens in htypechk in
+            tcallcandidates.collect_overloads_in_struct: keep searching in
+            parent types in case the currently found procdef is marked as
+            "overload" and we haven't found a proper match yet }
+          if assigned(ps.owner.defowner) and
+             (ps.owner.defowner.typ=objectdef) and
+             assigned(tobjectdef(ps.owner.defowner).childof) and
+             (not assigned(bestpd) or
+              (po_overload in bestpd.procoptions)) then
+            begin
+              sym:=tsym(tobjectdef(ps.owner.defowner).childof.symtable.find(ps.name));
+              if assigned(sym) and
+                 (sym.typ=procsym) then
+                ps:=tprocsym(sym)
+              else
+                ps:=nil;
+            end
+          else
+            ps:=nil;
+        until (besteq>=te_equal) or
+              not assigned(ps);
         result:=bestpd;
         result:=bestpd;
       end;
       end;
 
 

+ 49 - 0
tests/webtbs/tw18706.pp

@@ -0,0 +1,49 @@
+{$MODE DELPHI}
+
+type
+
+  TExecProc = procedure of object;
+
+  TA = class
+  public
+    procedure P1; overload; virtual;
+    procedure P1(const param: boolean); overload; virtual;
+  end;
+
+  TB = class(TA)
+  public
+    procedure P1(const param: boolean); override;
+  end;
+
+procedure ShowProc(p: TExecProc);
+begin
+  p;
+end;
+
+procedure TA.P1;
+begin
+  writeln('1');
+end;
+
+procedure TA.P1(const param: boolean);
+begin
+  writeln('2');
+  halt(1);
+end;
+
+procedure TB.P1(const param: boolean);
+begin
+  writeln('3');
+  halt(2);
+end;
+
+var
+  a: TA;
+  b: TB;
+begin
+  a := TA.Create;
+  b := TB.Create;
+
+  ShowProc(a.P1); // compile and execute correctly
+  ShowProc(b.P1); // error on compile !!! but here should be call TA.P1 !!!
+end.