diff --git a/bindings/pascocoa/parser/ObjCParserTypes.pas b/bindings/pascocoa/parser/ObjCParserTypes.pas
index a88590953..a20eda4c6 100755
--- a/bindings/pascocoa/parser/ObjCParserTypes.pas
+++ b/bindings/pascocoa/parser/ObjCParserTypes.pas
@@ -145,6 +145,7 @@ type
{ TStructField }
+
TStructField = class(TEntity)
{updated}
protected
@@ -184,7 +185,7 @@ type
{ TTypeDef }
//C token - any type, including unsigned short
- TTypeDefSpecs = set of (td_Unsigned, td_Signed, td_Volitale, td_Const, td_Long, td_Short, td_Char, td_Int);
+ TTypeDefSpecs = set of (td_Unsigned, td_Signed, td_Volitale, td_Const, td_InOut, td_Long, td_Short, td_Char, td_Int);
{updated}
TTypeDef = class(TEntity)
@@ -206,8 +207,8 @@ type
function DoParse(AParser: TTextParser): Boolean; override;
public
_Inherited : AnsiString;
- _Type : TEntity;
_TypeName : AnsiString;
+ _Type : TEntity;
end;
{ TObjCParameterDef }
@@ -316,8 +317,59 @@ function CToPascalNumeric(const Cnum: AnsiString): AnsiString;
function IsTypePointer(AType: TEntity; DefResult: Boolean ): Boolean;
function ErrExpectStr(const Expected, Found: AnsiString): AnsiString;
+function IsTypeOrTypeDef(const Token: AnsiString): Boolean;
+
+function ParseTypeOrTypeDef(AParser: TTextParser; Owner: TEntity; var Ent: TEntity): Boolean;
+
+function IsTypeDefEntity(Ent: TEntity): Boolean;
+function isEmptyStruct(AStruct: TStructTypeDef): Boolean;
+
implementation
+function IsTypeDefEntity(Ent: TEntity): Boolean;
+begin
+ Result := (Ent is TTypeDef) or (Ent is TStructTypeDef)
+ or (Ent is TUnionTypeDef) or (Ent is TTypeNameDef) or (Ent is TEnumTypeDef);
+end;
+
+function IsTypeOrTypeDef(const Token: AnsiString): Boolean;
+begin
+ Result := false;
+ if Token = '' then Exit;
+ case Token[1] of
+ 't': Result := Token = 'typedef';
+ 'e': Result := Token = 'enum';
+ 's': Result := Token = 'struct';
+ 'u': Result := Token = 'union';
+ end;
+end;
+
+function ParseTypeOrTypeDef(AParser: TTextParser; Owner: TEntity; var Ent: TEntity): Boolean;
+var
+ s : AnsiString;
+ tt : TTokenType;
+begin
+ AParser.FindNextToken(s, tt);
+ Result := (tt = tt_Ident) and IsTypeOrTypeDef(s);
+ if (not Result) then begin
+ AParser.Index := AParser.TokenPos;
+ Exit;
+ end;
+
+ if s = 'typedef' then begin
+ AParser.Index := AParser.TokenPos;
+ Ent := TTypeNameDef.Create(Owner);
+ Result := Ent.Parse(AParser);
+ end else begin
+ AParser.Index := AParser.TokenPos;
+ Ent := ParseTypeDef(Owner, AParser);
+ Result := Assigned(ent);
+ AParser.FindNextToken(s, tt);
+ Result := (tt=tt_Symbol) and (s = ';');
+ end;
+
+end;
+
// isPointer returned the * is declared
// isPointerRef return the ** is declared
procedure ParsePointerDef(AParser: TTextParser; var isPointer, isPointerRef: Boolean);
@@ -840,6 +892,7 @@ var
tt : TTokenType;
cnt : Integer;
mtd : TClassMethodDef;
+ ent : TEntity;
begin
Result := false;
AParser.FindNextToken(s, tt);
@@ -893,7 +946,13 @@ begin
mtd := TClassMethodDef.Create(Self);
mtd.Parse(AParser);
Items.Add(mtd);
+ end else if IsTypeOrTypeDef(s) then begin
+ AParser.Index := AParser.TokenPos;
+ if ParseTypeOrTypeDef(AParser, Self, ent) then
+ Items.Add(ent);
+ //AParser.FindNextToken(s, tt);
end;
+
end;
until (s = '@end') or (s = ''); // looking for declaration end
Result := true;
@@ -1041,23 +1100,6 @@ end;
{ TResultTypeDef }
-const
- TypeDefReserved : array [0..1] of AnsiString = (
- 'unsigned', 'const'
- );
-
-function IsTypeDefReserved(const s: AnsiString): Boolean;
-var
- i : integer;
-begin
- Result := false;
- for i := 0 to length(TypeDefReserved) - 1 do
- if TypeDefReserved[i] = s then begin
- Result := true;
- Exit;
- end;
-end;
-
function TObjCResultTypeDef.DoParse(AParser: TTextParser): Boolean;
var
s : AnsiString;
@@ -1336,13 +1378,12 @@ begin
AParser.SetError( ErrExpectStr('Type name identifier', _TypeName) );
Exit;
end;
- _inherited := GetTypeNameFromEntity(_Type);
+ _inherited := GetTypeNameFromEntity( _Type );
AParser.FindNextToken(s, tt); // skip last ';';
Result := true;
end;
-
{ TStructTypeDef }
function TStructTypeDef.DoParse(AParser: TTextParser): Boolean;
@@ -1464,10 +1505,10 @@ begin
Result := true;
if (s = 'volitle') then begin
SpecVal := [td_Volitale];
- SpecMask := [td_Volitale, td_Const];
+ SpecMask := [td_Volitale];
end else if (s = 'const') then begin
- SpecVal := [td_Volitale];
- SpecMask := [td_Volitale, td_Const];
+ SpecVal := [td_Const];
+ SpecMask := [td_InOut, td_Const];
end else if (s = 'signed') then begin
SpecVal := [td_Signed];
SpecMask := [td_Signed, td_Unsigned];
@@ -1486,6 +1527,9 @@ begin
end else if (s = 'int') then begin
SpecVal := [td_Int];
SpecMask := [td_Int];
+ end else if (s = 'inout') then begin
+ SpecVal := [td_inout];
+ SpecMask := [td_inout, td_const];
end else
Result := false;
end;
@@ -1617,4 +1661,18 @@ begin
//ie: struct POINT {int x; int y} point;
end;
+function isEmptyStruct(AStruct: TStructTypeDef): Boolean;
+var
+ i : integer;
+begin
+ for i := 0 to AStruct.Items.Count - 1 do
+ if TEntity(AStruct.Items[i]) is TStructField then begin
+ Result := false;
+ Exit;
+ end;
+ Result := true;
+end;
+
+
+
end.
diff --git a/bindings/pascocoa/parser/ObjCParserUtils.pas b/bindings/pascocoa/parser/ObjCParserUtils.pas
index 92287becc..33fe85be2 100755
--- a/bindings/pascocoa/parser/ObjCParserUtils.pas
+++ b/bindings/pascocoa/parser/ObjCParserUtils.pas
@@ -116,12 +116,14 @@ begin
end;
end;
+
+// 'result' is considered reserved word!
function IsPascalReserved(const s: AnsiString): Boolean;
var
ls : AnsiString;
begin
- //todo: a hash table should be used?
- Result := true;
+ //todo: a hash table should be used!
+ Result := false;
if s = '' then Exit;
ls := AnsiLowerCase(s);
case ls[1] of
@@ -142,7 +144,7 @@ begin
'p':
Result := (ls = 'packed') or (ls = 'popstack') or (ls = 'private') or (ls = 'procedure') or (ls = 'program') or (ls = 'property')
or (ls = 'protected') or (ls = 'public');
- 'r': Result := (ls = 'raise') or (ls = 'record') or (ls = 'reintroduce') or (ls = 'repeat');
+ 'r': Result := (ls = 'raise') or (ls = 'record') or (ls = 'reintroduce') or (ls = 'repeat') or (ls = 'result');
's': Result := (ls = 'self') or (ls = 'set') or (ls = 'shl') or (ls = 'shr') or (ls = 'stdcall') or (ls = 'string');
't': Result := (ls = 'then') or (ls = 'to') or (ls = 'true') or (ls = 'try') or (ls = 'type');
'u': Result := (ls = 'unimplemented') or (ls = 'unit') or (ls = 'until') or (ls = 'uses');
@@ -876,12 +878,15 @@ var
s : AnsiString;
begin
i := subs.Count;
-
- WriteOutRecord(struct, Prefix, RecPrefix, subs);
- s := subs[i];
- Delete(s, 1, length(Prefix));
- s := Prefix + struct._Name + ' = ' + s;
- subs[i] := s;
+ if not isEmptyStruct(struct) then begin
+ WriteOutRecord(struct, Prefix, RecPrefix, subs);
+ s := subs[i];
+ Delete(s, 1, length(Prefix));
+ s := Prefix + struct._Name + ' = ' + s;
+ subs[i] := s;
+ end else begin
+ subs.Add(Prefix + struct._Name + ' = Pointer;');
+ end;
end;
function WriteOutTypeDefName(const NewType, FromType: AnsiSTring; isPointer: Boolean): AnsiString;
@@ -1410,7 +1415,8 @@ begin
if res._IsClassMethod then res._Name := res._Name + '_'
else if mtd._IsClassMethod then mtd._Name := mtd._Name + '_';
end;
- if IsPascalReserved(mtd._Name) then mtd._Name := mtd._Name + '_';
+ if IsPascalReserved(mtd._Name) then
+ mtd._Name := mtd._Name + '_';
end;
finally
mtdnames.Free;
@@ -1418,10 +1424,74 @@ begin
//nothing todo...
end;
-procedure AppleHeaderFix(ent : TEntity);
+procedure FastPack(Items: TList);
+var
+ i, j : INteger;
+begin
+ j := 0;
+ for i := 0 to Items.Count - 1 do
+ if Assigned(Items[i]) then begin
+ Items[j] := Items[i];
+ inc(j);
+ end;
+ Items.Count := j;
+end;
+
+procedure FixObjCClassTypeDef(ent: TEntity);
var
i : Integer;
j : Integer;
+ cl : TClassDef;
+begin
+ for i := 0 to ent.Items.Count - 1 do begin
+ if not (TObject(ent.Items[i]) is TClassDef) then Continue;
+ cl := TClassDef(ent.Items[i]);
+ for j := 0 to cl.Items.Count - 1 do begin
+ if not IsTypeDefEntity(cl.Items[j]) then Continue;
+ ent.Items.Add(cl.Items[j]);
+ TEntity(cl.Items[j]).Owner := ent;
+ cl.Items[j] := nil;
+ end;
+ end;
+ FastPack(ent.Items);
+end;
+
+procedure FixEmptyStruct(var ent: TEntity);
+var
+ i : Integer;
+ td : TTypeDef;
+ dis : TEntity;
+begin
+(*
+ if not Assigned(ent) then Exit;
+
+ if (ent is TStructTypeDef) and isEmptyStruct(TStructTypeDef(ent) ) then begin
+ td := TTypeDef.Create(ent.Owner);
+ td._Name := TStructTypeDef(ent)._Name;
+ //td._IsPointer := true;
+ for i := 0 to ent.Items.Count - 1 do begin
+ td.Items.Add(ent.Items[i]);
+ TEntity(ent.Items[i]).Owner := td;
+ end;
+ dis := ent;
+ ent := td;
+ dis.Free;
+ end;
+
+ for i := 0 to ent.Items.Count - 1 do begin
+ dis := TEntity(ent.Items[i]);
+ FixEmptyStruct(dis);
+ ent.Items[i] := dis;
+ end;
+*)
+ //hack and work-around :(
+ {if ent is TTypeNameDef then
+ FixEmptyStruct( TTypeNameDef(ent)._Type);}
+end;
+
+procedure AppleHeaderFix(ent : TEntity);
+var
+ i : Integer;
obj : TEntity;
begin
// i := 0;
@@ -1447,17 +1517,12 @@ begin
end;
// packing list, removing nil references.
- j := 0;
- for i := 0 to ent.Items.Count - 1 do
- if Assigned(ent.Items[i]) then begin
- ent.Items[j] := ent.Items[i];
- inc(j);
- end;
- ent.Items.Count := j;
+ FastPack(ent.Items);
+ FixObjCClassTypeDef(ent);
+ FixEmptyStruct(ent);
- for i := 0 to ent.Items.Count - 1 do begin
+ for i := 0 to ent.Items.Count - 1 do
AppleHeaderFix( TEntity(ent.Items[i]));
- end;
end;
diff --git a/bindings/pascocoa/parser/objcparser.lpi b/bindings/pascocoa/parser/objcparser.lpi
index 941d3fa9d..f04054d9b 100755
--- a/bindings/pascocoa/parser/objcparser.lpi
+++ b/bindings/pascocoa/parser/objcparser.lpi
@@ -13,7 +13,7 @@
-
+
@@ -35,28 +35,28 @@
-
+
-
+
-
-
+
+
-
+
-
-
+
+
-
+
@@ -67,50 +67,50 @@
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
@@ -119,165 +119,194 @@
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/bindings/pascocoa/parser/objcparser.pas b/bindings/pascocoa/parser/objcparser.pas
index ecfacee14..f2a33b674 100755
--- a/bindings/pascocoa/parser/objcparser.pas
+++ b/bindings/pascocoa/parser/objcparser.pas
@@ -303,8 +303,9 @@ end;
var
inpf : AnsiString = '';
st : TStrings = nil;
- i : integer;
err : AnsiString = '';
+ i : integer;
+
begin
try
GetConvertSettings(ConvertSettings, inpf);