paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-21 02:50:55 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@47499 -
(cherry picked from commit 215dab8c8a)
This commit is contained in:
michael 2020-11-20 20:19:49 +00:00 committed by Florian Klämpfl
parent a0db717adf
commit 9413d2c5d1
4 changed files with 31 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

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

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

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

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

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