* added fpc_class_is_corbaintf and fpc_class_cast_corbaintf compiler helper functions

git-svn-id: trunk@15085 -

rtl/inc/compproc.inc

@@ -590,13 +590,15 @@ procedure fpc_intf_decr_ref(var i: pointer); compilerproc;
 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_is(const S: pointer; const iid: TGUID): Boolean; compilerproc;
+function fpc_intf_is(const S: pointer; const iid: TGUID): Boolean; compilerproc;
 function fpc_intf_is_class(const S: pointer; const aclass: tclass): Boolean; compilerproc;
 function fpc_class_is_intf(const S: pointer; const iid: TGUID): Boolean; compilerproc;
-function  fpc_intf_cast(const S: pointer; const iid: TGUID): IInterface; compilerproc;
+function fpc_class_is_corbaintf(const S: pointer; const iid: Shortstring): Boolean; compilerproc;
+function fpc_intf_cast(const S: pointer; const iid: TGUID): IInterface; compilerproc;
 function fpc_intf_cast_class(const S: pointer; const aclass: tclass): pointer; compilerproc;
 function fpc_class_cast_intf(const S: pointer; const iid: TGUID): IInterface; compilerproc;
-function  fpc_intf_as(const S: pointer; const iid: TGUID): IInterface; compilerproc;
+function fpc_class_cast_corbaintf(const S: pointer; const iid: Shortstring): Pointer; 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;

rtl/inc/objpas.inc

@@ -122,7 +122,7 @@
         tmpo: tobject;
       begin
         tmpi := nil;
-        if Assigned(S) and (IUnknown(S).QueryInterface(IImplementorGetter, tmpi)=S_OK) then
+        if Assigned(S) and (IUnknown(S).QueryInterface(IImplementorGetter,tmpi)=S_OK) then
           begin
             tmpo := IImplementorGetter(tmpi).GetObject;
             IUnknown(tmpi)._Release;
@@ -147,6 +147,11 @@
       end;
 
 
+    function fpc_class_is_corbaintf(const S: pointer; const iid: Shortstring): Boolean;[public,alias: 'FPC_CLASS_IS_CORBAINTF']; compilerproc;
+      begin
+        fpc_class_is_corbaintf:=Assigned(S) and Assigned(TObject(S).GetInterfaceEntryByStr(iid));
+      end;
+
 
     function fpc_intf_cast(const S: pointer; const iid: TGUID): IInterface;[public,alias: 'FPC_INTF_CAST']; compilerproc;
       var
@@ -195,6 +200,17 @@
       end;
 
 
+    function fpc_class_cast_corbaintf(const S: pointer; const iid: Shortstring): Pointer;[public,alias: 'FPC_CLASS_CAST_CORBAINTF']; compilerproc;
+      var
+        tmpi: pointer;
+      begin
+        if Assigned(S) and TObject(S).GetInterface(iid,tmpi) then
+          fpc_class_cast_corbaintf:=tmpi
+        else
+          fpc_class_cast_corbaintf:=nil;
+      end;
+
+
     function fpc_intf_as(const S: pointer; const iid: TGUID): IInterface;[public,alias: 'FPC_INTF_AS']; compilerproc;
       var
         tmpi: pointer; // _AddRef before _Release
@@ -219,7 +235,7 @@
         if assigned(S) then
           begin
             tmpi := nil;
-            if IUnknown(S).QueryInterface(IImplementorGetter, tmpi)=S_OK then
+            if IUnknown(S).QueryInterface(IImplementorGetter,tmpi)=S_OK then
               begin
                 tmpo := IImplementorGetter(tmpi).GetObject;
                 IUnknown(tmpi)._Release;