fixed on usage msgSend function for parametered functions; fix for returning structures as a result

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

bindings/pascocoa/parser/ObjCParserTypes.pas

@@ -294,6 +294,17 @@ type
 
   { TClassDef }
   
+  { TClassesForward }
+
+  TClassesForward = class(TEntity)
+  protected
+    function DoParse(AParser: TTextParser): Boolean; override;
+  public
+    _Classes    : TStringList;
+    constructor Create(AOwner: TEntity);
+    destructor Destroy; override;
+  end;
+
   TClassDef = class(TEntity)
   protected
     function DoParse(AParser: TTextParser): Boolean; override;
@@ -953,7 +964,7 @@ var
 begin
   Result := false;
   AParser.FindNextToken(s, tt);
-  if s <> '@interface' then begin
+  if s <> '@interface'  then begin
     AParser.SetError(ErrExpectStr('@interface', s));
     Exit;
   end;
@@ -1040,10 +1051,20 @@ begin
       ent := TEnumTypeDef.Create(Self);
       if not ent.Parse(AParser) then Exit;
       AParser.FindNextToken(s, tt); // skipping last ';'
+    end else if s = 'struct' then begin
+      APArser.index := APArser.TokenPos;
+      ent := TStructTypeDef.Create(SElf);
+      if not ent.Parse(AParser) then Exit;
+      AParser.FindNextToken(s, tt); //? skipping last ';'?
+      if s <> ';' then AParser.Index := AParser.TokenPos;
     end else if s = '@interface' then begin
       AParser.Index := AParser.TokenPos;
       ent := TClassDef.Create(Self);
       if not ent.Parse(AParser) then Exit;
+    end else if s = '@class' then begin
+      AParser.Index := AParser.TokenPos;
+      ent := TClassesForward.create(Self);
+      if not ent.Parse(AParser) then Exit;
     end else begin
       // anything else is skipped, though should not!
       ent := TSkip.Create(Self);
@@ -1924,4 +1945,37 @@ begin
   end;
 end;
 
+{ TClassesForward }
+
+function TClassesForward.DoParse(AParser: TTextParser): Boolean;
+var
+  s   : AnsiString;
+  tt  : TTokenType;
+begin
+  AParser.FindNextToken(s, tt);
+  if s <> '@class' then begin
+    AParser.SetError( ErrExpectStr('@class', s));
+    Exit;
+  end;
+
+  while s <> ';' do begin
+    AParser.FindNextToken(s, tt);
+    if tt = tt_Ident then
+      _Classes.Add(s);
+  end;
+  Result := true;
+end;
+
+constructor TClassesForward.Create(AOwner: TEntity);
+begin
+  inherited Create(AOwner);
+  _Classes:=TStringList.Create;
+end;
+
+destructor TClassesForward.Destroy;
+begin
+  _Classes.Free;
+  inherited Destroy;
+end;
+
 end.

bindings/pascocoa/parser/ObjCParserUtils.pas

@@ -219,7 +219,7 @@ begin
         tp := TTypeDef(TObjCParameterDef(p)._Type._Type);
         vtype := ObjCToDelphiType(tp._Name, tp._IsPointer);
       end else begin
-        prc := 'TProc' + TObjCParameterDef(p)._Name + IntToStr(ConvertSettings.CustomTypes.Count);
+        prc := 'TProc' + TClassDef(m.Owner)._ClassName + TObjCParameterDef(p)._Name + IntToStr(ConvertSettings.CustomTypes.Count);
         ConvertSettings.AssignNewTypeName(prc, CToDelphiFuncType(TFunctionTypeDef(TObjCParameterDef(p)._Type._Type)), vtype);
         tp := TTypeDef.Create(TObjCParameterDef(p)._Type);
         tp._Name := vtype;
@@ -361,9 +361,9 @@ begin
   for i := 0 to mtd.Items.Count - 1 do begin
     obj := mtd.Items[i];
     if not Assigned(obj) then Continue;
-    if obj is TParamDescr then
+    if obj is TParamDescr then begin
-      Result := Result + TParamDescr(obj)._Descr
+      Result := Result + TParamDescr(obj)._Descr;
-    else if obj is TObjCParameterDef then
+    end else if obj is TObjCParameterDef then
       Result := Result + '_';
   end;
   i := length(Result);
@@ -1295,19 +1295,27 @@ const
   MtdPrefix = 'TMtd_';
   MtdPostfix = '';
 
-procedure ObjCMethodToProcType(mtd: TClassMethodDef; var typeName: AnsiString; subs: TStrings);
+procedure ObjCMethodToProcType(mtd: TClassMethodDef; var typeName: AnsiString; subs: TStrings; isResultStruct: Boolean);
 var
   s   : AnsiString;
   ms  : AnsiString;
   restype : AnsiString;
 begin
