paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 04:39:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: typeinfo(GenTemplateType)

Browse Source 
git-svn-id: trunk@43223 -
This commit is contained in:
Mattias Gaertner 2019-10-18 16:06:34 +00:00
parent 3f19cff02b
commit a832f3615b
3 changed files with 99 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
packages/fcl-passrc/tests/tcresolvegenerics.pas
View File

@ -144,6 +144,7 @@ type
procedure TestGenProc_TypeParamCntOverloadNoParams;
procedure TestGenProc_TypeParamWithDefaultParamDelphiFail;
// ToDo: NestedResultAssign
procedure TestGenProc_OverloadsOtherUnit;
// generic function infer types
procedure TestGenProc_Infer_NeedExplicitFail;
@ -2147,6 +2148,30 @@ begin
CheckResolverException(sParamOfThisTypeCannotHaveDefVal,nParamOfThisTypeCannotHaveDefVal);
end;
procedure TTestResolveGenerics.TestGenProc_OverloadsOtherUnit;
begin
AddModuleWithIntfImplSrc('ns1.unit2.pp',
LinesToStr([
'var i2: longint;']),
LinesToStr([
'']));
AddModuleWithIntfImplSrc('ns1.unit1.pp',
LinesToStr([
'uses unit2;',
'var j1: longint;']),
LinesToStr([
'']));
StartProgram(true);
Add([
'uses unit1;',
'begin',
' if j1=0 then ;',
'']);
ParseProgram;
end;
procedure TTestResolveGenerics.TestGenProc_Infer_NeedExplicitFail;
begin
StartProgram(false);

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

@ -4853,6 +4853,9 @@ var
TypeEl: TPasType;
FoundClass: TPasClassType;
ScopeDepth: Integer;
TemplType: TPasGenericTemplateType;
ConEl: TPasElement;
ConToken: TToken;
begin
Param:=Params.Params[0];
ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
@ -4932,7 +4935,32 @@ begin
TIName:=Pas2JSBuiltInNames[pbitnTIDynArray];
end
else if C=TPasPointerType then
TIName:=Pas2JSBuiltInNames[pbitnTIPointer];
TIName:=Pas2JSBuiltInNames[pbitnTIPointer]
else if C=TPasGenericTemplateType then
begin
TemplType:=TPasGenericTemplateType(TypeEl);
if length(TemplType.Constraints)>0 then
begin
ConEl:=TemplType.Constraints[0];
ConToken:=GetGenericConstraintKeyword(ConEl);
case ConToken of
tkrecord: TIName:=Pas2JSBuiltInNames[pbitnTIRecord];
tkclass,tkConstructor: TIName:=Pas2JSBuiltInNames[pbitnTIClass];
else
if not (ConEl is TPasType) then
RaiseNotYetImplemented(20191018180031,ConEl,GetObjPath(Param));
if ConEl is TPasClassType then
TIName:=Pas2JSBuiltInNames[pbitnTIClass]
else
RaiseNotYetImplemented(20191018180131,ConEl,GetObjPath(Param));
end;
end;
if TIName='' then
begin
// generic template without constraints
TIName:=Pas2JSBuiltInNames[pbitnTI];
end;
end;
end
else if ParamResolved.BaseType=btSet then
begin
@ -4961,7 +4989,7 @@ begin
else if ParamResolved.BaseType in [btChar,btBoolean] then
TIName:=Pas2JSBuiltInNames[pbitnTI]
end;
//writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult TIName=',TIName);
//writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult TIName=',TIName,' ',GetObjName(TypeEl));
if TIName='' then
begin
{$IFDEF VerbosePas2JS}

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

@ -52,6 +52,7 @@ type
procedure TestGenProc_Overload;
procedure TestGenProc_Forward;
procedure TestGenProc_Infer_OverloadForward;
procedure TestGenProc_TypeInfo;
// ToDo: FuncName:=
// generic methods
@ -1024,6 +1025,49 @@ begin
'']));
end;
procedure TTestGenerics.TestGenProc_TypeInfo;
begin
Converter.Options:=Converter.Options-[coNoTypeInfo];
StartProgram(false);
Add([
'{$modeswitch externalclass}',
'{$modeswitch implicitfunctionspecialization}',
'type',
' TTypeInfo = class external name ''rtl.tTypeInfo''',
' end;',
' TTypeInfoInteger = class external name ''rtl.tTypeInfoInteger''(TTypeInfo)',
' end;',
'generic procedure Run<S>(a: S);',
'var',
' p: TTypeInfo;',
'begin',
' p:=TypeInfo(S);',
' p:=TypeInfo(a);',
'end;',
'begin',
' Run(word(3));',
' Run(''foo'');',
'']);
ConvertProgram;
CheckSource('TestGenProc_TypeInfo',
LinesToStr([ // statements
'this.Run$s0 = function (a) {',
' var p = null;',
' p = rtl.word;',
' p = rtl.word;',
'};',
'this.Run$s1 = function (a) {',
' var p = null;',
' p = rtl.string;',
' p = rtl.string;',
'};',
'']),
LinesToStr([ // $mod.$main
'$mod.Run$s0(3);',
'$mod.Run$s1("foo");',
'']));
end;
procedure TTestGenerics.TestGenMethod_ObjFPC;
begin
StartProgram(false);