paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-06 14:37:49 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: fixed anonymous asm proc in mode delphi

Browse Source 
git-svn-id: trunk@47060 -
This commit is contained in:
Mattias Gaertner 2020-10-06 21:40:52 +00:00
parent 29b6e4d6de
commit 8ca7446bf0
3 changed files with 52 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -451,7 +451,8 @@ type
procedure ParseArgList(Parent: TPasElement; procedure ParseArgList(Parent: TPasElement;
Args: TFPList; // list of TPasArgument Args: TFPList; // list of TPasArgument
EndToken: TToken); EndToken: TToken);
procedure ParseProcedureOrFunction(Parent: TPasElement; Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean); procedure ParseProcedureOrFunction(Parent: TPasElement;
Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
procedure ParseProcedureBody(Parent: TPasElement); procedure ParseProcedureBody(Parent: TPasElement);
function ParseMethodResolution(Parent: TPasElement): TPasMethodResolution; function ParseMethodResolution(Parent: TPasElement): TPasMethodResolution;
// Properties for external access // Properties for external access
@ -4998,7 +4999,7 @@ begin
ptAnonymousProcedure,ptAnonymousFunction: ptAnonymousProcedure,ptAnonymousFunction:
case CurToken of case CurToken of
tkIdentifier, // e.g. procedure assembler tkIdentifier, // e.g. procedure assembler
tkbegin,tkvar,tkconst,tktype,tkprocedure,tkfunction: tkbegin,tkvar,tkconst,tktype,tkprocedure,tkfunction,tkasm:
UngetToken; UngetToken;
tkColon: tkColon:
if ProcType=ptAnonymousFunction then if ProcType=ptAnonymousFunction then
@ -5300,7 +5301,7 @@ begin
ResultEl.ResultType := ParseType(ResultEl,CurSourcePos); ResultEl.ResultType := ParseType(ResultEl,CurSourcePos);
end; end;
else else
resultEl:=Nil; ResultEl:=Nil;
end; end;
if OfObjectPossible then if OfObjectPossible then
begin begin
@ -5312,7 +5313,7 @@ begin
end end
else if (CurToken = tkIs) then else if (CurToken = tkIs) then
begin begin
expectToken(tkIdentifier); ExpectToken(tkIdentifier);
if (lowerCase(CurTokenString)<>'nested') then if (lowerCase(CurTokenString)<>'nested') then
ParseExc(nParserExpectedNested,SParserExpectedNested); ParseExc(nParserExpectedNested,SParserExpectedNested);
Element.IsNested:=True; Element.IsNested:=True;

2
packages/pastojs/tests/tcfiler.pas
View File

@ -2730,7 +2730,7 @@ begin
'implementation', 'implementation',
'generic function Run<T>(a: T): T;', 'generic function Run<T>(a: T): T;',
'var b: T;', 'var b: T;',
' var i: word;', ' i: word;',
'begin', 'begin',
' b:=a;', ' b:=a;',
' Result:=b;', ' Result:=b;',

46
packages/pastojs/tests/tcmodules.pas
View File

@ -358,6 +358,7 @@ type
Procedure TestAnonymousProc_NestedAssignResult; Procedure TestAnonymousProc_NestedAssignResult;
Procedure TestAnonymousProc_Class; Procedure TestAnonymousProc_Class;
Procedure TestAnonymousProc_ForLoop; Procedure TestAnonymousProc_ForLoop;
Procedure TestAnonymousProc_AsmDelphi;
// enums, sets // enums, sets
Procedure TestEnum_Name; Procedure TestEnum_Name;
@ -5257,6 +5258,51 @@ begin
])); ]));
end; end;
procedure TTestModule.TestAnonymousProc_AsmDelphi;
begin
StartProgram(false);
Add([
'{$mode delphi}',
'type',
' TProc = reference to procedure;',
' TFunc = reference to function(x: word): word;',
'procedure Run;',
'asm',
'end;',
'procedure Walk(p: TProc; f: TFunc);',
'begin',
' Walk(procedure asm end, function(b:word): word asm return 1+b; end);',
'end;',
'begin',
' Walk(procedure',
' asm',
' console.log("a");',
' end,',
' function(x: word): word asm',
' console.log("c");',
' end);',
'']);
ConvertProgram;
CheckSource('TestAnonymousProc_AsmDelphi',
LinesToStr([ // statements
'this.Run = function () {',
'};',
'this.Walk = function (p, f) {',
' $mod.Walk(function () {',
' }, function (b) {',
' return 1+b;',
' });',
'};',
'']),
LinesToStr([
'$mod.Walk(function () {',
' console.log("a");',
'}, function (x) {',
' console.log("c");',
'});',
'']));
end;
procedure TTestModule.TestEnum_Name; procedure TTestModule.TestEnum_Name;
begin begin
StartProgram(false); StartProgram(false);