* Parse Apple universal interfaces

git-svn-id: trunk@47724 -

packages/fcl-passrc/src/pastree.pp

@@ -120,7 +120,7 @@ type
                         ccMS_ABI_Default,ccMS_ABI_CDecl,
                         ccVectorCall);
   TProcTypeModifier = (ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs,
-                       ptmReferenceTo,ptmAsync,ptmFar);
+                       ptmReferenceTo,ptmAsync,ptmFar,ptmCblock);
   TProcTypeModifiers = set of TProcTypeModifier;
   TPackMode = (pmNone,pmPacked,pmBitPacked);
 
@@ -1770,7 +1770,7 @@ const
                         'MS_ABI_Default','MS_ABI_CDecl',
                         'VectorCall');
   ProcTypeModifiers : Array[TProcTypeModifier] of string =
-      ('of Object', 'is nested','static','varargs','reference to','async','far');
+      ('of Object', 'is nested','static','varargs','reference to','async','far','cblock');
 
   ModifierNames : Array[TProcedureModifier] of string
                 = ('virtual', 'dynamic','abstract', 'override',

packages/fcl-passrc/src/pparser.pp

@@ -1403,6 +1403,11 @@ begin
     Result:=true;
     PTM:=ptmStatic;
     end
+  else if CompareText(S,ProcTypeModifiers[ptmCblock])=0 then
+    begin
+    Result:=true;
+    PTM:=ptmCblock;
+    end
   else if (CompareText(S,ProcTypeModifiers[ptmAsync])=0) and (po_AsyncProcs in Options) then
     begin
     Result:=true;
@@ -4917,6 +4922,21 @@ end;
 
 // Starts after the opening bracket token
 procedure TPasParser.ParseArgList(Parent: TPasElement; Args: TFPList; EndToken: TToken);
+
+  Function GetParamName : string;
+
+  begin
+    if ([msDelphi,msDelphiUnicode,msObjfpc]* CurrentModeswitches)<>[] then
+      Result := ExpectIdentifier
+    else
+      begin
+      NextToken;
+      if CurToken in [tkProperty,tkIdentifier,tkClass] then
+        Result:=CurTokenString
+      else
+        ParseExcTokenError('identifier')
+      end;
+  end;
 var
   IsUntyped, ok, LastHadDefaultValue: Boolean;
   Name : String;
@@ -4925,6 +4945,10 @@ var
   Arg: TPasArgument;
   Access: TArgumentAccess;
   ArgType: TPasType;
+  varargs : boolean;
+
+
+
 begin
   LastHadDefaultValue := false;
   while True do
@@ -4934,22 +4958,38 @@ begin
     IsUntyped := False;
     ArgType := nil;
     NextToken;
-    if CurToken = tkConst then
+    if CurToken = tkDotDotDot then
+    begin
+      varargs:=True;
+      expectToken(endToken);
+      Break;
+    end else  if CurToken = tkConst then
     begin
       Access := argConst;
-      Name := ExpectIdentifier;
+      Name := GetParamName;
     end else if CurToken = tkConstRef then
     begin
       Access := argConstref;
-      Name := ExpectIdentifier;
+      Name := getParamName;
     end else if CurToken = tkVar then
     begin
       Access := ArgVar;
-      Name := ExpectIdentifier;
+      Name:=GetParamName;
     end else if (CurToken = tkIdentifier) and (UpperCase(CurTokenString) = 'OUT') then
     begin
-      Access := ArgOut;
-      Name := ExpectIdentifier;
+      if  ([msObjfpc, msDelphi, msDelphiUnicode, msOut] * CurrentModeswitches)<>[] then
+        begin
+        Access := ArgOut;
+        Name := ExpectIdentifier
+        end
+      else
+        Name := CurTokenString
+    end else if (CurToken = tkproperty) or (CurToken=tkClass) then
+      begin
+      if ([msDelphi,msDelphiUnicode,msObjfpc]* CurrentModeswitches)<>[] then
+        ParseExcTokenError('identifier')
+      else
+        Name := CurTokenString
     end else if CurToken = tkIdentifier then
       Name := CurTokenString
     else

packages/fcl-passrc/src/pscanner.pp

@@ -162,6 +162,8 @@ type
     tkAssignMul,             // *=
     tkAssignDivision,        // /=
     tkAtAt,                  // @@
+    // Three-character tokens
+    tkDotDotDot,             // ... (mac mode)
     // Reserved words
     tkabsolute,
     tkand,
@@ -569,6 +571,10 @@ const
     '0', // false
     '1'  // true  Note: True is <>'0'
     );
