* importtl new parameter --ref-style that allows to set different styles for reference input param. (var, constref or const [ref])

A more complete solution for bugreport #30764. 
Changed importtl to getopts for param parsing

git-svn-id: trunk@38338 -

packages/winunits-base/src/typelib.pas

@@ -39,6 +39,12 @@ interface
 uses
   Classes, SysUtils,comobj,activex,windows;
 
+// Style of input ref parameters:
+Type
+    TParamInputRefType = (ParamInputVar,               // old delphi [in] becomes VAR,  Default
+                          ParamInputConstRef,          // (old) FPC    [in] becomes CONSTREF
+                          ParamInputConstRefDelphi);   // XE3+ style  CONST [Ref]
+
 {
 Reads type information from 'FileName' and converts it in a freepascal binding unit. The
 contents of the unit is returned as the function result.
@@ -52,12 +58,12 @@ To load a different type of library resource, append an integer index to 'FileNa
 
 Example:  C:\WINDOWS\system32\msvbvm60.dll\3
 }
+
 function ImportTypelib(FileName: WideString;var sUnitName:string;var slDependencies:TStringList;
-  bActiveX,bPackage,bRemoveStructTag:boolean;var sPackageSource,sPackageRegUnitSource:String):string;
+  bActiveX,bPackage,bRemoveStructTag:boolean;var sPackageSource,sPackageRegUnitSource:String;inreftype :TParamInputRefType  = ParamInputVar):string;
 
 
 Type
-
   { TTypeLibImporter }
 
   TTypeLibImporter = Class(TComponent)
@@ -65,6 +71,7 @@ Type
     FActiveX: Boolean;
     FAppendVersionNumber: Boolean;
     FCreatePackage: Boolean;
+    FInParamRefStyle : TParamInputRefType;
     FDependencies: TStringList;
     FRemoveStructTag: Boolean;
     FUnitSource: TStringList;
@@ -157,6 +164,8 @@ Type
     Property RemoveStructTag : Boolean read FRemoveStructTag write SetRemoveStructTag Default False;
     // Set automatically by OutputFileName or by Execute
     Property UnitName : string Read FUnitname Write SetUnitName;
+    // generate constref for [in] parameters instead of delphi compatible VAR, mantis 30764
+    Property InParamRefStyle  : TParamInputRefType read fInParamRefStyle write FInParamRefStyle;
   end;
 
 
@@ -166,7 +175,7 @@ Resourcestring
   SErrInvalidUnitName = 'Invalid unit name : %s';
 
 function ImportTypelib(FileName: WideString;var sUnitName:string;var slDependencies:TStringList;
-  bActiveX,bPackage,bRemoveStructTag:boolean;var sPackageSource,sPackageRegUnitSource:String):string;
+  bActiveX,bPackage,bRemoveStructTag:boolean;var sPackageSource,sPackageRegUnitSource:String;inreftype :TParamInputRefType  = ParamInputVar):string;
 var i:integer;
 begin
   With TTypeLibImporter.Create(Nil) do
@@ -175,11 +184,13 @@ begin
       ActiveX:=bActiveX;
       CreatePackage:=bPackage;
       RemoveStructTag:=bRemoveStructTag;
+      InParamRefStyle :=inreftype;
       Execute;
       Result:=UnitSource.Text;
       sUnitname:=UnitName;
       sPackageSource:=FPackageSource.Text;
       sPackageRegUnitSource:=FPackageRegUnitSource.Text;
+
       if Assigned(slDependencies) then
         begin  //add new dependencies
         for i:=0 to Dependencies.Count-1 do
@@ -643,7 +654,12 @@ begin
             case FD^.lprgelemdescParam[k].paramdesc.wParamFlags and (PARAMFLAG_FIN or PARAMFLAG_FOUT) of
             PARAMFLAG_FIN or PARAMFLAG_FOUT:sPar:='var ';
             PARAMFLAG_FOUT:sPar:='out ';
-            PARAMFLAG_FIN:sPar:='var '; //constref in safecall? TBD
+            PARAMFLAG_NONE,
+            PARAMFLAG_FIN: case FInParamRefStyle of
+                              ParamInputVar             : sPar:='var '; //constref in safecall? TBD
+                              ParamInputConstRef        : sPar:='constref ';
+                              ParamInputConstRefDelphi  : sPar:='const [ref] ';
+                              end;
             end;
           if not MakeValidId(GetName(k+1),sVarName) then
             AddToHeader('//  Warning: renamed parameter ''%s'' in %s.%s to ''%s''',[GetName(k+1),iname,sMethodName,sVarName],True);

utils/importtl/importtl.pas

@@ -3,7 +3,29 @@ program importtl;
 {$mode objfpc}{$H+}
 {$apptype console}
 uses
