paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-05 18:17:45 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
mattias 2020-12-07 23:19:35 +00:00
parent 31103c3c9f
commit 782c135262
4 changed files with 31 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
compiler/packages/fcl-passrc/src/pastree.pp
View File

@ -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',

16
compiler/packages/fcl-passrc/src/pparser.pp
View File

@ -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)

14
compiler/packages/fcl-passrc/tests/tcvarparser.pas
View File

@ -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','');

3
compiler/packages/pastojs/src/pas2jsfiler.pp
View File

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