paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Further fixes for gir2pascal instance-parameter

Browse Source 
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
This commit is contained in:
drewski207 2014-01-06 04:39:27 +00:00
parent ba51e1b8d9
commit ae7df38f31
4 changed files with 55 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
applications/gobject-introspection/gir2pascal.lpr
View File

@ -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

9
applications/gobject-introspection/girnamespaces.pas
View File

@ -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;

19
applications/gobject-introspection/girobjects.pas
View File

@ -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');

34
applications/gobject-introspection/girpascalwritertypes.pas
View File

@ -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:='@self'
CallParams := '';
// 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;