+  MACDirectiveBool: array[boolean] of string = (
+    'FALSE', // false
+    'TRUE'  // true  Note: True is <>'0'
+    );
 type
   TMaxPrecInt = {$ifdef fpc}int64{$else}NativeInt{$endif};
   TMaxFloat = {$ifdef fpc}extended{$else}double{$endif};
@@ -628,11 +634,13 @@ type
     procedure Push(const AnOperand: String; OperandPosition: integer);
   public
     Expression: String;
+    MsgCurLine : Integer;
     MsgPos: integer;
     MsgNumber: integer;
     MsgType: TMessageType;
     MsgPattern: String; // Format parameter
-    constructor Create;
+    isMac : Boolean;
+    constructor Create(aIsMac : Boolean = False);
     destructor Destroy; override;
     function Eval(const Expr: string): boolean;
     property OnEvalVariable: TCEEvalVarEvent read FOnEvalVariable write FOnEvalVariable;
@@ -803,8 +811,8 @@ type
     procedure HandleIFDEF(const AParam: String);
     procedure HandleIFNDEF(const AParam: String);
     procedure HandleIFOPT(const AParam: String);
-    procedure HandleIF(const AParam: String);
-    procedure HandleELSEIF(const AParam: String);
+    procedure HandleIF(const AParam: String; aIsMac : Boolean);
+    procedure HandleELSEIF(const AParam: String; aIsMac : Boolean);
     procedure HandleELSE(const AParam: String);
     procedure HandleENDIF(const AParam: String);
     procedure HandleDefine(Param: String); virtual;
@@ -960,6 +968,7 @@ const
     '*=',
     '/=',
     '@@',
+    '...',
     // Reserved words
     'absolute',
     'and',
@@ -1461,12 +1470,16 @@ end;
 function TCondDirectiveEvaluator.IsFalse(const Value: String): boolean;
 begin
   Result:=Value=CondDirectiveBool[false];
+  if (not Result) and isMac then
+    Result:=Value=MacDirectiveBool[false];
 end;
 
 // inline
 function TCondDirectiveEvaluator.IsTrue(const Value: String): boolean;
 begin
   Result:=Value<>CondDirectiveBool[false];
