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

pastojs: inlinespecializeexpr

Browse Source 
git-svn-id: trunk@42828 -
This commit is contained in:
Mattias Gaertner 2019-08-26 12:54:30 +00:00
parent b3465a021c
commit c60fb09f1a
2 changed files with 76 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1999,6 +1999,7 @@ type
Function ConvertPrimitiveExpression(El: TPrimitiveExpr; AContext: TConvertContext): TJSElement; virtual;
Function ConvertIdentifierExpr(El: TPasExpr; const aName: string; AContext : TConvertContext): TJSElement; virtual;
Function ConvertUnaryExpression(El: TUnaryExpr; AContext: TConvertContext): TJSElement; virtual;
Function ConvertInlineSpecializeExpr(El: TInlineSpecializeExpr; AContext: TConvertContext): TJSElement; virtual;
// Convert declarations
Function ConvertElement(El : TPasElement; AContext: TConvertContext) : TJSElement; virtual;
Function ConvertProperty(El: TPasProperty; AContext: TConvertContext ): TJSElement; virtual;
@ -6848,6 +6849,25 @@ begin
Result:=U;
end;
function TPasToJSConverter.ConvertInlineSpecializeExpr(
El: TInlineSpecializeExpr; AContext: TConvertContext): TJSElement;
var
aResolver: TPas2JSResolver;
DestType: TPasType;
GenType: TPasGenericType;
Name: String;
begin
aResolver:=AContext.Resolver;
DestType:=aResolver.ResolveAliasType(El.DestType);
if not (DestType is TPasGenericType) then
RaiseNotSupported(El,AContext,20190826143203,GetObjPath(DestType));
GenType:=TPasGenericType(DestType);
if (GenType.GenericTemplateTypes<>nil) and (GenType.GenericTemplateTypes.Count>0) then
RaiseNotSupported(El,AContext,20190826143508,GetObjName(GenType));
Name:=CreateReferencePath(GenType,AContext,rpkPathAndName);
Result:=CreatePrimitiveDotExpr(Name,El);
end;
function TPasToJSConverter.GetExpressionValueType(El: TPasExpr;
AContext: TConvertContext): TJSType;
@ -12759,31 +12779,36 @@ end;
function TPasToJSConverter.ConvertExpression(El: TPasExpr;
AContext: TConvertContext): TJSElement;
var
C: TClass;
begin
{$IFDEF VerbosePas2JS}
writeln('TPasToJSConverter.ConvertExpression El=',GetObjName(El),' Context=',GetObjName(AContext));
{$ENDIF}
Result:=Nil;
if (El.ClassType=TUnaryExpr) then
C:=El.ClassType;
if C=TUnaryExpr then
Result:=ConvertUnaryExpression(TUnaryExpr(El),AContext)
else if (El.ClassType=TBinaryExpr) then
else if C=TBinaryExpr then
Result:=ConvertBinaryExpression(TBinaryExpr(El),AContext)
else if (El.ClassType=TPrimitiveExpr) then
else if C=TPrimitiveExpr then
Result:=ConvertPrimitiveExpression(TPrimitiveExpr(El),AContext)
else if (El.ClassType=TBoolConstExpr) then
else if C=TBoolConstExpr then
Result:=ConvertBoolConstExpression(TBoolConstExpr(El),AContext)
else if (El.ClassType=TNilExpr) then
else if C=TNilExpr then
Result:=ConvertNilExpr(TNilExpr(El),AContext)
else if (El.ClassType=TInheritedExpr) then
else if C=TInheritedExpr then
Result:=ConvertInheritedExpr(TInheritedExpr(El),AContext)
else if (El.ClassType=TParamsExpr) then
else if C=TParamsExpr then
Result:=ConvertParamsExpr(TParamsExpr(El),AContext)
else if (El.ClassType=TProcedureExpr) then
else if C=TProcedureExpr then
Result:=ConvertProcedure(TProcedureExpr(El).Proc,AContext)
else if (El.ClassType=TRecordValues) then
else if C=TRecordValues then
Result:=ConvertRecordValues(TRecordValues(El),AContext)
else if (El.ClassType=TArrayValues) then
else if C=TArrayValues then
Result:=ConvertArrayValues(TArrayValues(El),AContext)
else if C=TInlineSpecializeExpr then
Result:=ConvertInlineSpecializeExpr(TInlineSpecializeExpr(El),AContext)
else
RaiseNotSupported(El,AContext,20161024191314);
end;

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

@ -24,6 +24,9 @@ type
// generic external class
procedure TestGen_ExtClass_Array;
// statements
Procedure TestGen_InlineSpec_Constructor;
end;
implementation
@ -263,6 +266,44 @@ begin
'']));
end;
procedure TTestGenerics.TestGen_InlineSpec_Constructor;
begin
StartProgram(false);
Add([
'{$mode objfpc}',
'type',
' TObject = class',
' public',
' constructor Create;',
' end;',
' generic TBird<T> = class',
' end;',
'constructor TObject.Create; begin end;',
'var b: TBird<word>;',
'begin',
' b:=specialize TBird<word>.Create;',
'']);
ConvertProgram;
CheckSource('TestGen_InlineSpec_Constructor',
LinesToStr([ // statements
'rtl.createClass($mod, "TObject", null, function () {',
' this.$init = function () {',
' };',
' this.$final = function () {',
' };',
' this.Create = function () {',
' return this;',
' };',
'});',
'rtl.createClass($mod, "TBird$G1", $mod.TObject, function () {',
'});',
'this.b = null;',
'']),
LinesToStr([ // $mod.$main
'$mod.b = $mod.TBird$G1.$create("Create");',
'']));
end;
Initialization
RegisterTests([TTestGenerics]);
end.