Browse Source

* calculate distance between related objectdefs

git-svn-id: trunk@1492 -
peter 20 years ago
parent
commit
260861e184
3 changed files with 52 additions and 0 deletions
  1. 1 0
      .gitattributes
  2. 19 0
      compiler/htypechk.pas
  3. 32 0
      tests/webtbs/tw4278.pp

+ 1 - 0
.gitattributes

@@ -6320,6 +6320,7 @@ tests/webtbs/tw4260.pp svneol=native#text/plain
 tests/webtbs/tw4266.pp -text
 tests/webtbs/tw4266.pp -text
 tests/webtbs/tw4272.pp svneol=native#text/plain
 tests/webtbs/tw4272.pp svneol=native#text/plain
 tests/webtbs/tw4277.pp svneol=native#text/plain
 tests/webtbs/tw4277.pp svneol=native#text/plain
+tests/webtbs/tw4278.pp svneol=native#text/plain
 tests/webtbs/tw4290.pp svneol=native#text/plain
 tests/webtbs/tw4290.pp svneol=native#text/plain
 tests/webtbs/tw4294.pp svneol=native#text/plain
 tests/webtbs/tw4294.pp svneol=native#text/plain
 tests/webtbs/tw4308.pp svneol=native#text/plain
 tests/webtbs/tw4308.pp svneol=native#text/plain

+ 19 - 0
compiler/htypechk.pas

@@ -1737,6 +1737,7 @@ implementation
         paraidx  : integer;
         paraidx  : integer;
         currparanr : byte;
         currparanr : byte;
         rfh,rth  : bestreal;
         rfh,rth  : bestreal;
+        objdef   : tobjectdef;
         def_from,
         def_from,
         def_to   : tdef;
         def_to   : tdef;
         currpt,
         currpt,
@@ -1862,6 +1863,24 @@ implementation
                    hp^.ordinal_distance:=hp^.ordinal_distance+rfh;
                    hp^.ordinal_distance:=hp^.ordinal_distance+rfh;
                  end
                  end
               else
               else
+              { related object parameters also need to determine the distance between the current
+                object and the object we are comparing with }
+               if (def_from.deftype=objectdef) and
+                  (def_to.deftype=objectdef) and
+                  (tobjectdef(def_from).objecttype=tobjectdef(def_to).objecttype) and
+                  tobjectdef(def_from).is_related(tobjectdef(def_to)) then
+                 begin
+                   eq:=te_convert_l1;
+                   objdef:=tobjectdef(def_from);
+                   while assigned(objdef) do
+                     begin
+                       if objdef=def_to then
+                         break;
+                       hp^.ordinal_distance:=hp^.ordinal_distance+1;
+                       objdef:=objdef.childof;
+                     end;
+                 end
+              else
               { generic type comparision }
               { generic type comparision }
                begin
                begin
                  eq:=compare_defs_ext(def_from,def_to,currpt.left.nodetype,convtype,pdoper,cdoptions);
                  eq:=compare_defs_ext(def_from,def_to,currpt.left.nodetype,convtype,pdoper,cdoptions);

+ 32 - 0
tests/webtbs/tw4278.pp

@@ -0,0 +1,32 @@
+{$mode objfpc}
+
+var
+  err : boolean;
+
+type
+  TA = class
+  end;
+  TB = class(TA)
+  end;
+  TC = class(TB)
+  end;
+
+procedure Test(const A: TA); overload;
+begin
+end;
+
+procedure Test(const B: TB); overload;
+begin
+  writeln('ok');
+  err:=false;
+end;
+
+var
+  X : TC;
+
+begin
+  err:=true;
+  Test(X);
+  if err then
+    halt(1);
+end.