+  if Result and isMac then
+    Result:=Value<>MacDirectiveBool[False];
 end;
 
 function TCondDirectiveEvaluator.IsInteger(const Value: String; out i: TMaxPrecInt
@@ -1786,7 +1799,7 @@ begin
     OnLog(Self,Args);
     if not (aMsgType in [mtError,mtFatal]) then exit;
     end;
-  raise EScannerError.CreateFmt(MsgPattern+' at '+IntToStr(MsgPos),Args);
+  raise EScannerError.CreateFmt(MsgPattern+' at pos '+IntToStr(MsgPos)+' line '+IntToStr(MsgCurLine),Args);
 end;
 
 procedure TCondDirectiveEvaluator.LogXExpectedButTokenFound(const X: String;
@@ -1810,6 +1823,12 @@ procedure TCondDirectiveEvaluator.ReadOperand(Skip: boolean);
    'Abc'
    (expression)
 }
+
+  Function IsMacNoArgFunction(aName : string) : Boolean;
+  begin
+    Result:=SameText(aName,'DEFINED') or SameText(aName,'UNDEFINED');
+  end;
+
 var
   i: TMaxPrecInt;
   e: extended;
@@ -1817,6 +1836,8 @@ var
   Code: integer;
   NameStartP: {$ifdef UsePChar}PChar{$else}integer{$endif};
   p, Lvl: integer;
+  NeedBrace : Boolean;
+
 begin
   {$IFDEF VerbosePasDirectiveEval}
   writeln('TCondDirectiveEvaluator.ReadOperand START Token[',FTokenStart-PChar(Expression)+1,']="',GetTokenString,'" ',FToken,BoolToStr(Skip,' SKIP',''));
@@ -1886,7 +1907,9 @@ begin
     tkIdentifier:
       if Skip then
         begin
+        aName:=GetTokenString;
         NextToken;
+        // for macpas IFC we can have DEFINED A or DEFINED(A)...
         if FToken=tkBraceOpen then
           begin
           // only one parameter is supported
@@ -1896,6 +1919,10 @@ begin
           if FToken<>tkBraceClose then
             LogXExpectedButTokenFound(')');
           NextToken;
+          end
+        else if (IsMac and IsMacNoArgFunction(aName)) then
+          begin
+          NextToken;
           end;
         end
       else
@@ -1926,6 +1953,14 @@ begin
           Push(S,p);
           NextToken;
           end
+        else if (IsMac and IsMacNoArgFunction(aName)) then
+          begin
+          if FToken<>tkIdentifier then
+            LogXExpectedButTokenFound('identifier');
+          aName:=GetTokenString;
+          Push(CondDirectiveBool[OnEvalVariable(Self,aName,S)],p);
+          NextToken;
+          end
         else
           begin
           // variable
@@ -2289,9 +2324,9 @@ begin
   {$ENDIF}
 end;
 
-constructor TCondDirectiveEvaluator.Create;
+constructor TCondDirectiveEvaluator.Create(aIsMac: Boolean);
 begin
-
+  IsMac:=aIsMac
 end;
 
 destructor TCondDirectiveEvaluator.Destroy;
@@ -2315,6 +2350,9 @@ begin
   NextToken;
   ReadExpression;
   Result:=IsTrue(FStack[0].Operand);
+  {$IFDEF VerbosePasDirectiveEval}
+  Writeln('COND Eval: ', Expr,' -> ',Result);
+  {$ENDIF}
 end;
 
 { TMacroDef }
@@ -3631,7 +3669,7 @@ begin
     MValue:=Trim(Param);
     MName:=Trim(Copy(MValue,1,Index-1));
     Delete(MValue,1,Index+1);
-    AddMacro(MName,MValue);
+    AddMacro(MName,Trim(MValue));
     end;
 end;
 
@@ -3964,7 +4002,7 @@ begin
     end;
 end;
 
-procedure TPascalScanner.HandleIF(const AParam: String);
+procedure TPascalScanner.HandleIF(const AParam: String; aIsMac: Boolean);
 
 begin
   PushSkipMode;
@@ -3972,6 +4010,8 @@ begin
     PPSkipMode := ppSkipAll
   else
     begin
+    ConditionEval.MsgCurLine:=CurTokenPos.Row;
+    ConditionEval.isMac:=aIsMac;
     if ConditionEval.Eval(AParam) then
       PPSkipMode := ppSkipElseBranch
     else
@@ -3987,12 +4027,13 @@ begin
     end;
 end;
 
-procedure TPascalScanner.HandleELSEIF(const AParam: String);
+procedure TPascalScanner.HandleELSEIF(const AParam: String; aIsMac : Boolean);
 begin
   if PPSkipStackIndex = 0 then
     Error(nErrInvalidPPElse,sErrInvalidPPElse);
   if PPSkipMode = ppSkipIfBranch then
     begin
+    ConditionEval.isMac:=aIsMac;
     if ConditionEval.Eval(AParam) then
       begin
       PPSkipMode := ppSkipElseBranch;
@@ -4058,7 +4099,11 @@ begin
   Result:=tkComment;
   P:=Pos(' ',ADirectiveText);
   If P=0 then
-    P:=Length(ADirectiveText)+1;
+    begin
+    P:=Pos(#9,ADirectiveText);
+    If P=0 then
+      P:=Length(ADirectiveText)+1;
+    end;
   Directive:=Copy(ADirectiveText,2,P-2); // 1 is $
   Param:=ADirectiveText;
   Delete(Param,1,P);
@@ -4073,12 +4118,16 @@ begin
      HandleIFNDEF(Param);
   'IFOPT':
      HandleIFOPT(Param);
+  'IFC',   
   'IF':
-     HandleIF(Param);
+     HandleIF(Param,UpperCase(Directive)='IFC');
+  'ELIFC',
   'ELSEIF':
-     HandleELSEIF(Param);
+     HandleELSEIF(Param,UpperCase(Directive)='ELIFC');
+  'ELSEC',   
   'ELSE':
      HandleELSE(Param);
+  'ENDC',
   'ENDIF':
     HandleENDIF(Param);
   'IFEND':
@@ -4102,7 +4151,9 @@ begin
       Case UpperCase(Directive) of
       'ASSERTIONS':
         DoBoolDirective(bsAssertions);
-      'DEFINE':
+      'DEFINE',
+      'DEFINEC',
+      'SETC':
         HandleDefine(Param);
       'GOTO':
         DoBoolDirective(bsGoto);
@@ -4163,6 +4214,11 @@ begin
         DoBoolDirective(bsWarnings);
       'WRITEABLECONST':
         DoBoolDirective(bsWriteableConst);
+      'ALIGN',
+      'CALLING',
+      'INLINE',
+      'PACKRECORDS',
+      'PACKENUM' : ;
       else
         Handled:=false;
       end;
@@ -4534,7 +4590,13 @@ begin
       else if {$ifdef UsePChar}FTokenPos[0]='.'{$else}(FTokenPos<=l) and (s[FTokenPos]='.'){$endif} then
         begin
         Inc(FTokenPos);
-        Result := tkDotDot;
+        if {$ifdef UsePChar}FTokenPos[0]='.'{$else}(FTokenPos<=l) and (s[FTokenPos]='.'){$endif} then
+          begin
+          Inc(FTokenPos);
+          Result:=tkDotDotDot;
+          end
+        else  
+          Result := tkDotDot;
         end
       else
         Result := tkDot;
@@ -4932,6 +4994,10 @@ end;
 
 procedure TPascalScanner.OnCondEvalLog(Sender: TCondDirectiveEvaluator;
   Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif});
+
+Var
+  Msg : String;
+
 begin
   {$IFDEF VerbosePasDirectiveEval}
   writeln('TPascalScanner.OnCondEvalLog "',Sender.MsgPattern,'"');
@@ -4940,7 +5006,8 @@ begin
   if Sender.MsgType<=mtError then
     begin
     SetCurMsg(Sender.MsgType,Sender.MsgNumber,Sender.MsgPattern,Args);
-    raise EScannerError.Create(FLastMsg);
+    Msg:=Msg+Format('%s(%d,%d) : %s',[FormatPath(FCurFileName),CurRow,CurColumn,FLastMsg]);
+    raise EScannerError.Create(Msg);
     end
   else
     DoLog(Sender.MsgType,Sender.MsgNumber,Sender.MsgPattern,Args,true);

packages/fcl-passrc/tests/tcpaswritestatements.pas

@@ -2500,7 +2500,7 @@ begin
     AddStatements(['@Proc:=Nil']);
     ParseModule;
     AssertPasWriteOutput('output', BuildString(['program afile;',
-        '', '', 'begin', '  @Proc:=Nil;', 'end.', '']), PasProgram);
+        '', '', 'begin', '  @ Proc := Nil;', 'end.', '']), PasProgram);
 end;
 
 procedure TTestStatementWriterSpecials.TestFinalizationNoSemicolon;
