Further fixes for gir2pascal instance-parameter

Improved PointerLevel detection
Added IsConst Property to Parameter types



git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2877 8e941d3f-bd1b-0410-a28a-d453659cc2b4

applications/gobject-introspection/gir2pascal.lpr

@@ -214,6 +214,7 @@ begin
     AddOption(['p', 'paths'], True ,'List of paths seperated by ":" to search for needed .gir files.');
     AddOption(['d', 'deprecated'], False, 'Include fields and methods marked as deprecated.');
     AddOption(['t', 'test'], False ,'Creates a test program per unit to verify struct sizes.');
+    AddOption(['P', 'unit-prefix'], True, 'Set a prefix to be added to each unitname.');
   end;
   FCmdOptions.ReadOptions;
   if FCmdOptions.OptionsMalformed then

applications/gobject-introspection/girnamespaces.pas

@@ -471,7 +471,7 @@ begin
   NS := Self;
   // some basic fixes
   PlainCType:=StringReplace(StripPointers(ACType, @PointerLevel), ' ', '_', [rfReplaceAll]);
-  if (PlainCType = 'gchar') or {(PlainCType = 'guchar') or} (PlainCType = 'char') then
+  if (PlainCType = 'gchar') or {(PlainCType = 'guchar') or} (PlainCType = 'char') or (PlainCType = 'const_char') then
     AName := 'GLib.utf8';
 
   if (PlainCType = 'GType')  {or (AName = 'Type')} or (AName = 'GType')then
@@ -497,10 +497,17 @@ begin
   if (Result <> nil) and (Result.ObjectType = otFuzzyType) and (TgirFuzzyType(Result).ResolvedType <> nil) then
     Result := TgirFuzzyType(Result).ResolvedType;
 
+  // if we find a result in another namespace then we need to depend on that namespace/unit
+  if (NS <> nil) and (NS <> Self) and (Result <> nil) then
+    if FRequiredNameSpaces.IndexOf(NS) = -1 then
+      FRequiredNameSpaces.Add(NS);
+
   if (Result = nil) and Not SearchOnly then
       Result := NS.AddFuzzyType(AName, ACType);
   if Result <> nil then
     Result.ImpliedPointerLevel:=PointerLevel;
+
+
 end;
 
 function TgirNamespace.ResolveFuzzyType(AFuzzyType: TgirFuzzyType): TGirBaseType;

applications/gobject-introspection/girobjects.pas

@@ -106,6 +106,7 @@ type
 
   TgirTypeParam = class(TGirBaseType)
   private
+    FIsConst: Boolean;
     FIsInstanceParam: Boolean;
     FVarType: TGirBaseType;
     FPointerLevel: Integer;
@@ -117,6 +118,7 @@ type
     property VarType: TGirBaseType read GetType;
     property PointerLevel: Integer read GetPointerLevel;
     property IsInstanceParam: Boolean read FIsInstanceParam;
+    property IsConst: Boolean read FIsConst;
   end;
 
   { TgirProperty }
@@ -830,6 +832,16 @@ constructor TgirTypeParam.Create(AOwner: TObject; ANode: TDomNode);
         Inc(Result);
   end;
 
+  function AssignC_Type(C_Type: String): String;
+  begin
+    if Pos('const ', C_Type) > 0 then
+    begin
+      FIsConst:=True;
+      Result := Copy(C_Type, 7, Length(C_Type) - 6);
+    end
+    else
+      Result := C_Type;
+  end;
 var
   Node: TDOMElement;
   C_Type: String;
@@ -851,7 +863,8 @@ begin
     case Token of
       gtDoc:;
       gtType:    begin
-                   C_Type := Node.GetAttribute('c:type');
+                   C_Type := AssignC_Type(Node.GetAttribute('c:type'));
+
                    FCType:= C_Type;
                    VarTypeName:=Node.GetAttribute('name');
                    if VarTypeName = '' then
@@ -859,7 +872,7 @@ begin
                    FVarType := TgirNamespace(Owner).LookupTypeByName(VarTypeName, C_Type);
                  end;
       gtArray:   begin
-                   C_Type := Node.GetAttribute('c:type');
+                   C_Type := AssignC_Type(Node.GetAttribute('c:type'));
                    FVarType := TgirNamespace(Owner).LookupTypeByName(TDOMElement(Node.FirstChild).GetAttribute('name'), C_Type);
                    Tmp := Node.GetAttribute('length');
                    if Tmp <> '' then
@@ -945,7 +958,7 @@ var
 
     if AddParam then
     begin
-      girError(geInfo, Format(geAddingErrorNode,[ClassName, CIdentifier]));
+      //girError(geInfo, Format(geAddingErrorNode,[ClassName, CIdentifier]));
       ErrorNode := ParentNode.OwnerDocument.CreateElement('parameter');
       ErrorNode.SetAttribute('name','error');
       TypeNode := ParentNode.OwnerDocument.CreateElement('type');

applications/gobject-introspection/girpascalwritertypes.pas

@@ -1632,13 +1632,32 @@ var
   Code: TPCodeText;
   ResultStr: String = '';
   Args: String;
+  Param: TGirFunctionParam;
 begin
   if AWantSelf then
   begin
-    if (AParams.Count = 0) or ((AParams.Count = 1) and AParams.Param[0].IsInstanceParam) then
+    CallParams := '';
-      CallParams:='@self'
+    // old gir files don't have the instance-param
+    if AParams.Count < 1 then
+      CallParams:='@'
     else
-      CallParams:='@self, ';
+    begin
+      Param := AParams.Param[0];
+      if Param.IsInstanceParam then
+      begin
+        if ((Param.PointerLevel > 0) or (Param.ImpliedPointerLevel > 0))
+        and ((Pos('*', Param.CType)>0) or ((Pos('pointer', Param.CType)>0)))
+        then
+          CallParams:='@'+Param.TranslatedName;
+      end
+      else // old gir files don't have the instance-param
+        CallParams:='@';
+    end;
+
+    if (AParams.Count = 0) or ((AParams.Count = 1) and AParams.Param[0].IsInstanceParam) then
+      CallParams+='self'
+    else
+      CallParams+='self, ';
   end
   else
     CallParams:='';
@@ -1735,6 +1754,13 @@ function TPascalUnit.TypeAsString(AType: TGirBaseType; APointerLevel: Integer; A
 var
   BackupNoPointers: String;
   TranslatedName: String;
+
+  function NameIsPointerType(AName: String): Boolean;
+         begin
+           Result := ((AName = 'gpointer') or(AName = 'gconstpointer'))
+                       and (TranslatedName <> AName)
+                       and (TranslatedName <> '');
+         end;
 begin
   ResolveTypeTranslation(AType);
   TranslatedName := AType.TranslatedName;
@@ -1742,7 +1768,7 @@ begin
   BackupNoPointers := StringReplace(ACTypeAsBackup, '*', '', [rfReplaceAll]);
 
   // some types are pointers but contain no "*" so it thinks it has a pointer level 0 when really it's 1
-  if (APointerLevel = 0) and (ACTypeAsBackup = 'gpointer') and (TranslatedName <> '') and (TranslatedName <> 'gpointer') then
+  if (APointerLevel = 0) and (NameIsPointerType(ACTypeAsBackup)) then
   begin
     APointerLevel := 1;
   end;