* Tests for procedure/function declarations, fixes in parsing of those

git-svn-id: trunk@22157 -

.gitattributes

@@ -2333,6 +2333,7 @@ packages/fcl-passrc/tests/tcclasstype.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcexprparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcmoduleparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tconstparser.pas svneol=native#text/plain
+packages/fcl-passrc/tests/tcprocfunc.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcscanner.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcstatements.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tctypeparser.pas svneol=native#text/plain

packages/fcl-passrc/examples/test_parser.pp

@@ -1157,7 +1157,7 @@ procedure GetTypes(pe:TPasElement; lindent:integer);
           begin
            pv:=TPasVariant(prct.Variants[i]);
            write(s1,pv.Name);
-           for k:=0 to pv.Values.Count-1 do write(pv.Values[k]);
+           for k:=0 to pv.Values.Count-1 do write(TPasElement(pv.Values[k]).GetDeclaration(true));
            write(': (');
            if GetVariantRecord(TPasElement(pv.Members),j+1) then
              writeln(s1,');')
@@ -1245,7 +1245,7 @@ procedure GetTypes(pe:TPasElement; lindent:integer);
           begin
            pv:=TPasVariant(prct.Variants[i]);
            write(s2,pv.Name);
-           for k:=0 to pv.Values.Count-1 do write(pv.Values[k]);
+           for k:=0 to pv.Values.Count-1 do write(TPasElement(pv.Values[k]).GetDeclaration(true));
            write(': (');
            if GetVariantRecord(TPasElement(pv.Members),j+2) then
              writeln(s2,');')

packages/fcl-passrc/src/pastree.pp

@@ -692,11 +692,11 @@ type
   end;
 
   TProcedureModifier = (pmVirtual, pmDynamic, pmAbstract, pmOverride,
-                        pmExported, pmOverload, pmMessage, pmReintroduce,
+                        pmExport, pmOverload, pmMessage, pmReintroduce,
                         pmStatic,pmInline,pmAssembler,pmVarargs, pmPublic,
                         pmCompilerProc,pmExternal,pmForward);
   TProcedureModifiers = Set of TProcedureModifier;
-  TProcedureMessageType = (pmtInteger,pmtString);
+  TProcedureMessageType = (pmtNone,pmtInteger,pmtString);
                         
   TProcedureBody = class;
 
@@ -705,6 +705,7 @@ type
     FModifiers : TProcedureModifiers;
     FMessageName : String;
     FMessageType : TProcedureMessageType;
+    FPublicName: String;
     function GetCallingConvention: TCallingConvention;
     procedure SetCallingConvention(AValue: TCallingConvention);
   public
@@ -716,6 +717,9 @@ type
   public
     ProcType : TPasProcedureType;
     Body : TProcedureBody;
+    PublicName,
+    LibrarySymbolName,
+    LibraryExpr : TPasExpr;
     Procedure AddModifier(AModifier : TProcedureModifier);
     Function IsVirtual : Boolean;
     Function IsDynamic : Boolean;
@@ -735,10 +739,13 @@ type
   end;
 
   TPasFunction = class(TPasProcedure)
+  private
+    function GetFT: TPasFunctionType;
   public
     function ElementTypeName: string; override;
     function TypeName: string; override;
     function GetDeclaration (full : boolean) : string; override;
+    Property FuncType : TPasFunctionType Read GetFT;
   end;
 
   { TPasOperator }
@@ -1138,6 +1145,11 @@ const
   cCallingConventions : array[TCallingConvention] of string =
       ( '', 'Register','Pascal','CDecl','StdCall','OldFPCCall','SafeCall');
 
+  ModifierNames : Array[TProcedureModifier] of string
+                = ('virtual', 'dynamic','abstract', 'override',
+                   'export', 'overload', 'message', 'reintroduce',
+                   'static','inline','assembler','varargs', 'public',
+                   'compilerproc','external','forward');
 
 implementation
 
@@ -1317,6 +1329,12 @@ function TPasConst.ElementTypeName: string; begin Result := SPasTreeConst end;
 function TPasProperty.ElementTypeName: string; begin Result := SPasTreeProperty end;
 function TPasOverloadedProc.ElementTypeName: string; begin Result := SPasTreeOverloadedProcedure end;
 function TPasProcedure.ElementTypeName: string; begin Result := SPasTreeProcedure end;
+
+function TPasFunction.GetFT: TPasFunctionType;
+begin
+  Result:=ProcType as TPasFunctionType;
+end;
+
 function TPasFunction.ElementTypeName: string; begin Result := SPasTreeFunction end;
 function TPasClassProcedure.ElementTypeName: string; begin Result := SPasTreeClassProcedure; end;
 function TPasClassFunction.ElementTypeName: string; begin Result := SPasTreeClassFunction; end;
@@ -1821,6 +1839,9 @@ begin
     ProcType.Release;
   if Assigned(Body) then
     Body.Release;
+  FreeAndNil(PublicName);
+  FreeAndNil(LibraryExpr);
+  FreeAndNil(LibrarySymbolName);
   inherited Destroy;
 end;
 
@@ -2579,7 +2600,7 @@ end;
 
 Function TPasProcedure.IsExported : Boolean;
 begin
-  Result:=pmExported in FModifiers;
+  Result:=pmExport in FModifiers;
 end;
 
 function TPasProcedure.IsExternal: Boolean;

packages/fcl-passrc/src/pparser.pp

@@ -30,6 +30,7 @@ resourcestring
   SParserErrorAtToken = '%s at token "%s" in file %s at line %d column %d';
   SParserUngetTokenError = 'Internal error: Cannot unget more tokens, history buffer is full';
   SParserExpectTokenError = 'Expected "%s"';
+  SParserForwardNotInterface = 'The use of a FORWARD procedure modifier is not allowed in the interface';
   SParserExpectVisibility = 'Expected visibility specifier';
   SParserStrangeVisibility = 'Strange strict visibility encountered : "%s"';
   SParserExpectToken2Error = 'Expected "%s" or "%s"';
@@ -306,12 +307,6 @@ end;
 
 Function IsModifier(S : String; Out Pm : TProcedureModifier) : Boolean;
 
-Const
-  ModifierNames : Array[TProcedureModifier] of string
-                = ('virtual', 'dynamic','abstract', 'override',
-                   'exported', 'overload', 'message', 'reintroduce',
-                   'static','inline','assembler','varargs', 'public',
-                   'compilerproc','external','forward');
 
 Var
   P : TProcedureModifier;
@@ -660,7 +655,7 @@ end;
 function TPasParser.TokenIsProcedureModifier(Parent : TPasElement; S: String; out Pm: TProcedureModifier): Boolean;
 begin
   Result:=IsModifier(S,PM);
-  if result and (pm=pmPublic)then
+  if result and (pm in [pmPublic,pmForward]) then
     begin
     While (Parent<>Nil) and Not (Parent is TPasClassType) do
      Parent:=Parent.Parent;
