Browse Source

* Fix bug ID #0031546, far modifier for procedure

git-svn-id: trunk@35597 -
michael 8 years ago
parent
commit
0ad519aac5
2 changed files with 20 additions and 2 deletions
  1. 4 2
      packages/fcl-passrc/src/pastree.pp
  2. 16 0
      packages/fcl-passrc/tests/tcprocfunc.pas

+ 4 - 2
packages/fcl-passrc/src/pastree.pp

@@ -822,7 +822,8 @@ type
   TProcedureModifier = (pmVirtual, pmDynamic, pmAbstract, pmOverride,
                         pmExport, pmOverload, pmMessage, pmReintroduce,
                         pmStatic,pmInline,pmAssembler,pmVarargs, pmPublic,
-                        pmCompilerProc,pmExternal,pmForward, pmDispId, pmNoReturn);
+                        pmCompilerProc,pmExternal,pmForward, pmDispId, 
+                        pmNoReturn, pmfar);
   TProcedureModifiers = Set of TProcedureModifier;
   TProcedureMessageType = (pmtNone,pmtInteger,pmtString);
                         
@@ -1405,7 +1406,8 @@ const
                 = ('virtual', 'dynamic','abstract', 'override',
                    'export', 'overload', 'message', 'reintroduce',
                    'static','inline','assembler','varargs', 'public',
-                   'compilerproc','external','forward','dispid','noreturn');
+                   'compilerproc','external','forward','dispid',
+                   'noreturn','far');
 
   VariableModifierNames : Array[TVariableModifier] of string
      = ('cvar', 'external', 'public', 'export', 'class', 'static');

+ 16 - 0
packages/fcl-passrc/tests/tcprocfunc.pas

@@ -130,6 +130,8 @@ type
     Procedure TestFunctionForwardInterface;
     Procedure TestProcedureForward;
     Procedure TestFunctionForward;
+    Procedure TestProcedureFar;
+    Procedure TestFunctionFar;
     Procedure TestProcedureCdeclForward;
     Procedure TestFunctionCDeclForward;
     Procedure TestProcedureCompilerProc;
@@ -943,6 +945,20 @@ begin
   AssertFunc([pmforward],ccDefault,0);
 end;
 
+procedure TTestProcedureFunction.TestProcedureFar;
+begin
+  AddDeclaration('procedure A; far;');
+  ParseProcedure;
+  AssertProc([pmfar],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionFar;
+begin
+  AddDeclaration('function A : integer; far;');
+  ParseFunction;
+  AssertFunc([pmfar],ccDefault,0);
+end;
+
 procedure TTestProcedureFunction.TestProcedureCdeclForward;
 begin
   UseImplementation:=True;