@@ -2585,7 +2585,7 @@ begin
 end;
 
 initialization
-    RegisterTests('TestPassWriter',
+    RegisterTests('TestPasSrcWriter',
         [TTestStatementWriterEmpty, TTestStatementWriterBlock, TTestStatementWriterAssignment,
         TTestStatementWriterCall, TTestStatementWriterIf, TTestStatementWriterCase,
         TTestStatementWriterWith, TTestStatementWriterLoops, TTestStatementWriterRaise,
@@ -2593,733 +2593,3 @@ initialization
 
 end.
 
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

packages/fcl-passrc/tests/tcprocfunc.pas

@@ -518,6 +518,7 @@ end;
 
 procedure TTestProcedureFunction.TestProcedureOneOutArg;
 begin
+  Parser.CurrentModeswitches:=[msObjfpc];
   ParseProcedure('(Out B : Integer)');
   AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argOut,'Integer','');
@@ -525,6 +526,7 @@ end;
 
 procedure TTestProcedureFunction.TestFunctionOneOutArg;
 begin
+  Parser.CurrentModeswitches:=[msObjfpc];
   ParseFunction('(Out B : Integer)');
   AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argOut,'Integer','');

packages/fcl-passrc/tests/tcresolver.pas

@@ -1069,6 +1069,7 @@ begin
   FHub:=TPasResolverHub.Create(Self);
   inherited SetUp;
   Parser.Options:=Parser.Options+[po_ResolveStandardTypes];
+  Parser.CurrentModeswitches:=[msObjfpc];
   Scanner.OnDirective:=@OnScannerDirective;
   Scanner.OnLog:=@OnScannerLog;
 end;
@@ -2195,7 +2196,8 @@ function TCustomTestResolver.AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
 var
   Src: String;
 begin
-  Src:='unit '+ExtractFileUnitName(aFilename)+';'+LineEnding;
+  Src:='{$mode objfpc}';
+  Src+='unit '+ExtractFileUnitName(aFilename)+';'+LineEnding;
   Src+=LineEnding;
   Src+='interface'+LineEnding;
   Src+=LineEnding;

packages/fcl-passrc/tests/tcscanner.pas

@@ -261,6 +261,10 @@ type
     procedure TestIFLesserEqualThan;
     procedure TestIFDefinedElseIf;
     procedure TestIfError;
+    procedure TestIFCDefined;
+    procedure TestIFCNotDefined;
+    procedure TestIFCAndDefined;
+    procedure TestIFCFalse;
     Procedure TestModeSwitch;
     Procedure TestOperatorIdentifier;
     Procedure TestUTF8BOM;
@@ -1834,6 +1838,61 @@ begin
     +'end.',True,False);
 end;
 