@@ -2553,26 +2548,42 @@ procedure TPasParser.HandleProcedureModifier(Parent: TPasElement;pm : TProcedure
 
 Var
   Tok : String;
+  P : TPasProcedure;
+  E : TPasExpr;
 
 begin
   if parent is TPasProcedure then
-    TPasProcedure(Parent).AddModifier(pm);
+    P:=TPasProcedure(Parent);
+  if Assigned(P) then
+    P.AddModifier(pm);
   if (pm=pmExternal) then
     begin
     NextToken;
     if CurToken in [tkString,tkIdentifier] then
       begin
-      NextToken;
+      // extrenal libname
+      // external libname name XYZ
+      // external name XYZ
+      Tok:=UpperCase(CurTokenString);
+      if Not ((curtoken=tkIdentifier) and (Tok='NAME')) then
+        begin
+        E:=DoParseExpression(Parent);
+        if Assigned(P) then
+          P.LibraryExpr:=E;
+        end;
       if CurToken=tkSemicolon then
         UnGetToken
       else
         begin
         Tok:=UpperCase(CurTokenString);
-        if Tok='NAME' then
+        if ((curtoken=tkIdentifier) and (Tok='NAME')) then
           begin
           NextToken;
           if not (CurToken in [tkString,tkIdentifier]) then
             ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkString]]));
+          E:=DoParseExpression(Parent);
+          if Assigned(P) then
+            P.LibrarySymbolName:=E;
           end;
         end;
       end
@@ -2593,13 +2604,20 @@ begin
     else
       begin
       NextToken;  // Should be export name string.
-      ExpectToken(tkSemicolon);
+      if not (CurToken in [tkString,tkIdentifier]) then
+        ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkString]]));
+      E:=DoParseExpression(Parent);
+      if parent is TPasProcedure then
+        TPasProcedure(Parent).PublicName:=E;
+      if (CurToken <> tkSemicolon) then
+        ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkSemicolon]]));
       end;
     end
-  else if pm=pmForward then
+  else if (pm=pmForward) then
     begin
     if (Parent.Parent is TInterfaceSection) then
        begin
+       ParseExc(SParserForwardNotInterface);
        UngetToken;
        end;
     end

packages/fcl-passrc/tests/tcbaseparser.pas

@@ -40,6 +40,7 @@ Type
     FIsUnit : Boolean;
     FImplementation : Boolean;
     FEndSource: Boolean;
+    FUseImplementation: Boolean;
     function GetPL: TPasLibrary;
     function GetPP: TPasProgram;
   protected
@@ -70,6 +71,7 @@ Type
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureModifier); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureModifiers); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TAssignKind); overload;
+    Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureMessageType); overload;
     Procedure HaveHint(AHint : TPasMemberHint; AHints : TPasMemberHints);
     Property Resolver : TStreamResolver Read FResolver;
     Property Scanner : TPascalScanner Read FScanner;
@@ -82,7 +84,7 @@ Type
     Property Definition : TPasElement Read FDefinition Write FDefinition;
     // If set, Will be freed in teardown
     Property ParseResult : TPasElement Read FParseResult Write FParseResult;
-
+    Property UseImplementation : Boolean Read FUseImplementation Write FUseImplementation;
   end;
 
 implementation
@@ -232,9 +234,18 @@ procedure TTestParser.StartImplementation;
 begin
   if Not FImplementation then
     begin
-    Add('');
-    Add('Implementation');
-    Add('');
+    if UseImplementation then
+      begin
+      FSource.Insert(0,'');
+      FSource.Insert(0,'Implementation');
+      FSource.Insert(0,'');
+      end
+    else
+      begin
+      Add('');
+      Add('Implementation');
+      Add('');
+      end;
     FImplementation:=True;
     end;
 end;
@@ -269,14 +280,20 @@ end;
 
 procedure TTestParser.ParseDeclarations;
 begin
+  if UseImplementation then
+    StartImplementation;
   FSource.Insert(0,'');
   FSource.Insert(0,'interface');
   FSource.Insert(0,'');
   FSource.Insert(0,'unit afile;');
-  StartImplementation;
+  if Not UseImplementation then
+    StartImplementation;
   EndSource;
   ParseModule;
-  FDeclarations:=Module.InterfaceSection;
+  if UseImplementation then
+    FDeclarations:=Module.ImplementationSection
+  else
+    FDeclarations:=Module.InterfaceSection;
 end;
 
 procedure TTestParser.ParseModule;
@@ -446,6 +463,13 @@ begin
                    GetEnumName(TypeInfo(TAssignKind),Ord(AActual)));
 end;
 
+procedure TTestParser.AssertEquals(const Msg: String; AExpected,
+  AActual: TProcedureMessageType);
+begin
+  AssertEquals(Msg,GetEnumName(TypeInfo(TProcedureMessageType),Ord(AExpected)),
+                   GetEnumName(TypeInfo(TProcedureMessageType),Ord(AActual)));
+end;
+
 procedure TTestParser.HaveHint(AHint: TPasMemberHint; AHints: TPasMemberHints);
 begin
   If not (AHint in AHints) then

packages/fcl-passrc/tests/tcclasstype.pas

@@ -92,6 +92,8 @@ type
     Procedure TestMethodOverloadVisibility;
     Procedure TestMethodHint;
     Procedure TestMethodVirtualHint;
+    Procedure TestIntegerMessageMethod;
+    Procedure TestStringMessageMethod;
     Procedure Test2Methods;
     Procedure Test2MethodsDifferentVisibility;
     Procedure TestPropertyRedeclare;
@@ -717,6 +719,28 @@ begin
   AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
 end;
 
+procedure TTestClassType.TestIntegerMessageMethod;
+begin
+  AddMember('Procedure DoSomething(A : Integer) message 123');
+  ParseClass;
+  DefaultMethod;
+  AssertEquals('Default visibility',visDefault,Method1.Visibility);
+  AssertEquals('No modifiers',[pmMessage],Method1.Modifiers);
+  AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
+  AssertEquals('Message name','123',Method1.MessageName);
+end;
+
+procedure TTestClassType.TestStringMessageMethod;
+begin
+  AddMember('Procedure DoSomething(A : Integer) message ''aha''');
+  ParseClass;
+  DefaultMethod;
+  AssertEquals('Default visibility',visDefault,Method1.Visibility);
+  AssertEquals('No modifiers',[pmMessage],Method1.Modifiers);
+  AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
+  AssertEquals('Message name','''aha''',Method1.MessageName);
+end;
+
 procedure TTestClassType.Test2Methods;
 begin
   AddMember('Procedure DoSomething(A : Integer) virtual');

packages/fcl-passrc/tests/tcprocfunc.pas

