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

pastojs: check object type casts

Browse Source 
git-svn-id: trunk@38004 -
This commit is contained in:
Mattias Gaertner 2018-01-19 00:54:14 +00:00
parent 89382e0929
commit 7a55c7b0a1
2 changed files with 52 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3883,6 +3883,8 @@ begin
try
// add "var $mod = this;"
IntfContext.ThisPas:=El;
if El.CustomData is TPasModuleScope then
IntfContext.ScannerBoolSwitches:=TPasModuleScope(El.CustomData).ScannerBoolSwitches;
ModVarName:=FBuiltInNames[pbivnModule];
IntfContext.AddLocalVar(ModVarName,El);
AddToSourceElements(Src,CreateVarStatement(ModVarName,
@ -4494,7 +4496,7 @@ begin
end;
if (LeftResolved.BaseType=btCustom) then
begin
// aJSValue is ... -> "rtl.isExt(A,B)"
// aJSValue is ... -> "rtl.isExt(A,B,mode)"
Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnIsExt]]);
Call.AddArg(B); B:=nil;
if RightTypeEl is TPasClassType then
@ -5880,6 +5882,8 @@ var
Param: TPasExpr;
JSBaseType: TPas2jsBaseType;
C: TClass;
aName: String;
aClassTypeEl: TPasClassType;
begin
Result:=nil;
if El.Kind<>pekFuncParams then
@ -5976,7 +5980,31 @@ begin
AContext.Resolver.ComputeElement(Param,ParamResolved,[]);
Result:=ConvertElement(Param,AContext);
if (ParamResolved.BaseType=btCustom)
if bsMethodCallChecks in AContext.ScannerBoolSwitches then
begin
if (C=TPasClassType)
or (C=TPasClassOfType) then
begin
// TObject(value) -> rtl.asExt(value,type,mode)
if C=TPasClassOfType then
aClassTypeEl:=AContext.Resolver.ResolveAliasType(TPasClassOfType(Decl).DestType) as TPasClassType
else
aClassTypeEl:=TPasClassType(Decl);
aName:=CreateReferencePath(aClassTypeEl,AContext,rpkPathAndName);
Call:=CreateCallExpression(El);
Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnAsExt]]);
Call.AddArg(Result);
Call.AddArg(CreatePrimitiveDotExpr(aName,El.Value));
if aClassTypeEl.IsExternal then
else if C=TPasClassOfType then
Call.AddArg(CreateLiteralNumber(El.Value,IsExtModePasClass))
else
Call.AddArg(CreateLiteralNumber(El.Value,IsExtModePasClassInstance));
Result:=Call;
end;
end
else if (ParamResolved.BaseType=btCustom)
and (ParamResolved.TypeEl.CustomData is TResElDataPas2JSBaseType) then
begin
JSBaseType:=TResElDataPas2JSBaseType(ParamResolved.TypeEl.CustomData).JSBaseType;
@ -5995,15 +6023,6 @@ begin
end;
end;
if bsMethodCallChecks in AContext.ScannerBoolSwitches then
begin
if (C=TPasClassType)
or (C=TPasClassOfType) then
begin
end;
end;
exit;
end
else if C.InheritsFrom(TPasVariable) then
@ -12470,8 +12489,8 @@ var
begin
Result:='';
{$IFDEF VerbosePas2JS}
writeln('TPasToJSConverter.CreateReferencePath START El=',GetObjName(El),' Parent=',GetObjName(El.Parent),' Context=',GetObjName(AContext),' SelfContext=',GetObjName(AContext.GetSelfContext));
AContext.WriteStack;
//writeln('TPasToJSConverter.CreateReferencePath START El=',GetObjName(El),' Parent=',GetObjName(El.Parent),' Context=',GetObjName(AContext),' SelfContext=',GetObjName(AContext.GetSelfContext));
//AContext.WriteStack;
{$ENDIF}
if (El is TPasType) and (AContext<>nil) then
El:=AContext.Resolver.ResolveAliasType(TPasType(El));

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

@ -15925,12 +15925,23 @@ begin
' TObject = class',
' procedure DoIt;',
' end;',
' TClass = class of tobject;',
' TBird = class',
' end;',
' TBirdClass = class of TBird;',
'var',
' o : TObject;',
' c: TClass;',
' b: TBird;',
' bc: TBirdClass;',
'procedure TObject.DoIt;',
'begin',
' b:=TBird(o);',
'end;',
'var o : TObject;',
'begin',
' o.DoIt;',
' b:=TBird(o);',
' bc:=TBirdClass(c);',
'']);
ConvertProgram;
CheckSource('TestCheckMethodCall',
@ -15942,12 +15953,20 @@ begin
' };',
' this.DoIt = function () {',
' rtl.checkMethodCall(this,$mod.TObject);',
' $mod.b = rtl.asExt($mod.o, $mod.TBird, 1);',
' };',
'});',
'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
'});',
'this.o = null;',
'this.c = null;',
'this.b = null;',
'this.bc = null;',
'']),
LinesToStr([ // $mod.$main
'$mod.o.DoIt();',
'$mod.b = rtl.asExt($mod.o,$mod.TBird, 1);',
'$mod.bc = rtl.asExt($mod.c, $mod.TBird, 2);',
'']));
end;