+procedure TTestScanner.TestIFCDefined;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  FScanner.AddDefine('cpu32');
+  TestTokens([tkconst,tkIdentifier,tkEqual,tkString,tkSemicolon,tkbegin,tkend,tkDot],
+    'const platform = '+LineEnding
+    +'{$ifc defined cpu32} ''x86'''+LineEnding
+    +'{$elseif defined(cpu64)} 1 '+LineEnding
+    +'{$else} {$error unknown platform} {$endc};'+LineEnding
+    +'begin end.',True,False);
+end;
+
+procedure TTestScanner.TestIFCNotDefined;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  FScanner.AddDefine('cpu32');
+  TestTokens([tkconst,tkIdentifier,tkEqual,tkNumber,tkSemicolon,tkbegin,tkend,tkDot],
+    'const platform = '+LineEnding
+    +'{$ifc not defined cpu32} ''x86'''+LineEnding
+    +'{$else} 1 '+LineEnding
+    +'{$endc};'+LineEnding
+    +'begin end.',True,False);
+end;
+
+procedure TTestScanner.TestIFCAndDefined;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  FScanner.AddDefine('cpu32');
+  FScanner.AddDefine('alpha');
+  TestTokens([tkconst,tkIdentifier,tkEqual,tkstring,tkSemicolon,tkbegin,tkend,tkDot],
+    'const platform = '+LineEnding
+    +'{$ifc defined cpu32 and defined alpha} ''x86'''+LineEnding
+    +'{$else} 1 '+LineEnding
+    +'{$endc};'+LineEnding
+    +'begin end.',True,False);
+end;
+
+procedure TTestScanner.TestIFCFalse;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  FScanner.AddDefine('cpu32');
+  FScanner.AddDefine('alpha');
+  FScanner.AddMacro('MY','FALSE');
+  TestTokens([tkconst,tkIdentifier,tkEqual,tkNumber,tkSemicolon,tkbegin,tkend,tkDot],
+    'const platform = '+LineEnding
+    +'{$IFC MY} ''x86'''+LineEnding
+    +'{$else} 1 '+LineEnding
+    +'{$endc};'+LineEnding
+    +'begin end.',True,False);
+end;
+
 procedure TTestScanner.TestModeSwitch;
 
 Const

