paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 19:29:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: fixed a.specialize b<c>

Browse Source 
git-svn-id: trunk@47243 -
This commit is contained in:
Mattias Gaertner 2020-10-28 20:12:17 +00:00
parent 20a8b05bee
commit b51c89df41
2 changed files with 59 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
packages/pastojs/src/fppas2js.pp
View File

@ -9405,10 +9405,13 @@ begin
Result:=nil;
aResolver:=AContext.Resolver;
// Note: TPasParser guarantees that there is at most one TBinaryExpr between
// Note: TPasParser guarantees that there is at most one TBinaryExpr
// and/or one TInlineSpecializeExpr between
// TParamsExpr and its NameExpr. E.g. a.b.c() = ((a.b).c)()
RightEl:=El.right;
if RightEl is TInlineSpecializeExpr then
RightEl:=TInlineSpecializeExpr(RightEl).NameExpr;
if (RightEl.ClassType<>TPrimitiveExpr) then
RaiseNotSupported(RightEl,AContext,20190131162250,'Left='+GetObjName(El.left)+' right='+GetObjName(RightEl));
if not (RightEl.CustomData is TResolvedReference) then
@ -9451,10 +9454,13 @@ var
begin
aResolver:=AContext.Resolver;
// Note: TPasParser guarantees that there is at most one TBinaryExpr between
// Note: TPasParser guarantees that there is at most one TBinaryExpr
// and/or one TInlineSpecializeExpr between
// TParamsExpr and its NameExpr. E.g. a.b.c() = ((a.b).c)()
RightEl:=El.right;
if RightEl is TInlineSpecializeExpr then
RightEl:=TInlineSpecializeExpr(RightEl).NameExpr;
if (RightEl.ClassType<>TPrimitiveExpr) then
begin
{$IFDEF VerbosePas2JS}
@ -20826,7 +20832,7 @@ var
C: TClass;
begin
{$IFDEF VerbosePas2JS}
writeln('TPasToJSConverter.CreateCallHelperMethod Proc=',GetObjName(Proc),' Expr=',GetObjName(Expr));
writeln('TPasToJSConverter.CreateCallHelperMethod Proc=',GetObjName(Proc),' Expr=',GetObjName(Expr),' Implicit=',Implicit);
{$ENDIF}
Result:=nil;
aResolver:=AContext.Resolver;
@ -24684,9 +24690,12 @@ begin
if TargetArg.ValueExpr=nil then
begin
{$IFDEF VerbosePas2JS}
writeln('TPasToJSConverter.CreateProcedureCallArgs missing default value: TargetProc=',TargetProc.Name,' i=',i);
writeln('TPasToJSConverter.CreateProcedureCallArgs missing default value: i=',i,' TargetProc=',GetObjPath(TargetProc),' Args=',GetObjPath(Args));
{$ENDIF}
RaiseNotSupported(Args,AContext,20170201193601);
if Args=nil then
RaiseNotSupported(TargetProc,AContext,20201028203457)
else
RaiseNotSupported(Args,AContext,20170201193601);
end;
AContext.Access:=caRead;
Arg:=ConvertExpression(TargetArg.ValueExpr,ArgContext);

45
packages/pastojs/tests/tcgenerics.pas
View File

@ -54,6 +54,7 @@ type
procedure TestGen_ClassInterface_Corba;
procedure TestGen_ClassInterface_InterfacedObject;
procedure TestGen_ClassInterface_COM_RTTI;
procedure TestGen_ClassInterface_Helper;
// statements
Procedure TestGen_InlineSpec_Constructor;
@ -1587,6 +1588,50 @@ begin
'']));
end;
procedure TTestGenerics.TestGen_ClassInterface_Helper;
begin
StartProgram(true,[supTInterfacedObject]);
Add([
'{$mode objfpc}',
'{$ModeSwitch typehelpers}',
'type',
' IAnt = interface',
' procedure InterfaceProc;',
' end;',
' TBird = type helper for IAnt',
' generic procedure Fly<T>(a: T);',
' end;',
'generic procedure TBird.Fly<T>(a: T);',
'begin',
'end;',
'var ',
' Ant: IAnt;',
'begin',
' Ant.specialize Fly<word>(3);',
'']);
ConvertProgram;
CheckSource('TestGen_ClassInterface_COM_RTTI',
LinesToStr([ // statements
'rtl.createInterface(this, "IAnt", "{B9D0FF27-A446-3A1B-AA85-F167837AA297}", ["InterfaceProc"], pas.system.IUnknown);',
'rtl.createHelper(this, "TBird", null, function () {',
' this.Fly$G1 = function (a) {',
' };',
'});',
'this.Ant = null;',
'']),
LinesToStr([ // $mod.$main
'$mod.TBird.Fly$G1.call({',
' p: $mod,',
' get: function () {',
' return this.p.Ant;',
' },',
' set: function (v) {',
' rtl.setIntfP(this.p, "Ant", v);',
' }',
'}, 3);',
'']));
end;
procedure TTestGenerics.TestGen_InlineSpec_Constructor;
begin
StartProgram(false);