* far is a procedure type modifier, can appear in type defs

git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@47499 3ad0048d-3df7-0310-abae-a5850022a9f2

4 files changed, 31 insertions, 6 deletions

diff --git a/packages/fcl-passrc/src/pastree.pp b/packages/fcl-passrc/src/pastree.pp
index 28c0d2d95d..f2ec5de501 100644
--- a/packages/fcl-passrc/src/pastree.pp
+++ b/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);
+                       ptmReferenceTo,ptmAsync,ptmFar);
   TProcTypeModifiers = set of TProcTypeModifier;
   TPackMode = (pmNone,pmPacked,pmBitPacked);
 
@@ -1768,7 +1768,7 @@ const
                         'MS_ABI_Default','MS_ABI_CDecl',
                         'VectorCall');
   ProcTypeModifiers : Array[TProcTypeModifier] of string =
-      ('of Object', 'is nested','static','varargs','reference to','async');
+      ('of Object', 'is nested','static','varargs','reference to','async','far');
 
   ModifierNames : Array[TProcedureModifier] of string
                 = ('virtual', 'dynamic','abstract', 'override',
diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp
index 0db1321764..15b24665c3 100644
--- a/packages/fcl-passrc/src/pparser.pp
+++ b/packages/fcl-passrc/src/pparser.pp
@@ -1393,6 +1393,11 @@ begin
     Result:=true;
     PTM:=ptmVarargs;
     end
+  else if CompareText(S,ProcTypeModifiers[ptmFar])=0 then
+    begin
+    Result:=true;
+    PTM:=ptmFar;
+    end
   else if CompareText(S,ProcTypeModifiers[ptmStatic])=0 then
     begin
     Result:=true;
@@ -5383,8 +5388,8 @@ begin
       begin
       if IsAnonymous then
         CheckToken(tkbegin); // begin expected, but ; found
-      if LastToken=tkSemicolon then
-        ParseExcSyntaxError;
+      // if LastToken=tkSemicolon then
+      //  ParseExcSyntaxError;
       continue;
       end
     else if TokenIsCallingConvention(CurTokenString,cc) then
@@ -5417,7 +5422,12 @@ begin
     else if IsAnonymous and TokenIsAnonymousProcedureModifier(Parent,CurTokenString,PM) then
       HandleProcedureModifier(Parent,PM)
     else if TokenIsProcedureTypeModifier(Parent,CurTokenString,PTM) then
-      HandleProcedureTypeModifier(Element,PTM)
+      begin
+      HandleProcedureTypeModifier(Element,PTM);
+      // Backwards compatibility
+      if (PTM=ptmFar) and (Parent is TPasProcedure) then
+        (Parent as TPasProcedure).AddModifier(pmFar)
+      end
     else if (not IsProcType) and (not IsAnonymous)
         and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
       HandleProcedureModifier(Parent,PM)
diff --git a/packages/fcl-passrc/tests/tcvarparser.pas b/packages/fcl-passrc/tests/tcvarparser.pas
index 2c2ee5ac0e..b6092b340c 100644
--- a/packages/fcl-passrc/tests/tcvarparser.pas
+++ b/packages/fcl-passrc/tests/tcvarparser.pas
@@ -39,6 +39,8 @@ Type
     Procedure TestSimpleVarAbsoluteDot;
     Procedure TestSimpleVarAbsolute2Dots;
     Procedure TestVarProcedure;
+    procedure TestVarProcedureCdecl;
+    procedure TestVarFunctionFar;
     Procedure TestVarFunctionINitialized;
     Procedure TestVarProcedureDeprecated;
     Procedure TestVarRecord;
@@ -247,6 +249,18 @@ begin
   AssertVariableType(TPasProcedureType);
 end;
 
+procedure TTestVarParser.TestVarProcedureCdecl;
+begin
+  ParseVar('procedure; cdecl;','');
+  AssertVariableType(TPasProcedureType);
+end;
+
+procedure TTestVarParser.TestVarFunctionFar;
+begin
+  ParseVar('function (cinfo : j_decompress_ptr) : int; far;','');
+  AssertVariableType(TPasFunctionType);
+end;
+
 procedure TTestVarParser.TestVarFunctionINitialized;
 begin
   ParseVar('function (device: pointer): pointer; cdecl = nil','');
diff --git a/packages/pastojs/src/pas2jsfiler.pp b/packages/pastojs/src/pas2jsfiler.pp
index 516dd9d6ed..fe73784a6b 100644
--- a/packages/pastojs/src/pas2jsfiler.pp
+++ b/packages/pastojs/src/pas2jsfiler.pp
@@ -442,7 +442,8 @@ const
     'Static',
     'Varargs',
     'ReferenceTo',
-    'Async'
+    'Async',
+    'Far'
     );
 
   PCUProcedureMessageTypeNames: array[TProcedureMessageType] of string = (