-  typeName := MtdPrefix + mtd._Name + MtdPostFix;
+  //typeName := MtdPrefix + mtd._Name + MtdPostFix;
+  typeName := 'TmsgSendWrapper';
+  
   subs.Add('type');
   ms := GetMethodParams(mtd, false);
   if ms = '' then ms := 'param1: objc.id; param2: SEL'
   else ms := 'param1: objc.id; param2: SEL' + ';' + ms;
-  restype := GetMethodResultType(mtd);
+
-  if IsMethodConstructor(mtd.Owner as TClassDef, mtd) then restype := 'objc.id';
+  if isResultStruct then begin
+    restype := '';
+    ms := 'result_param: Pointer; ' + ms;
+  end else begin
+    restype := GetMethodResultType(mtd);
+    if IsMethodConstructor(mtd.Owner as TClassDef, mtd) then restype := 'objc.id';
+  end;
 
   s := Format('  %s = %s cdecl;',[typeName, GetProcFuncHead('', '', ms, restype, '' )]);
   subs.Add(s);
@@ -1356,7 +1364,7 @@ var
   prms  : AnsiString;
 begin
   cl  := TClassDef(mtd.Owner);
-  ObjCMethodToProcType(mtd, typeName, subs);
+  ObjCMethodToProcType(mtd, typeName, subs, false);
   prms := GetMethodParams(mtd, true);
   if prms <> '' then prms := ', ' + prms;
 
@@ -1402,6 +1410,7 @@ var
   res       : AnsiString;
   callobj   : AnsiString;
   mnm       : AnsiString;
+  prms      : AnsiString;
 begin
   cl := TClassDef(mtd.Owner);
   callobj := ClassMethodCaller[mtd._IsClassMethod];
@@ -1410,10 +1419,11 @@ begin
   mnm := RefixName(mtd._Name);
   //s := Format('vmethod(%s, sel_registerName(PChar(Str%s_%s)), %s)', [callobj, cl._ClassName, RefixName(mtd._Name), GetParamsNames(mtd)]);
   tp := GetObjCVarType(res);
+  prms := GetMethodParams(mtd, true);
   case tp of
