Просмотр исходного кода

Merged revisions 1491 via svnmerge from
http://[email protected]/svn/fpc/trunk

r1491 (peter)
* prefer object->object over object->intf

git-svn-id: branches/fixes_2_0@1520 -

peter 20 лет назад
Родитель
Сommit
6a39e37549
3 измененных файлов с 32 добавлено и 2 удалено
  1. 1 0
      .gitattributes
  2. 3 2
      compiler/defcmp.pas
  3. 28 0
      tests/webtbs/tw3829.pp

+ 1 - 0
.gitattributes

@@ -5985,6 +5985,7 @@ tests/webtbs/tw3805.pp svneol=native#text/plain
 tests/webtbs/tw3812.pp svneol=native#text/plain
 tests/webtbs/tw3814.pp svneol=native#text/plain
 tests/webtbs/tw3827.pp svneol=native#text/plain
+tests/webtbs/tw3829.pp -text svneol=unset#text/plain
 tests/webtbs/tw3833.pp svneol=native#text/plain
 tests/webtbs/tw3840.pp svneol=native#text/plain
 tests/webtbs/tw3863.pp svneol=native#text/plain

+ 3 - 2
compiler/defcmp.pas

@@ -1092,7 +1092,8 @@ implementation
                              if hd3.implementedinterfaces.searchintf(def_to)<>-1 then
                                begin
                                   doconv:=tc_class_2_intf;
-                                  eq:=te_convert_l1;
+                                  { don't prefer this over objectdef->objectdef }
+                                  eq:=te_convert_l2;
                                   break;
                                end;
                              hd3:=hd3.childof;
@@ -1110,7 +1111,7 @@ implementation
                    else if (def_from.deftype=variantdef) and is_interface(def_to) then
                      begin
                        doconv:=tc_variant_2_interface;
-                       eq:=te_convert_l1;
+                       eq:=te_convert_l2;
                      end
                    { ugly, but delphi allows it }
                    else if (eq=te_incompatible) and

+ 28 - 0
tests/webtbs/tw3829.pp

@@ -0,0 +1,28 @@
+{ Source provided for Free Pascal Bug Report 3829 }
+{ Submitted by "Thomas Schatzl" on  2005-03-25 }
+{ e-mail:  }
+{$mode delphi}
+
+uses
+  sysutils;
+
+type
+  IAny = interface  ['{A40AEE53-8C88-4DD2-9F14-05A8C1A64849}']
+  end;
+
+  TAny = class(TInterfacedObject, IAny)
+  end;
+
+var
+  a : TAny;
+
+begin
+  a:=TAny.Create;
+
+  (a as IAny)._Addref();
+
+  if (supports(a, IAny)) then
+    writeln('ok')
+  else
+    halt(1);
+end.