-  classes,typelib,sysutils;
+  classes,typelib,sysutils,getopts;
+
+var
+  theopts : array[1..2] of TOption;
+
+procedure InitOptions;
+
+begin
+  with theopts[1] do
+   begin
+    name:='ref-style';
+    has_arg:=Required_Argument;
+    flag:=nil;
+    value:=#0;
+  end;
+  with theopts[2] do
+   begin
+    name:='';
+    has_arg:=0;
+    flag:=nil;
+    value:=#0;
+  end;
+end;
 
 var
   unitname,sPackageSource,sPackageRegUnitSource:string;
@@ -11,41 +33,53 @@ var
   F:text;
   slDep:TStringList;
   i:integer;
+  FileName : string;
   bNoRecurse,bHelp,bActiveX,bPackage,bRemoveStructTag:boolean;
+  InRefStyle : TParamInputRefType;
+  optionindex : Longint;
+  c:char;
 begin
+  InitOptions;
   slDep:=TStringList.Create;
   bNoRecurse:=false;
   bHelp:=false;
   bActiveX:=false;
   bPackage:=false;
-  i:=1;
-  while i<=Paramcount do
-    begin
-    if pos('-n',ParamStr(i))>0 then bNoRecurse:=true
-    else if pos('-a',ParamStr(i))>0 then bActiveX:=true
-    else if pos('-h',ParamStr(i))>0 then bHelp:=true
-    else if pos('-p',ParamStr(i))>0 then bPackage:=true
-    else if pos('-t',ParamStr(i))>0 then bRemoveStructTag:=true
-    else if pos('-d',ParamStr(i))>0 then
-      begin
-      sOutDir:=trim(copy(ParamStr(i), pos('-d',ParamStr(i))+2, 260));  // windows MAX_PATH
-      if sOutDir='' then
-        if i<Paramcount-1 then
-          begin
-          i:=i+1;
-          sOutDir:=trim(ParamStr(i));
-          end
-        else
-          begin
-          bHelp:=true;
-          sOutDir:='\';
-          end;
-      if not (sOutDir[length(sOutDir)] in [':','\']) then
-        sOutDir:=sOutDir+'\';
-      end;
-    i:=i+1;
-    end;
-  if bHelp or (Paramcount=0) or (pos('-',paramstr(Paramcount))=1) then
+  InRefStyle:=ParamInputVar;
+
+  repeat
+    c:=getlongopts('ad:hnpt',@theopts[1],optionindex);
+    case c of
+       #0 : begin
+             case optionindex-1 of
+               0 : if lowercase(optarg)='var' then
+                     InRefStyle:=ParamInputVar
+                   else
+                    if lowercase(optarg)='constref' then
+                     InRefStyle:=ParamInputConstRef
+                   else
+                     if lowercase(optarg)='constrefdelphi' then
+                       InRefStyle:=ParamInputConstRefDelphi
+              end;
+           end;
+      'n' : bNoRecurse:=true;
+      'a' : bActiveX:=true;
+      'p' : bPackage:=true;
+      'h' : bHelp:=true;
+      't' : bRemoveStructTag:=true;
+      'd' :  if (length(optarg)>0) and (optarg[1]='-') then
+                bHelp:=true
+              else
+                sOutDir:=IncludeTrailingPathDelimiter(optarg);
+      '?',':' : writeln ('Error parsing option : ',optopt);
+   end; { case }
+ until c=endofoptions;
+
+ FileName:='';
+ if optind=paramcount then
+   FileName:=paramstr(optind);
+
+ if bHelp or (Paramcount=0) or (filename='')then
     begin
     writeln('Usage:  importtl [options] file');
     writeln('Reads type information from "file" and converts it into a freepascal binding');
@@ -58,13 +92,15 @@ begin
     writeln('          dependencies.');
     writeln('  -p    : create lazarus package for ActiveXContainer descendants');
     writeln('  -t    : remove "tag" prefix from structs');
-    exit;
+    writeln('  --ref-style st : input parameter style, parameter st=var,constref');
+    writeln('            or constrefdelphi (= XE3+ const [ref])');
+    halt;
     end;
   slDep.Add(paramstr(Paramcount));
   i:=0;
   repeat
     writeln('Reading typelib from '+slDep[i]+ ' ...');
-    sTL:=ImportTypelib(slDep[i],unitname,slDep,bActiveX,bPackage,bRemoveStructTag,sPackageSource,sPackageRegUnitSource);
+    sTL:=ImportTypelib(slDep[i],unitname,slDep,bActiveX,bPackage,bRemoveStructTag,sPackageSource,sPackageRegUnitSource,InRefStyle);
     unitname:=sOutDir+unitname;
     if (bPackage) and (sPackageSource<>'') then
       begin