@@ -0,0 +1,1121 @@
+unit tcprocfunc;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, typinfo, fpcunit, pastree, pscanner, pparser, tcbaseparser,testregistry;
+
+type
+
+  { TTestProcedureFunction }
+
+  TTestProcedureFunction= class(TTestParser)
+  private
+    FFunc: TPasFunction;
+    FHint: String;
+    FProc: TPasProcedure;
+    procedure AddDeclaration(const ASource: string; const AHint: String='');
+    procedure AssertArg(ProcType: TPasProcedureType; AIndex: Integer;
+      AName: String; AAccess: TArgumentAccess; const TypeName: String;
+      AValue: String='');
+    procedure AssertArrayArg(ProcType: TPasProcedureType; AIndex: Integer;
+      AName: String; AAccess: TArgumentAccess; const ElementTypeName: String);
+    procedure AssertFunc(Mods: TProcedureModifiers; CC: TCallingConvention; ArgCount: Integer; P: TPasFunction=nil);
+    procedure AssertProc(Mods: TProcedureModifiers; CC: TCallingConvention; ArgCount: Integer; P: TPasProcedure=nil);
+    function BaseAssertArg(ProcType: TPasProcedureType; AIndex: Integer;
+      AName: String; AAccess: TArgumentAccess; AValue: String=''): TPasArgument;
+    function GetFT: TPasFunctionType;
+    function GetPT: TPasProcedureType;
+    Procedure ParseProcedure;
+    function ParseProcedure(const ASource: string; const AHint: String=''): TPasProcedure;
+    Procedure ParseFunction;
+    function ParseFunction(const ASource : String; AResult: string = ''; const AHint: String=''; CC : TCallingConvention = ccDefault): TPasProcedure;
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    Property Hint : String Read FHint Write FHint;
+    Property Proc : TPasProcedure Read FProc;
+    Property ProcType : TPasProcedureType Read GetPT;
+    Property Func : TPasFunction Read FFunc;
+    Property FuncType : TPasFunctionType Read GetFT;
+  published
+    procedure TestEmptyProcedure;
+    Procedure TestEmptyFunction;
+    procedure TestEmptyProcedureDeprecated;
+    Procedure TestEmptyFunctionDeprecated;
+    procedure TestEmptyProcedurePlatform;
+    Procedure TestEmptyFunctionPlatform;
+    procedure TestEmptyProcedureExperimental;
+    Procedure TestEmptyFunctionExperimental;
+    procedure TestEmptyProcedureUnimplemented;
+    Procedure TestEmptyFunctionUnimplemented;
+    procedure TestProcedureOneArg;
+    Procedure TestFunctionOneArg;
+    procedure TestProcedureOneVarArg;
+    Procedure TestFunctionOneVarArg;
+    procedure TestProcedureOneConstArg;
+    Procedure TestFunctionOneConstArg;
+    procedure TestProcedureOneOutArg;
+    Procedure TestFunctionOneOutArg;
+    procedure TestProcedureOneConstRefArg;
+    Procedure TestFunctionOneConstRefArg;
+    procedure TestProcedureTwoArgs;
+    Procedure TestFunctionTwoArgs;
+    procedure TestProcedureTwoArgsSeparate;
+    Procedure TestFunctionTwoArgsSeparate;
+    procedure TestProcedureOneArgDefault;
+    Procedure TestFunctionOneArgDefault;
+    procedure TestProcedureOneArgDefaultSet;
+    Procedure TestFunctionOneArgDefaultSet;
+    procedure TestProcedureOneArgDefaultExpr;
+    Procedure TestFunctionOneArgDefaultExpr;
+    procedure TestProcedureTwoArgsDefault;
+    Procedure TestFunctionTwoArgsDefault;
+    procedure TestProcedureOneUntypedVarArg;
+    Procedure TestFunctionOneUntypedVarArg;
+    procedure TestProcedureTwoUntypedVarArgs;
+    Procedure TestFunctionTwoUntypedVarArgs;
+    procedure TestProcedureOneUntypedConstArg;
+    Procedure TestFunctionOneUntypedConstArg;
+    procedure TestProcedureTwoUntypedConstArgs;
+    Procedure TestFunctionTwoUntypedConstArgs;
+    procedure TestProcedureOpenArrayArg;
+    Procedure TestFunctionOpenArrayArg;
+    procedure TestProcedureTwoOpenArrayArgs;
+    Procedure TestFunctionTwoOpenArrayArgs;
+    procedure TestProcedureConstOpenArrayArg;
+    Procedure TestFunctionConstOpenArrayArg;
+    procedure TestProcedureVarOpenArrayArg;
+    Procedure TestFunctionVarOpenArrayArg;
+    procedure TestProcedureArrayOfConstArg;
+    Procedure TestFunctionArrayOfConstArg;
+    procedure TestProcedureConstArrayOfConstArg;
+    Procedure TestFunctionConstArrayOfConstArg;
+    Procedure TestProcedureCdecl;
+    Procedure TestFunctionCdecl;
+    Procedure TestProcedureCdeclDeprecated;
+    Procedure TestFunctionCdeclDeprecated;
+    Procedure TestProcedureSafeCall;
+    Procedure TestFunctionSafeCall;
+    //ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,ccOldFPCCall,ccSafeCall);
+    Procedure TestProcedurePascal;
+    Procedure TestFunctionPascal;
+    Procedure TestProcedureStdCall;
+    Procedure TestFunctionStdCall;
+    Procedure TestProcedureOldFPCCall;
+    Procedure TestFunctionOldFPCCall;
+    Procedure TestProcedurePublic;
+    Procedure TestProcedurePublicIdent;
+    Procedure TestFunctionPublic;
+    Procedure TestProcedureCdeclPublic;
+    Procedure TestFunctionCdeclPublic;
+    Procedure TestProcedureOverload;
+    Procedure TestFunctionOverload;
+    Procedure TestProcedureVarargs;
+    Procedure TestFunctionVarArgs;
+    Procedure TestProcedureCDeclVarargs;
+    Procedure TestFunctionCDeclVarArgs;
+    Procedure TestProcedureForwardInterface;
+    Procedure TestFunctionForwardInterface;
+    Procedure TestProcedureForward;
+    Procedure TestFunctionForward;
+    Procedure TestProcedureCdeclForward;
+    Procedure TestFunctionCDeclForward;
+    Procedure TestProcedureCompilerProc;
+    Procedure TestFunctionCompilerProc;
+    Procedure TestProcedureCDeclCompilerProc;
+    Procedure TestFunctionCDeclCompilerProc;
+    Procedure TestProcedureAssembler;
+    Procedure TestFunctionAssembler;
+    Procedure TestProcedureCDeclAssembler;
+    Procedure TestFunctionCDeclAssembler;
+    Procedure TestProcedureExport;
+    Procedure TestFunctionExport;
+    Procedure TestProcedureCDeclExport;
+    Procedure TestFunctionCDeclExport;
+    Procedure TestProcedureExternal;
+    Procedure TestFunctionExternal;
+    Procedure TestProcedureExternalLibName;
+    Procedure TestFunctionExternalLibName;
+    Procedure TestProcedureExternalLibNameName;
+    Procedure TestFunctionExternalLibNameName;
+    Procedure TestProcedureExternalName;
+    Procedure TestFunctionExternalName;
+    Procedure TestProcedureCdeclExternal;
+    Procedure TestFunctionCdeclExternal;
+    Procedure TestProcedureCdeclExternalLibName;
+    Procedure TestFunctionCdeclExternalLibName;
+    Procedure TestProcedureCdeclExternalLibNameName;
+    Procedure TestFunctionCdeclExternalLibNameName;
+    Procedure TestProcedureCdeclExternalName;
+    Procedure TestFunctionCdeclExternalName;
+  end;
+
+implementation
+
+
+procedure TTestProcedureFunction.AddDeclaration(Const ASource : string; Const AHint : String = '');
+
+Var
+  D : String;
+begin
+  Hint:=AHint;
+  D:=ASource;
+  If Hint<>'' then
+    D:=D+' '+Hint;
+  if (D[Length(D)]<>';') then
+    D:=D+';';
+  Add(D);
+end;
+
+function TTestProcedureFunction.GetPT: TPasProcedureType;
+begin
+  AssertNotNull('have procedure to get type from',Proc);
+  Result:=Proc.ProcType;
+end;
+
+Function TTestProcedureFunction.ParseProcedure(Const ASource : string; Const AHint : String = '') : TPasProcedure;
+
+
+begin
+  AddDeclaration('procedure A '+ASource,AHint);
+  Self.ParseProcedure;
+  Result:=Fproc;
+end;
+
+procedure TTestProcedureFunction.ParseProcedure;
+
+begin
+  //  Writeln(source.text);
+  ParseDeclarations;
+  AssertEquals('One variable definition',1,Declarations.Functions.Count);
+  AssertEquals('First declaration is procedure declaration.',TPasProcedure,TObject(Declarations.Functions[0]).ClassType);
+  FProc:=TPasProcedure(Declarations.Functions[0]);
+  Definition:=FProc;
+  AssertEquals('First declaration has correct name.','A',FProc.Name);
+  if (Hint<>'') then
+    CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'h'+Hint)));
+end;
+
+function TTestProcedureFunction.ParseFunction(const ASource : String;AResult: string = ''; const AHint: String = ''; CC : TCallingConvention = ccDefault): TPasProcedure;
+Var
+  D :String;
+begin
+  if (AResult='') then
+    AResult:='Integer';
+  D:='Function A '+ASource+' : '+AResult;
+  If (cc<>ccDefault) then
+    D:=D+'; '+cCallingConventions[cc]+';';
+  AddDeclaration(D,AHint);
+  Self.ParseFunction;
+  Result:=FFunc;
+  AssertNotNull('Have function result element',FuncType.ResultEl);
+  AssertNotNull('Have function result type element',FuncType.ResultEl.ResultType);
+  AssertEquals('Correct function result type name',AResult,FuncType.ResultEl.ResultType.Name);
+end;
+
+procedure TTestProcedureFunction.ParseFunction;
+begin
+  //  Writeln(source.text);
+  ParseDeclarations;
+  AssertEquals('One variable definition',1,Declarations.Functions.Count);
+  AssertEquals('First declaration is function declaration.',TPasFunction,TObject(Declarations.Functions[0]).ClassType);
+  FFunc:=TPasFunction(Declarations.Functions[0]);
+  Definition:=FFunc;
+  AssertEquals('First declaration has correct name.','A',FFunc.Name);
+  if (Hint<>'') then
+    CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'h'+Hint)));
+end;
+
+procedure TTestProcedureFunction.AssertProc(Mods : TProcedureModifiers; CC : TCallingConvention; ArgCount : Integer; P : TPasProcedure = Nil);
+
+begin
+  If P=Nil then
+    P:=Proc;
+  AssertNotNull('No proc to assert',P);
+  AssertEquals('Procedure modifiers',Mods,P.Modifiers);
+  AssertEquals('Procedue calling convention',CC,P.CallingConvention);
+  AssertEquals('No message name','',p.MessageName);
+  AssertEquals('No message type',pmtNone,P.MessageType);
+  AssertNotNull('Have procedure type to assert',P.ProcType);
+  AssertEquals('Correct number of arguments',ArgCount,P.ProcType.Args.Count);
+  AssertEquals('Not of object',False,P.ProcType.IsOfObject);
+  AssertEquals('Not is nested',False,P.ProcType.IsNested);
+end;
+
+procedure TTestProcedureFunction.AssertFunc(Mods : TProcedureModifiers; CC : TCallingConvention; ArgCount : Integer; P : TPasFunction = Nil);
+
+begin
+  If P=Nil then
+    P:=Func;
+  AssertNotNull('No func to assert',P);
+  AssertEquals('Procedure modifiers',Mods,P.Modifiers);
+  AssertEquals('Procedue calling convention',CC,P.CallingConvention);
+  AssertEquals('No message name','',p.MessageName);
+  AssertEquals('No message type',pmtNone,P.MessageType);
+  AssertNotNull('Have procedure type to assert',P.ProcType);
+  AssertEquals('Correct number of arguments',ArgCount,P.ProcType.Args.Count);
+  AssertEquals('Not of object',False,P.ProcType.IsOfObject);
+  AssertEquals('Not is nested',False,P.ProcType.IsNested);
+end;
+
+Function TTestProcedureFunction.BaseAssertArg(ProcType : TPasProcedureType; AIndex : Integer; AName : String; AAccess : TArgumentAccess; AValue : String='') : TPasArgument;
+
+Var
+  A : TPasArgument;
+  N : String;
+
+begin
+  AssertNotNull('Have proctype to test argument',ProcType);
+  if AIndex>=Proctype.Args.Count then
+    Fail(Format('Cannot test argument: index %d is larger than the number of arguments (%d).',[AIndex,Proctype.Args.Count]));
+  AssertNotNull('Have argument at position '+IntToStr(AIndex),Proctype.Args[AIndex]);
+  AssertEquals('Have argument type at position '+IntToStr(AIndex),TPasArgument,TObject(Proctype.Args[AIndex]).ClassType);
+  N:='Argument '+IntToStr(AIndex+1)+' : ';
+  A:=TPasArgument(Proctype.Args[AIndex]);
+  AssertEquals(N+'Argument name',AName,A.Name);
+  AssertEquals(N+'Argument access',AAccess,A.Access);
+  if (AValue='') then
+    AssertNull(N+' no default value',A.ValueExpr)
+  else
+    begin
+    AssertNotNull(N+' Have default value',A.ValueExpr);
+    AssertEquals(N+' Default value',AValue,A.Value);
+    end;
+  Result:=A;
+end;
+
+procedure TTestProcedureFunction.AssertArg(ProcType : TPasProcedureType; AIndex : Integer; AName : String; AAccess : TArgumentAccess; Const TypeName : String; AValue : String='');
+
+Var
+  A : TPasArgument;
+  N : String;
+
+begin
+  A:=BaseAssertArg(ProcType,AIndex,ANAme,AAccess,AValue);
+  N:='Argument '+IntToStr(AIndex+1)+' : ';
+  if (TypeName='') then
+    AssertNull(N+' No argument type',A.ArgType)
+  else
+    begin
+    AssertNotNull(N+' Have argument type',A.ArgType);
+    AssertEquals(N+' Correct argument type name',TypeName,A.ArgType.Name);
+    end;
+end;
+
+procedure TTestProcedureFunction.AssertArrayArg(ProcType: TPasProcedureType;
+  AIndex: Integer; AName: String; AAccess: TArgumentAccess;
+  const ElementTypeName: String);
+Var
+  A : TPasArgument;
+  AT : TPasArrayType;
+  N : String;
+
+begin
+  A:=BaseAssertArg(ProcType,AIndex,ANAme,AAccess,'');
+  N:='Argument '+IntToStr(AIndex+1)+' : ';
+  AssertNotNull(N+' Have argument type',A.ArgType);
+  AssertEquals(N+' is arrayType',TPasArrayType,A.ArgType.ClassType);
+  AT:=TPasArrayType(A.ArgType);
+  if (ElementTypeName='') then
+    AssertNull(N+' No array element type',AT.ElType)
+  else
+    begin
+    AssertNotNull(N+' Have array element type',AT.ElType);
+    AssertEquals(N+' Correct array element type name',ElementTypeName,AT.ElType.Name);
+    end;
+end;
+
+function TTestProcedureFunction.GetFT: TPasFunctionType;
+begin
+  AssertNotNull('have function to get type from',Func);
+  AssertEquals('Function type is correct type',TPasFunctionType,Func.ProcType.ClassType);
+  Result:=Func.FuncType;
+end;
+
+//TProcedureMessageType
+
+procedure TTestProcedureFunction.TestEmptyProcedure;
+begin
+  ParseProcedure('');
+  AssertProc([],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestEmptyFunction;
+begin
+  ParseFunction('');
+  AssertFunc([],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestEmptyProcedureDeprecated;
+begin
+  ParseProcedure('','deprecated');
+  AssertProc([],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestEmptyFunctionDeprecated;
+begin
+  ParseFunction('','deprecated');
+  AssertFunc([],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestEmptyProcedurePlatform;
+begin
+  ParseProcedure('','platform');
+  AssertProc([],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestEmptyFunctionPlatform;
+begin
+  ParseFunction('','platform');
+  AssertFunc([],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestEmptyProcedureExperimental;
+begin
+  ParseProcedure('','experimental');
+  AssertProc([],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestEmptyFunctionExperimental;
+begin
+  ParseFunction('','experimental');
+  AssertFunc([],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestEmptyProcedureUnimplemented;
+begin
+  ParseProcedure('','unimplemented');
+  AssertProc([],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestEmptyFunctionUnimplemented;
+begin
+  ParseFunction('','unimplemented');
+  AssertFunc([],ccDefault,0);
+
+end;
+
+
+
+procedure TTestProcedureFunction.TestProcedureOneArg;
+begin
+  ParseProcedure('(B : Integer)');
+  AssertProc([],ccDefault,1);
+  AssertArg(ProcType,0,'B',argDefault,'Integer','');
+end;
+
+procedure TTestProcedureFunction.TestFunctionOneArg;
+begin
+  ParseFunction('(B : Integer)');
+  AssertFunc([],ccDefault,1);
+  AssertArg(FuncType,0,'B',argDefault,'Integer','');
+end;
+
+procedure TTestProcedureFunction.TestProcedureOneVarArg;
+begin
+  ParseProcedure('(Var B : Integer)');
+  AssertProc([],ccDefault,1);
+  AssertArg(ProcType,0,'B',argVar,'Integer','');
+end;
+
+procedure TTestProcedureFunction.TestFunctionOneVarArg;
+begin
+  ParseFunction('(Var B : Integer)');
+  AssertFunc([],ccDefault,1);
+  AssertArg(FuncType,0,'B',argVar,'Integer','');
+end;
+
+procedure TTestProcedureFunction.TestProcedureOneConstArg;
+begin
+  ParseProcedure('(Const B : Integer)');
+  AssertProc([],ccDefault,1);
+  AssertArg(ProcType,0,'B',argConst,'Integer','');
+end;
+
+procedure TTestProcedureFunction.TestFunctionOneConstArg;
+begin
+  ParseFunction('(Const B : Integer)');
+  AssertFunc([],ccDefault,1);
+  AssertArg(FuncType,0,'B',argConst,'Integer','');
+end;
+
+procedure TTestProcedureFunction.TestProcedureOneOutArg;
+begin
+  ParseProcedure('(Out B : Integer)');
+  AssertProc([],ccDefault,1);
+  AssertArg(ProcType,0,'B',argOut,'Integer','');
+end;
+
+procedure TTestProcedureFunction.TestFunctionOneOutArg;
+begin
+  ParseFunction('(Out B : Integer)');
+  AssertFunc([],ccDefault,1);
+  AssertArg(FuncType,0,'B',argOut,'Integer','');
+end;
+
+procedure TTestProcedureFunction.TestProcedureOneConstRefArg;
+begin
+  ParseProcedure('(Constref B : Integer)');
+  AssertProc([],ccDefault,1);
+  AssertArg(ProcType,0,'B',argConstRef,'Integer','');
+end;
+
+procedure TTestProcedureFunction.TestFunctionOneConstRefArg;
+begin
+  ParseFunction('(ConstRef B : Integer)');
+  AssertFunc([],ccDefault,1);
+  AssertArg(FuncType,0,'B',argConstref,'Integer','');
+end;
+
+procedure TTestProcedureFunction.TestProcedureTwoArgs;
+begin
+  ParseProcedure('(B,C : Integer)');
+  AssertProc([],ccDefault,2);
+  AssertArg(ProcType,0,'B',argDefault,'Integer','');
+  AssertArg(ProcType,1,'C',argDefault,'Integer','');
+end;
+
+procedure TTestProcedureFunction.TestFunctionTwoArgs;
+begin
+  ParseFunction('(B,C : Integer)');
+  AssertFunc([],ccDefault,2);
+  AssertArg(FuncType,0,'B',argDefault,'Integer','');
+  AssertArg(FuncType,1,'C',argDefault,'Integer','');
+end;
+
+procedure TTestProcedureFunction.TestProcedureTwoArgsSeparate;
+begin
+  ParseProcedure('(B : Integer; C : Integer)');
+  AssertProc([],ccDefault,2);
+  AssertArg(ProcType,0,'B',argDefault,'Integer','');
+  AssertArg(ProcType,1,'C',argDefault,'Integer','');
+end;
+
+procedure TTestProcedureFunction.TestFunctionTwoArgsSeparate;
+begin
+  ParseFunction('(B : Integer;C : Integer)');
+  AssertFunc([],ccDefault,2);
+  AssertArg(FuncType,0,'B',argDefault,'Integer','');
+  AssertArg(FuncType,1,'C',argDefault,'Integer','');
+end;
+
+procedure TTestProcedureFunction.TestProcedureOneArgDefault;
+begin
+  ParseProcedure('(B : Integer = 1)');
+  AssertProc([],ccDefault,1);
+  AssertArg(ProcType,0,'B',argDefault,'Integer','1');
+end;
+
+procedure TTestProcedureFunction.TestFunctionOneArgDefault;
+begin
+  ParseFunction('(B : Integer = 1)');
+  AssertFunc([],ccDefault,1);
+  AssertArg(FuncType,0,'B',argDefault,'Integer','1');
+end;
+
+procedure TTestProcedureFunction.TestProcedureOneArgDefaultSet;
+begin
+  ParseProcedure('(B : MySet = [1,2])');
+  AssertProc([],ccDefault,1);
+  AssertArg(ProcType,0,'B',argDefault,'MySet','[1, 2]');
+end;
+
+procedure TTestProcedureFunction.TestFunctionOneArgDefaultSet;
+begin
+  ParseFunction('(B : MySet = [1,2])');
+  AssertFunc([],ccDefault,1);
+  AssertArg(FuncType,0,'B',argDefault,'MySet','[1, 2]');
+end;
+
+procedure TTestProcedureFunction.TestProcedureOneArgDefaultExpr;
+begin
+  ParseProcedure('(B : Integer = 1 + 2)');
+  AssertProc([],ccDefault,1);
+  AssertArg(ProcType,0,'B',argDefault,'Integer','1 + 2');
+end;
+
+procedure TTestProcedureFunction.TestFunctionOneArgDefaultExpr;
+begin
+  ParseFunction('(B : Integer = 1 + 2)');
+  AssertFunc([],ccDefault,1);
+  AssertArg(FuncType,0,'B',argDefault,'Integer','1 + 2');
+end;
+
+procedure TTestProcedureFunction.TestProcedureTwoArgsDefault;
+begin
+  ParseProcedure('(B : Integer = 1; C : Integer = 2)');
+  AssertProc([],ccDefault,2);
+  AssertArg(ProcType,0,'B',argDefault,'Integer','1');
+  AssertArg(ProcType,1,'C',argDefault,'Integer','2');
+end;
+
+procedure TTestProcedureFunction.TestFunctionTwoArgsDefault;
+begin
+  ParseFunction('(B : Integer = 1; C : Integer = 2)');
+  AssertFunc([],ccDefault,2);
+  AssertArg(FuncType,0,'B',argDefault,'Integer','1');
+  AssertArg(FuncType,1,'C',argDefault,'Integer','2');
+end;
+
+procedure TTestProcedureFunction.TestProcedureOneUntypedVarArg;
+begin
+  ParseProcedure('(Var B)');
+  AssertProc([],ccDefault,1);
+  AssertArg(ProcType,0,'B',argVar,'','');
+end;
+
+procedure TTestProcedureFunction.TestFunctionOneUntypedVarArg;
+begin
+  ParseFunction('(Var B)');
+  AssertFunc([],ccDefault,1);
+  AssertArg(FuncType,0,'B',argVar,'','');
+end;
+
+procedure TTestProcedureFunction.TestProcedureTwoUntypedVarArgs;
+begin
+  ParseProcedure('(Var B; Var C)');
+  AssertProc([],ccDefault,2);
+  AssertArg(ProcType,0,'B',argVar,'','');
+  AssertArg(ProcType,1,'C',argVar,'','');
+end;
+
+procedure TTestProcedureFunction.TestFunctionTwoUntypedVarArgs;
+begin
+  ParseFunction('(Var B; Var C)');
+  AssertFunc([],ccDefault,2);
+  AssertArg(FuncType,0,'B',argVar,'','');
+  AssertArg(FuncType,1,'C',argVar,'','');
+end;
+
+procedure TTestProcedureFunction.TestProcedureOneUntypedConstArg;
+begin
+  ParseProcedure('(Const B)');
+  AssertProc([],ccDefault,1);
+  AssertArg(ProcType,0,'B',argConst,'','');
+end;
+
+procedure TTestProcedureFunction.TestFunctionOneUntypedConstArg;
+begin
+  ParseFunction('(Const B)');
+  AssertFunc([],ccDefault,1);
+  AssertArg(FuncType,0,'B',argConst,'','');
+end;
+
+procedure TTestProcedureFunction.TestProcedureTwoUntypedConstArgs;
+begin
+  ParseProcedure('(Const B; Const C)');
+  AssertProc([],ccDefault,2);
+  AssertArg(ProcType,0,'B',argConst,'','');
+  AssertArg(ProcType,1,'C',argConst,'','');
+end;
+
+procedure TTestProcedureFunction.TestFunctionTwoUntypedConstArgs;
+begin
+  ParseFunction('(Const B; Const C)');
+  AssertFunc([],ccDefault,2);
+  AssertArg(FuncType,0,'B',argConst,'','');
+  AssertArg(FuncType,1,'C',argConst,'','');
+end;
+
+procedure TTestProcedureFunction.TestProcedureOpenArrayArg;
+begin
+  ParseProcedure('(B : Array of Integer)');
+  AssertProc([],ccDefault,1);
+  AssertArrayArg(ProcType,0,'B',argDefault,'Integer');
+end;
+
+procedure TTestProcedureFunction.TestFunctionOpenArrayArg;
+begin
+  ParseFunction('(B : Array of Integer)');
+  AssertFunc([],ccDefault,1);
+  AssertArrayArg(FuncType,0,'B',argDefault,'Integer');
+end;
+
+procedure TTestProcedureFunction.TestProcedureTwoOpenArrayArgs;
+begin
+  ParseProcedure('(B : Array of Integer;C : Array of Integer)');
+  AssertProc([],ccDefault,2);
+  AssertArrayArg(ProcType,0,'B',argDefault,'Integer');
+  AssertArrayArg(ProcType,1,'C',argDefault,'Integer');
+end;
+
+procedure TTestProcedureFunction.TestFunctionTwoOpenArrayArgs;
+begin
+  ParseFunction('(B : Array of Integer;C : Array of Integer)');
+  AssertFunc([],ccDefault,2);
+  AssertArrayArg(FuncType,0,'B',argDefault,'Integer');
+  AssertArrayArg(FuncType,1,'C',argDefault,'Integer');
+end;
+
+procedure TTestProcedureFunction.TestProcedureConstOpenArrayArg;
+begin
+  ParseProcedure('(Const B : Array of Integer)');
+  AssertProc([],ccDefault,1);
+  AssertArrayArg(ProcType,0,'B',argConst,'Integer');
+end;
+
+procedure TTestProcedureFunction.TestFunctionConstOpenArrayArg;
+begin
+  ParseFunction('(Const B : Array of Integer)');
+  AssertFunc([],ccDefault,1);
+  AssertArrayArg(FuncType,0,'B',argConst,'Integer');
+end;
+
+procedure TTestProcedureFunction.TestProcedureVarOpenArrayArg;
+begin
+  ParseProcedure('(Var B : Array of Integer)');
+  AssertProc([],ccDefault,1);
+  AssertArrayArg(ProcType,0,'B',argVar,'Integer');
+end;
+
+procedure TTestProcedureFunction.TestFunctionVarOpenArrayArg;
+begin
+  ParseFunction('(Var B : Array of Integer)');
+  AssertFunc([],ccDefault,1);
+  AssertArrayArg(FuncType,0,'B',argVar,'Integer');
+end;
+
+procedure TTestProcedureFunction.TestProcedureArrayOfConstArg;
+begin
+  ParseProcedure('(B : Array of Const)');
+  AssertProc([],ccDefault,1);
+  AssertArrayArg(ProcType,0,'B',argDefault,'');
+end;
+
+procedure TTestProcedureFunction.TestFunctionArrayOfConstArg;
+begin
+  ParseFunction('(B : Array of Const)');
+  AssertFunc([],ccDefault,1);
+  AssertArrayArg(FuncType,0,'B',argDefault,'');
+end;
+
+procedure TTestProcedureFunction.TestProcedureConstArrayOfConstArg;
+begin
+  ParseProcedure('(Const B : Array of Const)');
+  AssertProc([],ccDefault,1);
+  AssertArrayArg(ProcType,0,'B',argConst,'');
+end;
+
+procedure TTestProcedureFunction.TestFunctionConstArrayOfConstArg;
+begin
+  ParseFunction('(Const B : Array of Const)');
+  AssertFunc([],ccDefault,1);
+  AssertArrayArg(FuncType,0,'B',argConst,'');
+end;
+
+procedure TTestProcedureFunction.TestProcedureCdecl;
+begin
+  ParseProcedure('; cdecl');
+  AssertProc([],ccCdecl,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionCdecl;
+begin
+  ParseFunction('','','',ccCdecl);
+  AssertFunc([],ccCdecl,0);
+end;
+
+procedure TTestProcedureFunction.TestProcedureCdeclDeprecated;
+begin
+  ParseProcedure('; cdecl;','deprecated');
+  AssertProc([],ccCdecl,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionCdeclDeprecated;
+begin
+  ParseFunction('','','deprecated',ccCdecl);
+  AssertFunc([],ccCdecl,0);
+end;
+
+procedure TTestProcedureFunction.TestProcedureSafeCall;
+begin
+  ParseProcedure('; safecall;','');
+  AssertProc([],ccSafeCall,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionSafeCall;
+begin
+  ParseFunction('','','',ccSafecall);
+  AssertFunc([],ccSafecall,0);
+end;
+
+procedure TTestProcedureFunction.TestProcedurePascal;
+begin
+  ParseProcedure('; pascal;','');
+  AssertProc([],ccPascal,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionPascal;
+begin
+  ParseFunction('','','',ccPascal);
+  AssertFunc([],ccPascal,0);
+end;
+
+procedure TTestProcedureFunction.TestProcedureStdCall;
+begin
+  ParseProcedure('; stdcall;','');
+  AssertProc([],ccstdcall,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionStdCall;
+begin
+  ParseFunction('','','',ccStdCall);
+  AssertFunc([],ccStdCall,0);
+end;
+
+procedure TTestProcedureFunction.TestProcedureOldFPCCall;
+begin
+  ParseProcedure('; oldfpccall;','');
+  AssertProc([],ccoldfpccall,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionOldFPCCall;
+begin
+  ParseFunction('','','',ccOldFPCCall);
+  AssertFunc([],ccOldFPCCall,0);
+end;
+
+procedure TTestProcedureFunction.TestProcedurePublic;
+begin
+  ParseProcedure('; public name ''myfunc'';','');
+  AssertProc([pmPublic],ccDefault,0);
+  AssertExpression('Public name',Proc.PublicName,pekString,'''myfunc''');
+end;
+
+procedure TTestProcedureFunction.TestProcedurePublicIdent;
+begin
+  ParseProcedure('; public name exportname;','');
+  AssertProc([pmPublic],ccDefault,0);
+  AssertExpression('Public name',Proc.PublicName,pekIdent,'exportname');
+end;
+
+procedure TTestProcedureFunction.TestFunctionPublic;
+begin
+  AddDeclaration('function A : Integer; public name exportname');
+  ParseFunction;
+  AssertFunc([pmPublic],ccDefault,0);
+  AssertExpression('Public name',Func.PublicName,pekIdent,'exportname');
+end;
+
+procedure TTestProcedureFunction.TestProcedureCdeclPublic;
+begin
+  ParseProcedure('; cdecl; public name exportname;','');
+  AssertProc([pmPublic],ccCDecl,0);
+  AssertExpression('Public name',Proc.PublicName,pekIdent,'exportname');
+end;
+
+procedure TTestProcedureFunction.TestFunctionCdeclPublic;
+begin
+  AddDeclaration('function A : Integer; cdecl; public name exportname');
+  ParseFunction;
+  AssertFunc([pmPublic],ccCDecl,0);
+  AssertExpression('Public name',Func.PublicName,pekIdent,'exportname');
+end;
+
+procedure TTestProcedureFunction.TestProcedureOverload;
+begin
+  ParseProcedure('; overload;','');
+  AssertProc([pmOverload],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionOverload;
+begin
+  AddDeclaration('function A : Integer; overload');
+  ParseFunction;
+  AssertFunc([pmOverload],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestProcedureVarargs;
+begin
+  ParseProcedure('; varargs;','');
+  AssertProc([pmVarArgs],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionVarArgs;
+begin
+  AddDeclaration('function A : Integer; varargs');
+  ParseFunction;
+  AssertFunc([pmVarArgs],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestProcedureCDeclVarargs;
+begin
+  ParseProcedure(';cdecl; varargs;','');
+  AssertProc([pmVarArgs],ccCDecl,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionCDeclVarArgs;
+begin
+  AddDeclaration('function A : Integer; cdecl; varargs');
+  ParseFunction;
+  AssertFunc([pmVarArgs],ccCdecl,0);
+end;
+
+procedure TTestProcedureFunction.TestProcedureForwardInterface;
+begin
+  AddDeclaration('procedure A; forward;');
+  AssertException(EParserError,@ParseProcedure);
+end;
+
+procedure TTestProcedureFunction.TestFunctionForwardInterface;
+begin
+  AddDeclaration('function A : integer; forward;');
+  AssertException(EParserError,@ParseFunction);
+end;
+
+procedure TTestProcedureFunction.TestProcedureForward;
+begin
+  UseImplementation:=True;
+  AddDeclaration('procedure A; forward;');
+  ParseProcedure;
+  AssertProc([pmforward],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionForward;
+begin
+  UseImplementation:=True;
+  AddDeclaration('function A : integer; forward;');
+  ParseFunction;
+  AssertFunc([pmforward],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestProcedureCdeclForward;
+begin
+  UseImplementation:=True;
+  AddDeclaration('procedure A; cdecl; forward;');
+  ParseProcedure;
+  AssertProc([pmforward],ccCDecl,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionCDeclForward;
+begin
+  UseImplementation:=True;
+  AddDeclaration('function A : integer; cdecl; forward;');
+  ParseFunction;
+  AssertFunc([pmforward],ccCDecl,0);
+end;
+
+procedure TTestProcedureFunction.TestProcedureCompilerProc;
+begin
+  ParseProcedure(';compilerproc;','');
+  AssertProc([pmCompilerProc],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionCompilerProc;
+begin
+  AddDeclaration('function A : Integer; compilerproc');
+  ParseFunction;
+  AssertFunc([pmCompilerProc],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestProcedureCDeclCompilerProc;
+begin
+  ParseProcedure(';cdecl;compilerproc;','');
+  AssertProc([pmCompilerProc],ccCDecl,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionCDeclCompilerProc;
+begin
+  AddDeclaration('function A : Integer; cdecl; compilerproc');
+  ParseFunction;
+  AssertFunc([pmCompilerProc],ccCDecl,0);
+end;
+
+procedure TTestProcedureFunction.TestProcedureAssembler;
+begin
+  ParseProcedure(';assembler;','');
+  AssertProc([pmAssembler],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionAssembler;
+begin
+  AddDeclaration('function A : Integer; assembler');
+  ParseFunction;
+  AssertFunc([pmAssembler],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestProcedureCDeclAssembler;
+begin
+  ParseProcedure(';cdecl;assembler;','');
+  AssertProc([pmAssembler],ccCDecl,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionCDeclAssembler;
+begin
+  AddDeclaration('function A : Integer; cdecl; assembler');
+  ParseFunction;
+  AssertFunc([pmAssembler],ccCDecl,0);
+end;
+
+procedure TTestProcedureFunction.TestProcedureExport;
+begin
+  ParseProcedure(';export;','');
+  AssertProc([pmExport],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionExport;
+begin
+  AddDeclaration('function A : Integer; export');
+  ParseFunction;
+  AssertFunc([pmExport],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestProcedureCDeclExport;
+begin
+  ParseProcedure('cdecl;export;','');
+  AssertProc([pmExport],ccCDecl,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionCDeclExport;
+begin
+  AddDeclaration('function A : Integer; cdecl; export');
+  ParseFunction;
+  AssertFunc([pmExport],ccCDecl,0);
+end;
+
+procedure TTestProcedureFunction.TestProcedureExternal;
+begin
+  ParseProcedure(';external','');
+  AssertProc([pmExternal],ccDefault,0);
+  AssertNull('No Library name expression',Proc.LibraryExpr);
+end;
+
+procedure TTestProcedureFunction.TestFunctionExternal;
+begin
+  AddDeclaration('function A : Integer; external');
+  ParseFunction;
+  AssertFunc([pmExternal],ccDefault,0);
+  AssertNull('No Library name expression',Func.LibraryExpr);
+end;
+
+procedure TTestProcedureFunction.TestProcedureExternalLibName;
+begin
+  ParseProcedure(';external ''libname''','');
+  AssertProc([pmExternal],ccDefault,0);
+  AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
+end;
+
+procedure TTestProcedureFunction.TestFunctionExternalLibName;
+begin
+  AddDeclaration('function A : Integer; external ''libname''');
+  ParseFunction;
+  AssertFunc([pmExternal],ccDefault,0);
+  AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
+end;
+
+procedure TTestProcedureFunction.TestProcedureExternalLibNameName;
+begin
+  ParseProcedure(';external ''libname'' name ''symbolname''','');
+  AssertProc([pmExternal],ccDefault,0);
+  AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
+  AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
+end;
+
+procedure TTestProcedureFunction.TestFunctionExternalLibNameName;
+begin
+  AddDeclaration('function A : Integer; external ''libname'' name ''symbolname''');
+  ParseFunction;
+  AssertFunc([pmExternal],ccDefault,0);
+  AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
+  AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
+end;
+
+procedure TTestProcedureFunction.TestProcedureExternalName;
+begin
+  ParseProcedure(';external name ''symbolname''','');
+  AssertProc([pmExternal],ccDefault,0);
+  AssertNull('No Library name expression',Proc.LibraryExpr);
+  AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
+end;
+
+procedure TTestProcedureFunction.TestFunctionExternalName;
+begin
+  AddDeclaration('function A : Integer; external name ''symbolname''');
+  ParseFunction;
+  AssertFunc([pmExternal],ccDefault,0);
+  AssertNull('No Library name expression',Func.LibraryExpr);
+  AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
+end;
+
+procedure TTestProcedureFunction.TestProcedureCdeclExternal;
+begin
+  ParseProcedure('; cdecl; external','');
+  AssertProc([pmExternal],ccCdecl,0);
+  AssertNull('No Library name expression',Proc.LibraryExpr);
+end;
+
+procedure TTestProcedureFunction.TestFunctionCdeclExternal;
+begin
+  AddDeclaration('function A : Integer; cdecl; external');
+  ParseFunction;
+  AssertFunc([pmExternal],ccCdecl,0);
+  AssertNull('No Library name expression',Func.LibraryExpr);
+end;
+
+procedure TTestProcedureFunction.TestProcedureCdeclExternalLibName;
+begin
+  ParseProcedure('; cdecl; external ''libname''','');
+  AssertProc([pmExternal],ccCdecl,0);
+  AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
+end;
+
+procedure TTestProcedureFunction.TestFunctionCdeclExternalLibName;
+begin
+  AddDeclaration('function A : Integer; cdecl; external ''libname''');
+  ParseFunction;
+  AssertFunc([pmExternal],ccCdecl,0);
+  AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
+end;
+
+procedure TTestProcedureFunction.TestProcedureCdeclExternalLibNameName;
+begin
+  ParseProcedure('; cdecl; external ''libname'' name ''symbolname''','');
+  AssertProc([pmExternal],ccCdecl,0);
+  AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
+  AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
+end;
+
+procedure TTestProcedureFunction.TestFunctionCdeclExternalLibNameName;
+begin
+  AddDeclaration('function A : Integer; cdecl; external ''libname'' name ''symbolname''');
+  ParseFunction;
+  AssertFunc([pmExternal],ccCdecl,0);
+  AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
+  AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
+end;
+
+procedure TTestProcedureFunction.TestProcedureCdeclExternalName;
+begin
+  ParseProcedure('; cdecl; external name ''symbolname''','');
+  AssertProc([pmExternal],ccCdecl,0);
+  AssertNull('No Library name expression',Proc.LibraryExpr);
+  AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
+end;
+
+procedure TTestProcedureFunction.TestFunctionCdeclExternalName;
+begin
+  AddDeclaration('function A : Integer; cdecl; external name ''symbolname''');
+  ParseFunction;
+  AssertFunc([pmExternal],ccCdecl,0);
+  AssertNull('No Library name expression',Func.LibraryExpr);
+  AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
+end;
+
+procedure TTestProcedureFunction.SetUp;
+begin
+   Inherited;
+end;
+
+procedure TTestProcedureFunction.TearDown;
+begin
+   Inherited;
+end;
+
+initialization
+
+  RegisterTest(TTestProcedureFunction);
+end.
+

packages/fcl-passrc/tests/testpassrc.lpi

@@ -37,7 +37,7 @@
         <PackageName Value="FCL"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="10">
+    <Units Count="11">
       <Unit0>
         <Filename Value="testpassrc.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -88,6 +88,11 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="tcexprparser"/>
       </Unit9>
+      <Unit10>
+        <Filename Value="tcprocfunc.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcprocfunc"/>
+      </Unit10>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

packages/fcl-passrc/tests/testpassrc.lpr

@@ -3,9 +3,9 @@ program testpassrc;
 {$mode objfpc}{$H+}
 
 uses
-  Classes, consoletestrunner, tcscanner, 
-tctypeparser, tcstatements, tcbaseparser,
-  tcmoduleparser, tconstparser, tcvarparser, tcclasstype, tcexprparser;
+  Classes, consoletestrunner, tcscanner, tctypeparser, tcstatements,
+  tcbaseparser, tcmoduleparser, tconstparser, tcvarparser, tcclasstype,
+  tcexprparser, tcprocfunc;
 
 type