* implemented intf as object. When doing IInterface as TObject the compiler calls fpc_intf_as_class to query for the IImplementorGetter interface and then invokes GetObject to get the

objects reference.
* by default the TInterfacedObject is supporting now IImplementorGetter

git-svn-id: trunk@15080 -

compiler/ncnv.pas

@@ -3384,7 +3384,14 @@ implementation
 
          if (right.resultdef.typ=classrefdef) then
           begin
-            { left must be a class }
+            { left maybe an interface reference }
+            if is_interfacecom(left.resultdef) then
+             begin
+               { relation checks are not possible }
+             end
+            else
+
+            { or left must be a class }
             if is_class(left.resultdef) then
              begin
                { the operands must be related }
@@ -3397,7 +3404,7 @@ implementation
                     FullTypeName(tclassrefdef(right.resultdef).pointeddef,left.resultdef));
              end
             else
-             CGMessage1(type_e_class_type_expected,left.resultdef.typename);
+             CGMessage1(type_e_class_or_cominterface_type_expected,left.resultdef.typename);
             resultdef:=tclassrefdef(right.resultdef).pointeddef;
           end
          else if is_interface(right.resultdef) or is_dispinterface(right.resultdef) then
@@ -3487,7 +3494,10 @@ implementation
                   else
                     procname := 'fpc_class_as_intf'
                 else
-                  procname := 'fpc_intf_as';
+                  if right.resultdef.typ=classrefdef then
+                    procname := 'fpc_intf_as_class'
+                  else
+                    procname := 'fpc_intf_as';
                 call := ccallnode.createintern(procname,
                    ccallparanode.create(right,ccallparanode.create(left,nil)));
                 call := ctypeconvnode.create_internal(call,resultdef);

rtl/inc/compproc.inc

@@ -591,6 +591,7 @@ procedure fpc_intf_incr_ref(i: pointer); compilerproc;
 procedure fpc_intf_assign(var D: pointer; const S: pointer); compilerproc;
 procedure fpc_intf_assign_by_iid(var D: pointer; const S: pointer; const iid: TGUID); compilerproc;
 function  fpc_intf_as(const S: pointer; const iid: TGUID): IInterface; compilerproc;
+function fpc_intf_as_class(const S: pointer; const aclass: tclass): pointer; compilerproc;
 function fpc_class_as_intf(const S: pointer; const iid: TGUID): IInterface; compilerproc;
 function fpc_class_as_corbaintf(const S: pointer; const iid: Shortstring): Pointer; compilerproc;
 {$ifdef FPC_HAS_FEATURE_VARIANTS}

rtl/inc/objpas.inc

@@ -119,6 +119,30 @@
       end;
 
 
+    function fpc_intf_as_class(const S: pointer; const aclass: tclass): pointer;[public,alias: 'FPC_INTF_AS_CLASS']; compilerproc;
+      var
+        tmpi: pointer;
+        tmpo: tobject;
+      begin
+        if assigned(S) then
+          begin
+            tmpi := nil;
+            if IUnknown(S).QueryInterface(IImplementorGetter, tmpi)=S_OK then
+              begin
+                tmpo := IImplementorGetter(tmpi).GetObject;
+                IUnknown(tmpi)._Release;
+                if not assigned(tmpo) or not tmpo.inheritsfrom(aclass) then
+                  handleerror(219);
+                fpc_intf_as_class:=tmpo;
+              end
+            else
+              handleerror(219);
+          end
+        else
+          fpc_intf_as_class:=nil;
+      end;
+
+
     function fpc_class_as_intf(const S: pointer; const iid: TGUID): IInterface;[public,alias: 'FPC_CLASS_AS_INTF']; compilerproc;
       var
         tmpi: pointer; // _AddRef before _Release
@@ -870,6 +894,12 @@
            self.destroy;
       end;
 
+    function TInterfacedObject.GetObject : TObject;
+
+      begin
+         GetObject:=Self;
+      end;
+
     procedure TInterfacedObject.AfterConstruction;
 
       begin

rtl/inc/objpash.inc

@@ -279,13 +279,21 @@
             VarResult,ExcepInfo,ArgErr : pointer) : HResult;stdcall;
        end;
 
-       TInterfacedObject = class(TObject,IUnknown)
+       { for safe as operator support }
+       IImplementorGetter = interface
+         ['{D91C9AF4-3C93-420F-A303-BF5BA82BFD23}']
+         function GetObject : TObject;
+       end;
+
+       TInterfacedObject = class(TObject,IUnknown,IImplementorGetter)
        protected
           frefcount : longint;
           { implement methods of IUnknown }
           function QueryInterface(const iid : tguid;out obj) : longint;stdcall;
           function _AddRef : longint;stdcall;
           function _Release : longint;stdcall;
+          { implement methods of IImplementorGetter }
+          function GetObject : TObject;
         public
           procedure AfterConstruction;override;
           procedure BeforeDestruction;override;