packages/fcl-passrc/tests/tctypeparser.pas

@@ -465,6 +465,11 @@ type
     Procedure TestFunctionOneArg;
     Procedure TestFunctionOfObject;
     Procedure TestFunctionOneArgOfObject;
+    Procedure TestCBlock;
+    Procedure TestMacPasoutArg;
+    Procedure TestMacPasPropertyArg;
+    Procedure TestMacPasPropertyVarArg;
+    Procedure TestMacPasClassArg;
   end;
 
 
@@ -1181,6 +1186,48 @@ begin
 
 end;
 
+procedure TTestProcedureTypeParser.TestCBlock;
+
+
+begin
+  ParseType('reference to procedure (a: integer); cblock;',TPasProcedureType,'');
+  FProc:=Definition as TPasProcedureType;
+  AssertEquals('Argument count',1,Proc.Args.Count);
+  AssertEquals('Is cblock',True,ptmCblock in Proc.Modifiers);
+end;
+
+procedure TTestProcedureTypeParser.TestMacPasoutArg;
+begin
+  Parser.CurrentModeswitches:=[msMac];
+  ParseType('procedure (out: integer); ',TPasProcedureType,'');
+  FProc:=Definition as TPasProcedureType;
+  AssertEquals('Argument count',1,Proc.Args.Count);
+end;
+
+procedure TTestProcedureTypeParser.TestMacPasPropertyArg;
+begin
+  Parser.CurrentModeswitches:=[msMac];
+  ParseType('procedure (property : integer); ',TPasProcedureType,'');
+  FProc:=Definition as TPasProcedureType;
+  AssertEquals('Argument count',1,Proc.Args.Count);
+end;
+
+procedure TTestProcedureTypeParser.TestMacPasPropertyVarArg;
+begin
+  Parser.CurrentModeswitches:=[msMac];
+  ParseType('procedure (var property : integer); ',TPasProcedureType,'');
+  FProc:=Definition as TPasProcedureType;
+  AssertEquals('Argument count',1,Proc.Args.Count);
+end;
+
+procedure TTestProcedureTypeParser.TestMacPasClassArg;
+begin
+  Parser.CurrentModeswitches:=[msMac];
+  ParseType('procedure (class : integer); ',TPasProcedureType,'');
+  FProc:=Definition as TPasProcedureType;
+  AssertEquals('Argument count',1,Proc.Args.Count);
+end;
+
 { TTestRecordTypeParser }
 
 function TTestRecordTypeParser.GetC(AIndex: Integer): TPasConst;
@@ -2825,6 +2872,7 @@ begin
   FErrorSource:='';
   FHint:='';
   FType:=Nil;
+  Parser.CurrentModeswitches:=[msObjfpc];
 end;
 
 Procedure TBaseTestTypeParser.TearDown;