Browse Source

* fixed assigning an interface to a property after better property
checks

git-svn-id: trunk@7484 -

Jonas Maebe 18 years ago
parent
commit
fa5e232055
3 changed files with 61 additions and 0 deletions
  1. 1 0
      .gitattributes
  2. 3 0
      compiler/nld.pas
  3. 57 0
      tests/test/tinterface5.pp

+ 1 - 0
.gitattributes

@@ -6855,6 +6855,7 @@ tests/test/tinterface1.pp svneol=native#text/plain
 tests/test/tinterface2.pp svneol=native#text/plain
 tests/test/tinterface2.pp svneol=native#text/plain
 tests/test/tinterface3.pp svneol=native#text/plain
 tests/test/tinterface3.pp svneol=native#text/plain
 tests/test/tinterface4.pp svneol=native#text/plain
 tests/test/tinterface4.pp svneol=native#text/plain
+tests/test/tinterface5.pp svneol=native#text/plain
 tests/test/tinterrupt.pp svneol=native#text/plain
 tests/test/tinterrupt.pp svneol=native#text/plain
 tests/test/tintfdef.pp svneol=native#text/plain
 tests/test/tintfdef.pp svneol=native#text/plain
 tests/test/tintuint.pp svneol=native#text/plain
 tests/test/tintuint.pp svneol=native#text/plain

+ 3 - 0
compiler/nld.pas

@@ -649,6 +649,9 @@ implementation
         { call helpers for interface }
         { call helpers for interface }
         if is_interfacecom(left.resultdef) then
         if is_interfacecom(left.resultdef) then
          begin
          begin
+           { remove property flag to avoid errors, see comments for }
+           { tf_winlikewidestring assignments below                 }
+           exclude(left.flags,nf_isproperty);
            if right.resultdef.is_related(left.resultdef) then
            if right.resultdef.is_related(left.resultdef) then
              begin
              begin
                hp:=
                hp:=

+ 57 - 0
tests/test/tinterface5.pp

@@ -0,0 +1,57 @@
+{ %VERSION=1.1 }
+{ %SKIPTARGET=macos }
+{ On macos it crashes when run.}
+
+{$mode objfpc}
+type
+  IInterface = interface(IUnknown)
+     procedure mydo;
+  end;
+
+  TMyClass = class(TInterfacedObject, IInterface)
+     procedure mydo;virtual;
+  end;
+
+  TMyClass2 = class(TMyClass)
+     i : integer;
+  end;
+
+  TMyClass3 = class
+    private
+      fi: IInterface;
+    public
+      property intf: IInterface read fi write fi;
+  end;
+
+
+
+var
+   l : longint;
+
+procedure tmyclass.mydo;
+
+  begin
+     l:=1;
+  end;
+
+var
+  c: TMyClass;
+  c2 : TMyClass;
+  c3 : TMyClass3;
+
+begin
+  c := TMyClass.Create;
+  c3 := TMyClass3.Create;
+  c3.intf := c;
+  l:=0;
+  c3.intf.mydo;
+  if l<>1 then
+    halt(1);
+  c2 := TMyClass2.Create;
+  c3.intf := c2;
+  l:=0;
+  c3.intf.mydo;
+  if l<>1 then
+    halt(1);
+  c3.free;
+end.