Browse Source

fcl-passrc: far is a procedure type modifier, can appear in type defs

mattias 4 years ago
parent
commit
782c135262

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

@@ -119,7 +119,7 @@ type
                         ccMS_ABI_Default,ccMS_ABI_CDecl,
                         ccMS_ABI_Default,ccMS_ABI_CDecl,
                         ccVectorCall);
                         ccVectorCall);
   TProcTypeModifier = (ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs,
   TProcTypeModifier = (ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs,
-                       ptmReferenceTo,ptmAsync);
+                       ptmReferenceTo,ptmAsync,ptmFar);
   TProcTypeModifiers = set of TProcTypeModifier;
   TProcTypeModifiers = set of TProcTypeModifier;
   TPackMode = (pmNone,pmPacked,pmBitPacked);
   TPackMode = (pmNone,pmPacked,pmBitPacked);
 
 
@@ -1767,7 +1767,7 @@ const
                         'MS_ABI_Default','MS_ABI_CDecl',
                         'MS_ABI_Default','MS_ABI_CDecl',
                         'VectorCall');
                         'VectorCall');
   ProcTypeModifiers : Array[TProcTypeModifier] of string =
   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
   ModifierNames : Array[TProcedureModifier] of string
                 = ('virtual', 'dynamic','abstract', 'override',
                 = ('virtual', 'dynamic','abstract', 'override',

+ 13 - 3
compiler/packages/fcl-passrc/src/pparser.pp

@@ -1382,6 +1382,11 @@ begin
     Result:=true;
     Result:=true;
     PTM:=ptmVarargs;
     PTM:=ptmVarargs;
     end
     end
+  else if CompareText(S,ProcTypeModifiers[ptmFar])=0 then
+    begin
+    Result:=true;
+    PTM:=ptmFar;
+    end
   else if CompareText(S,ProcTypeModifiers[ptmStatic])=0 then
   else if CompareText(S,ProcTypeModifiers[ptmStatic])=0 then
     begin
     begin
     Result:=true;
     Result:=true;
@@ -5360,8 +5365,8 @@ begin
       begin
       begin
       if IsAnonymous then
       if IsAnonymous then
         CheckToken(tkbegin); // begin expected, but ; found
         CheckToken(tkbegin); // begin expected, but ; found
-      if LastToken=tkSemicolon then
-        ParseExcSyntaxError;
+      // if LastToken=tkSemicolon then
+      //  ParseExcSyntaxError;
       continue;
       continue;
       end
       end
     else if TokenIsCallingConvention(CurTokenString,cc) then
     else if TokenIsCallingConvention(CurTokenString,cc) then
@@ -5394,7 +5399,12 @@ begin
     else if IsAnonymous and TokenIsAnonymousProcedureModifier(Parent,CurTokenString,PM) then
     else if IsAnonymous and TokenIsAnonymousProcedureModifier(Parent,CurTokenString,PM) then
       HandleProcedureModifier(Parent,PM)
       HandleProcedureModifier(Parent,PM)
     else if TokenIsProcedureTypeModifier(Parent,CurTokenString,PTM) then
     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)
     else if (not IsProcType) and (not IsAnonymous)
         and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
         and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
       HandleProcedureModifier(Parent,PM)
       HandleProcedureModifier(Parent,PM)

+ 14 - 0
compiler/packages/fcl-passrc/tests/tcvarparser.pas

@@ -37,6 +37,8 @@ Type
     Procedure TestSimpleVarAbsoluteDot;
     Procedure TestSimpleVarAbsoluteDot;
     Procedure TestSimpleVarAbsolute2Dots;
     Procedure TestSimpleVarAbsolute2Dots;
     Procedure TestVarProcedure;
     Procedure TestVarProcedure;
+    procedure TestVarProcedureCdecl;
+    procedure TestVarFunctionFar;
     Procedure TestVarFunctionINitialized;
     Procedure TestVarFunctionINitialized;
     Procedure TestVarProcedureDeprecated;
     Procedure TestVarProcedureDeprecated;
     Procedure TestVarRecord;
     Procedure TestVarRecord;
@@ -222,6 +224,18 @@ begin
   AssertVariableType(TPasProcedureType);
   AssertVariableType(TPasProcedureType);
 end;
 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;
 procedure TTestVarParser.TestVarFunctionINitialized;
 begin
 begin
   ParseVar('function (device: pointer): pointer; cdecl = nil','');
   ParseVar('function (device: pointer): pointer; cdecl = nil','');

+ 2 - 1
compiler/packages/pastojs/src/pas2jsfiler.pp

@@ -444,7 +444,8 @@ const
     'Static',
     'Static',
     'Varargs',
     'Varargs',
     'ReferenceTo',
     'ReferenceTo',
-    'Async'
+    'Async',
+    'Far'
     );
     );
 
 
   PCUProcedureMessageTypeNames: array[TProcedureMessageType] of string = (
   PCUProcedureMessageTypeNames: array[TProcedureMessageType] of string = (