From 58fc64dc0966f85957228e656383e0855ee2a94e Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Tue, 20 Aug 2002 18:24:05 +0000
Subject: [PATCH]   * interface "as" helpers converted from procedures to
 functions

---
 rtl/inc/compproc.inc |  8 ++++++--
 rtl/inc/objpas.inc   | 23 ++++++++++++-----------
 2 files changed, 18 insertions(+), 13 deletions(-)

diff --git a/rtl/inc/compproc.inc b/rtl/inc/compproc.inc
index 3cf2df3f73..052451dcae 100644
--- a/rtl/inc/compproc.inc
+++ b/rtl/inc/compproc.inc
@@ -178,7 +178,8 @@ function fpc_do_as(aclass : tclass;aobject : tobject): tobject; compilerproc;
 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_as(var D: pointer; const S: pointer; const iid: TGUID); compilerproc;
+function  fpc_intf_as(const S: pointer; const iid: TGUID): pointer; compilerproc;
+function fpc_class_as_intf(const S: pointer; const iid: TGUID): pointer; compilerproc;
 
 Function fpc_PushExceptAddr (Ft: Longint;_buf,_newaddr : pointer): PJmp_buf ; compilerproc;
 Procedure fpc_PushExceptObj (Obj : TObject; AnAddr,AFrame : Pointer); compilerproc;
@@ -261,7 +262,10 @@ function fpc_qword_to_double(q: qword): double; compilerproc;
 
 {
   $Log$
-  Revision 1.18  2002-07-31 16:58:12  jonas
+  Revision 1.19  2002-08-20 18:24:05  jonas
+    * interface "as" helpers converted from procedures to functions
+
+  Revision 1.18  2002/07/31 16:58:12  jonas
     * fixed conversion from int64/qword to double errors
 
   Revision 1.17  2002/07/28 20:43:47  florian
diff --git a/rtl/inc/objpas.inc b/rtl/inc/objpas.inc
index 101cc585bd..b8a250433e 100644
--- a/rtl/inc/objpas.inc
+++ b/rtl/inc/objpas.inc
@@ -88,7 +88,7 @@
          D:=S;
       end;
 
-    procedure fpc_intf_as(var D: pointer; const S: pointer; const iid: TGUID);[public,alias: 'FPC_INTF_AS']; {$ifdef hascompilerproc} compilerproc; {$endif}
+    function fpc_intf_as(const S: pointer; const iid: TGUID): pointer;[public,alias: 'FPC_INTF_AS']; {$ifdef hascompilerproc} compilerproc; {$endif}
       const
         S_OK = 0;
       var
@@ -98,14 +98,14 @@
           begin
              if IUnknown(S).QueryInterface(iid,tmpi)<>S_OK then
                handleerror(219);
-             if assigned(D) then IUnknown(D)._Release;
-             D:=tmpi;
+             fpc_intf_as:=tmpi;
           end
         else
-          intf_decr_ref(D);
+          fpc_intf_as:=nil;
       end;
 
-    procedure fpc_class_as_intf(var D: pointer; const S: pointer; const iid: TGUID);[public,alias: 'FPC_CLASS_AS_INTF']; {$ifdef hascompilerproc} compilerproc; {$endif}
+
+    function fpc_class_as_intf(const S: pointer; const iid: TGUID): pointer;[public,alias: 'FPC_CLASS_AS_INTF']; {$ifdef hascompilerproc} compilerproc; {$endif}
       const
         S_OK = 0;
       var
@@ -113,14 +113,12 @@
       begin
         if assigned(S) then
           begin
-             if TObject(S).GetInterface(iid,tmpi) then
+             if not TObject(S).GetInterface(iid,tmpi) then
                handleerror(219);
-             if assigned(D) then
-               IUnknown(D)._Release;
-             D:=tmpi;
+             fpc_class_as_intf:=tmpi;
           end
         else
-          intf_decr_ref(D);
+          fpc_class_as_intf:=nil;
       end;
 {$endif HASINTF}
 
@@ -715,7 +713,10 @@
 
 {
   $Log$
-  Revision 1.23  2002-07-30 17:29:19  florian
+  Revision 1.24  2002-08-20 18:24:06  jonas
+    * interface "as" helpers converted from procedures to functions
+
+  Revision 1.23  2002/07/30 17:29:19  florian
     * interface helpers for 1.1 compilers without interface support fixed
 
   Revision 1.22  2002/07/01 16:29:05  peter