From 782c1352629e6542160f392373677268c9e81451 Mon Sep 17 00:00:00 2001
From: mattias <mattias@idefix.freepascal.org>
Date: Mon, 7 Dec 2020 23:19:35 +0000
Subject: [PATCH] fcl-passrc: far is a procedure type modifier, can appear in
 type defs

---
 compiler/packages/fcl-passrc/src/pastree.pp      |  4 ++--
 compiler/packages/fcl-passrc/src/pparser.pp      | 16 +++++++++++++---
 .../packages/fcl-passrc/tests/tcvarparser.pas    | 14 ++++++++++++++
 compiler/packages/pastojs/src/pas2jsfiler.pp     |  3 ++-
 4 files changed, 31 insertions(+), 6 deletions(-)

diff --git a/compiler/packages/fcl-passrc/src/pastree.pp b/compiler/packages/fcl-passrc/src/pastree.pp
index 5ced73a..2c7ec5a 100644
--- a/compiler/packages/fcl-passrc/src/pastree.pp
+++ b/compiler/packages/fcl-passrc/src/pastree.pp
@@ -119,7 +119,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);
 
@@ -1767,7 +1767,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/compiler/packages/fcl-passrc/src/pparser.pp b/compiler/packages/fcl-passrc/src/pparser.pp
index 488cec1..b7a5ca0 100644
--- a/compiler/packages/fcl-passrc/src/pparser.pp
+++ b/compiler/packages/fcl-passrc/src/pparser.pp
@@ -1382,6 +1382,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;
@@ -5360,8 +5365,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
@@ -5394,7 +5399,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/compiler/packages/fcl-passrc/tests/tcvarparser.pas b/compiler/packages/fcl-passrc/tests/tcvarparser.pas
index c3bee41..13becc7 100644
--- a/compiler/packages/fcl-passrc/tests/tcvarparser.pas
+++ b/compiler/packages/fcl-passrc/tests/tcvarparser.pas
@@ -37,6 +37,8 @@ Type
     Procedure TestSimpleVarAbsoluteDot;
     Procedure TestSimpleVarAbsolute2Dots;
     Procedure TestVarProcedure;
+    procedure TestVarProcedureCdecl;
+    procedure TestVarFunctionFar;
     Procedure TestVarFunctionINitialized;
     Procedure TestVarProcedureDeprecated;
     Procedure TestVarRecord;
@@ -222,6 +224,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/compiler/packages/pastojs/src/pas2jsfiler.pp b/compiler/packages/pastojs/src/pas2jsfiler.pp
index 265b465..7edade6 100644
--- a/compiler/packages/pastojs/src/pas2jsfiler.pp
+++ b/compiler/packages/pastojs/src/pas2jsfiler.pp
@@ -444,7 +444,8 @@ const
     'Static',
     'Varargs',
     'ReferenceTo',
-    'Async'
+    'Async',
+    'Far'
     );
 
   PCUProcedureMessageTypeNames: array[TProcedureMessageType] of string = (