-    vt_Int, vt_Object: s := Format('objc_msgSend(%s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
+    vt_Int, vt_Object: s := Format('vmethod(%s, sel_registerName(PChar(Str%s_%s)), %s)', [callobj, cl._ClassName, mnm, prms]);
-    vt_FloatPoint: s := Format('objc_msgSend_fpret(%s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
+    vt_FloatPoint: s := Format('vmethod(%s, sel_registerName(PChar(Str%s_%s)), %s)', [callobj, cl._ClassName, mnm, prms]);
-    vt_Struct: s := Format('objc_msgSend_stret(@Result, %s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
+    vt_Struct: s := Format('vmethod(@Result, %s, sel_registerName(PChar(Str%s_%s)), %s)', [callobj, cl._ClassName, mnm, prms]);
   end;
 
   if (tp <> vt_Struct) and (ObjCResultToDelphiType(mtd.GetResultType) <> '') then begin
@@ -1425,13 +1435,17 @@ begin
   end;
   
 
-  ObjCMethodToProcType(mtd, typeName, subs);
+  ObjCMethodToProcType(mtd, typeName, subs, tp=vt_Struct);
   subs.Add('var');
   subs.Add(
     Format('  vmethod: %s;', [typeName]));
   subs.Add('begin');
-  subs.Add(
+  case tp of
-    Format('  vmethod := %s(@objc_msgSend);', [typeName]));
+    vt_Struct:     subs.Add(Format('  vmethod := %s(@objc_msgSend_fpret);', [typeName]));
+    vt_FloatPoint: subs.Add(Format('  vmethod := %s(@objc_msgSend_stret);', [typeName]));
+  else
+    subs.Add( Format('  vmethod := %s(@objc_msgSend);', [typeName]));
+  end;
   subs.Add(
     Format('  %s;', [s]));
   subs.Add('end;');
@@ -1452,41 +1466,28 @@ begin
   res := GetMethodResultType(mtd);
   tp := GetObjCVarType(res);
 
-{  if tp = vt_Object then begin
+  mnm := RefixName(mtd._Name);
-    subs.Add('var');
+  case tp of
-    subs.Add('  hnd: objc.id;');
+    vt_Int, vt_Object:
-    subs.Add('begin');
+      s := Format('objc_msgSend(%s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
-    subs.Add('  hnd := ' + Format('objc_msgSend(%s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, RefixName(mtd._Name) ]));
+    vt_FloatPoint:
-    subs.Add('  if Assigned(hnd) then begin ');
+      s := Format('objc_msgSend_fpret(%s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
-    subs.Add('    Result := ' + Format('%s.Create; ', [res]) );
+    vt_Struct:
-    subs.Add('    Result.Handle := hnd;');
+      s := Format('objc_msgSend_stret(@Result, %s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
-    subs.Add('  end else');
+  end;
-    subs.Add('    Result := nil;');
-    subs.Add('end;');
-  end else begin}
   
-    mnm := RefixName(mtd._Name);
+  if (tp <> vt_Struct) and (res <> '') then begin
-    case tp of
+    if tp <> vt_FloatPoint then
-      vt_Int, vt_Object: s := Format('objc_msgSend(%s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
+      s := Format('Result := %s(%s)', [res, s])
-      vt_FloatPoint: s := Format('objc_msgSend_fpret(%s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
+    else
-      vt_Struct: s := Format('objc_msgSend_stret(@Result, %s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
+      s := Format('Result := %s', [s]);
-    end;
+  end;
+  s := s + ';';
 
-    if (tp <> vt_Struct) and (res <> '') then begin
+  subs.Add('begin');
-      if tp <> vt_FloatPoint then
+  subs.Add('  ' + s);
-        s := Format('Result := %s(%s)', [res, s])
+  subs.Add('end;');
-      else
-        s := Format('Result := %s', [s]);
-      //s := 'Result := '+res+'('+s+')';
-      //if res = 'objc.id' then s := 'Result := ' +s
-      //else
-    end;
-    s := s + ';';
 
-    subs.Add('begin');
-    subs.Add('  ' + s);
-    subs.Add('end;');
- // end;
 end;
 
 procedure WriteOutMethodToImplementation(mtd: TClassMethodDef; subs: TStrings);
@@ -1683,6 +1684,7 @@ end;
 procedure AppleHeaderFix(ent : TEntity);
 var
   i   : Integer;
+  j   : Integer;
   obj : TEntity;
   prm : TObjCParameterDef;
   res : TObjCResultTypeDef;
@@ -1701,9 +1703,9 @@ begin
     end else if (obj is TClassDef) and ((TClassDef(obj)._Category = '') and (TClassDef(obj)._ClassName = 'NSObject')) then begin
       if TClassDef(obj)._SuperClass = '' then
         TClassDef(obj)._SuperClass := 'TObject'
-    end else if (obj is TParamDescr) then begin
+    {end else if (obj is TParamDescr) then begin
       if IsPascalReserved(TParamDescr(obj)._Descr) then
-        TParamDescr(obj)._Descr := '_'+TParamDescr(obj)._Descr
+        TParamDescr(obj)._Descr := '_'+TParamDescr(obj)._Descr}
     end else if (obj is TClassMethodDef) and not IsMethodConstructor(TClassDef(obj.Owner ), TClassMethodDef(obj)) then begin
       res := TClassMethodDef(obj).GetResultType;
       if ConvertSettings.ObjCClassTypes.IndexOf( ObjCResultToDelphiType(res))>= 0 then
@@ -1729,6 +1731,9 @@ begin
       if ConvertSettings.ObjCClassTypes.IndexOf(TStructField(obj)._TypeName) >= 0 then begin
         TStructField(obj)._TypeName := 'objc.id'
       end;
+    end else if (obj is TClassesForward) then begin
+      for j := 0 to TClassesForward(obj)._Classes.Count - 1 do
+        ConvertSettings.ObjCClassTypes.Add( TClassesForward(obj)._Classes[j]);
     end;
 
     
@@ -1774,12 +1779,31 @@ var
   cl      : TClassDef;
   subs    : TStringList;
   consts  : TStringList;
+  used    : TStringList;
 begin
   subs := TStringList.Create;
   consts := TStringList.Create;
   try
     st.AddStrings(ConvertSettings.ConvertPrefix);
 
+    used := TStringList.Create;
+    try
+      for i := 0 to hdr.Items.Count - 1 do begin
+        if (TObject(hdr.Items[i]) is TClassDef) then begin
+          cl := TClassDef(hdr.Items[i]);
+          if (cl._Category = '') then begin
+            WriteOutClassToConsts(cl, subs, consts);
+            used.Add(cl._ClassName);
+          end else if used.IndexOf(cl._Classname) >= 0 then begin
+            WriteOutClassToConsts(cl, subs, consts);
+          end;
+        end;
+      end;
+    finally
+      used.Free;
+      used := nil;
+    end;
+
     if hdr.Items.Count <= 0 then Exit;
     AppleHeaderFix(hdr);
 
@@ -1793,17 +1817,10 @@ begin
       hdr.Items.Delete(0);
     end;
 
-    for i := 0 to hdr.Items.Count - 1 do begin
-      if (TObject(hdr.Items[i]) is TClassDef) then begin
-        cl := TClassDef(hdr.Items[i]);
-        WriteOutClassToConsts(cl, subs, consts);
-      end;
-    end;
 
     WriteOutHeaderSection(hdr, st);
     WriteOutForwardSection(hdr, st);
 
-
     for i := 0 to hdr.Items.Count - 1 do
       if TObject(hdr.Items[i]) is TClassDef then
         FixAppleClassDef(TClassDef(hdr.Items[i]));

bindings/pascocoa/parser/default.ini

@@ -1,5 +1,5 @@
 [common]
-ignoreincludes0=CoreFoundation/ Foundation/
+ignoreincludes0=CoreFoundation/ 
 ignoreincludes1=setjmp.h stdarg.h stdbool.h limits.h stdarg.h
 ignoreincludes2=AvailabilityMacros.h 
 ignoreincludes3=ApplicationServices/ 
@@ -7,6 +7,7 @@ ignoreincludes4=ApplicationServices/../FrameWorks/CoreGraphics.framework/Headers
 ignoreincludes5=AvailabilityMacros.h
 
 [TypeReplace]
+NSRect=CGRect
 NSStringRef=CFStringRef
 NSStringRef*=CFStringRef
 NSArray=CFArrayRef
@@ -65,7 +66,7 @@ CGSize=struct
 CGPoint=struct
 CFTimeInterval=float
 CGAffineTransform=struct
-  
+NSRect=struct  
 NSPoint=struct
 NSSize=struct
 NSRange=struct

bindings/pascocoa/parser/objcparser.lpi

@@ -36,7 +36,7 @@
         <Filename Value="objcparser.pas"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="objcparser"/>
-        <CursorPos X="69" Y="3"/>
+        <CursorPos X="45" Y="11"/>
         <TopLine Value="1"/>
         <EditorIndex Value="0"/>
         <UsageCount Value="26"/>
@@ -45,8 +45,8 @@
       <Unit1>
         <Filename Value="ObjCParserUtils.pas"/>
         <UnitName Value="ObjCParserUtils"/>
-        <CursorPos X="44" Y="1705"/>
+        <CursorPos X="13" Y="1305"/>
-        <TopLine Value="1703"/>
+        <TopLine Value="1293"/>
         <EditorIndex Value="1"/>
         <UsageCount Value="13"/>
         <Loaded Value="True"/>
@@ -54,22 +54,58 @@
       <Unit2>
         <Filename Value="ObjCParserTypes.pas"/>
         <UnitName Value="ObjCParserTypes"/>
-        <CursorPos X="30" Y="85"/>
+        <CursorPos X="18" Y="1966"/>
-        <TopLine Value="64"/>
+        <TopLine Value="1950"/>
         <EditorIndex Value="2"/>
         <UsageCount Value="13"/>
         <Loaded Value="True"/>
       </Unit2>
     </Units>
-    <JumpHistory Count="2" HistoryIndex="1">
+    <JumpHistory Count="11" HistoryIndex="10">
       <Position1>
         <Filename Value="ObjCParserUtils.pas"/>
-        <Caret Line="1708" Column="49" TopLine="1699"/>
+        <Caret Line="1772" Column="46" TopLine="1769"/>
       </Position1>
       <Position2>
         <Filename Value="ObjCParserUtils.pas"/>
-        <Caret Line="1707" Column="93" TopLine="1694"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
       </Position2>
+      <Position3>
+        <Filename Value="ObjCParserUtils.pas"/>
+        <Caret Line="64" Column="85" TopLine="52"/>
+      </Position3>
+      <Position4>
+        <Filename Value="ObjCParserUtils.pas"/>
+        <Caret Line="89" Column="42" TopLine="77"/>
+      </Position4>
+      <Position5>
+        <Filename Value="ObjCParserUtils.pas"/>
+        <Caret Line="91" Column="39" TopLine="79"/>
+      </Position5>
+      <Position6>
+        <Filename Value="ObjCParserUtils.pas"/>
+        <Caret Line="98" Column="39" TopLine="86"/>
+      </Position6>
+      <Position7>
+        <Filename Value="ObjCParserUtils.pas"/>
+        <Caret Line="101" Column="32" TopLine="89"/>
+      </Position7>
+      <Position8>
+        <Filename Value="ObjCParserUtils.pas"/>
+        <Caret Line="106" Column="49" TopLine="94"/>
+      </Position8>
+      <Position9>
+        <Filename Value="ObjCParserUtils.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position9>
+      <Position10>
+        <Filename Value="ObjCParserUtils.pas"/>
+        <Caret Line="1365" Column="15" TopLine="1361"/>
+      </Position10>
+      <Position11>
+        <Filename Value="ObjCParserUtils.pas"/>
+        <Caret Line="1306" Column="3" TopLine="1295"/>
+      </Position11>
     </JumpHistory>
   </ProjectOptions>
   <CompilerOptions>