View Issue Details

IDProjectCategoryView StatusLast Update
0027486FPCPatchpublic2016-01-02 22:01
ReporterJosé Mejuto Assigned ToMichael Van Canneyt  
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Platformx64OSWindows 
Product Version3.0.1 
Target Version3.0.2Fixed in Version3.1.1 
Summary0027486: typelib.pas generates wrong *_TLB.pas files
DescriptioniUnknown interface functions are not imported, so any interface that exposes this funcions is wrongly imported as function index is shifted by one.
This excluded functions are QueryInterface, AddRef, Release and IDispatch ones GetTypeInfoCount, GetTypeInfo, GetIdsOfNames and Invoke.

This functions must be imported.

Some parameters requires "val" (byref) modifier.
Additional InformationThe attached patch fixes both problems. It has been tested with several TLBs

The remove of functions like "QueryInterface" has been commented instead plain remove because I do not know the exact reason as the original developer left this functions out of import.
TagsNo tags attached.
Fixed in Revision32823
FPCOldBugId
FPCTarget
Attached Files

Activities

José Mejuto

2015-02-17 18:31

reporter  

typelib_const_var_interface.patch (4,731 bytes)   
 packages/winunits-base/src/typelib.pas | 63 ++++++++++++++++++++++------------
 1 file changed, 41 insertions(+), 22 deletions(-)

diff --git a/packages/winunits-base/src/typelib.pas b/packages/winunits-base/src/typelib.pas
index 42f8350..54db610 100644
--- a/packages/winunits-base/src/typelib.pas
+++ b/packages/winunits-base/src/typelib.pas
@@ -466,6 +466,7 @@ var
   VD: lpVARDESC;
   aPropertyDefs:array of TPropertyDef;
   Propertycnt,iType:integer;
+  Modifier: string;
 
   function findProperty(ireqdispid:integer):integer;
   var i:integer;
@@ -545,11 +546,18 @@ begin
     OleCheck(TI.GetNames(FD^.memid,@BL,length(BL),cnt));
     // skip IUnknown and IDispatch methods
     sl:=lowercase(BL[0]);
-    if (sl='queryinterface') or (sl='addref') or (sl='release') then  //IUnknown
+    (*************************
+     * Code portion removed by José Mejuto.
+     * If the interface declaration appears in the TLB it must be imported
+     * or the sequences of functions will be broken and any function below this
+     * point would be called wrongly.
+     *************************
+    if ((sl='queryinterface') or (sl='addref') or (sl='release')) then  //IUnknown
       continue;
     if bIsDispatch and
       ((sl='gettypeinfocount') or (sl='gettypeinfo') or (sl='getidsofnames') or (sl='invoke')) then  //IDispatch
       continue;
+      *)
     // get return type
     if bIsDispatch and ((FD^.invkind=INVOKE_PROPERTYGET) or (FD^.invkind=INVOKE_FUNC)) then
       begin
@@ -761,6 +769,8 @@ begin
           begin
           //getters/setters for interface, insert in interface as they come,
           //store in aPropertyDefs to create properties at the end
+          bParamByRef:=(FD^.lprgelemdescParam[0].tdesc.vt=VT_PTR) and                         // by ref
+          not((FD^.lprgelemdescParam[0].tdesc.lptdesc^.vt=VT_USERDEFINED) and bIsInterface);// but not pointer to interface
           if bPropHasParam then
             begin
             sPropParam2:='('+sPropParam+')';
@@ -785,33 +795,42 @@ begin
             begin
             if not MakeValidId(GetName(1),sVarName) then
               AddToHeader('//  Warning: renamed parameter ''%s'' in %s.Set_%s to ''%s''',[GetName(1),iname,sMethodName,sVarName]);
-            with aPropertyDefs[findProperty(FD^.memid)] do
+            if not bParamByRef then
               begin
-              if FD^.invkind=INVOKE_PROPERTYPUT then
-                begin
-                sptype:=sType;
-                bput:=true;
-                if bputref then                  //disambiguate  multiple setter
-                  sMethodName:=sMethodName+'_';
-                pname:=sMethodName;
-                end
-              else
+              with aPropertyDefs[findProperty(FD^.memid)] do
                 begin
-                sprtype:=sType;
-                bputref:=true;
-                if bput then                     //disambiguate  multiple setter
-                  sMethodName:=sMethodName+'_';
-                prname:=sMethodName;
+                if FD^.invkind=INVOKE_PROPERTYPUT then
+                  begin
+                  sptype:=sType;
+                  bput:=true;
+                  if bputref then                  //disambiguate  multiple setter
+                    sMethodName:=sMethodName+'_';
+                  pname:=sMethodName;
+                  end
+                else
+                  begin
+                  sprtype:=sType;
+                  bputref:=true;
+                  if bput then                     //disambiguate  multiple setter
+                    sMethodName:=sMethodName+'_';
+                  prname:=sMethodName;
+                  end;
+                  sorgname:=BstrName;
+                  sdoc:=BstrDocString;
+                  sParam:=sPropParam;
+                  sDefault:=sl;
                 end;
-              sorgname:=BstrName;
-              sdoc:=BstrDocString;
-              sParam:=sPropParam;
-              sDefault:=sl;
               end;
+
+            if not bParamByRef then begin
+              Modifier:='const';
+            end else begin
+              Modifier:='var';
+            end;
             if bPropHasParam then
-              s:=s+format('   procedure Set_%s(const %s:%s); %s;'#13#10,[sMethodName,sPropParam3,sType,sConv])
+              s:=s+format('   procedure Set_%s(%s %s:%s); %s;'#13#10,[sMethodName,Modifier,sPropParam3,sType,sConv])
             else
-              s:=s+format('   procedure Set_%s(const %s:%s); %s;'#13#10,[sMethodName,sVarName,sType,sConv]);
+              s:=s+format('   procedure Set_%s(%s %s:%s); %s;'#13#10,[sMethodName,Modifier,sVarName,sType,sConv]);
             end;
           end;
         end;

Michael Van Canneyt

2016-01-01 18:11

administrator   ~0088501

Applied the patch (with small modification) , thank you.

Issue History

Date Modified Username Field Change
2015-02-17 18:31 José Mejuto New Issue
2015-02-17 18:31 José Mejuto File Added: typelib_const_var_interface.patch
2016-01-01 18:11 Michael Van Canneyt Fixed in Revision => 32823
2016-01-01 18:11 Michael Van Canneyt Note Added: 0088501
2016-01-01 18:11 Michael Van Canneyt Status new => resolved
2016-01-01 18:11 Michael Van Canneyt Fixed in Version => 3.1.1
2016-01-01 18:11 Michael Van Canneyt Resolution open => fixed
2016-01-01 18:11 Michael Van Canneyt Assigned To => Michael Van Canneyt
2016-01-01 18:11 Michael Van Canneyt Target Version => 3.0.2
2016-01-01 19:51 José Mejuto Status resolved => closed