paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 22:09:32 +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 try
// add "var $mod = this;" // add "var $mod = this;"
IntfContext.ThisPas:=El; IntfContext.ThisPas:=El;
if El.CustomData is TPasModuleScope then
IntfContext.ScannerBoolSwitches:=TPasModuleScope(El.CustomData).ScannerBoolSwitches;
ModVarName:=FBuiltInNames[pbivnModule]; ModVarName:=FBuiltInNames[pbivnModule];
IntfContext.AddLocalVar(ModVarName,El); IntfContext.AddLocalVar(ModVarName,El);
AddToSourceElements(Src,CreateVarStatement(ModVarName, AddToSourceElements(Src,CreateVarStatement(ModVarName,
@ -4494,7 +4496,7 @@ begin
end; end;
if (LeftResolved.BaseType=btCustom) then if (LeftResolved.BaseType=btCustom) then
begin begin
// aJSValue is ... -> "rtl.isExt(A,B)" // aJSValue is ... -> "rtl.isExt(A,B,mode)"
Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnIsExt]]); Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnIsExt]]);
Call.AddArg(B); B:=nil; Call.AddArg(B); B:=nil;
if RightTypeEl is TPasClassType then if RightTypeEl is TPasClassType then
@ -5880,6 +5882,8 @@ var
Param: TPasExpr; Param: TPasExpr;
JSBaseType: TPas2jsBaseType; JSBaseType: TPas2jsBaseType;
C: TClass; C: TClass;
aName: String;
aClassTypeEl: TPasClassType;
begin begin
Result:=nil; Result:=nil;
if El.Kind<>pekFuncParams then if El.Kind<>pekFuncParams then
@ -5976,7 +5980,31 @@ begin
AContext.Resolver.ComputeElement(Param,ParamResolved,[]); AContext.Resolver.ComputeElement(Param,ParamResolved,[]);
Result:=ConvertElement(Param,AContext); 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 and (ParamResolved.TypeEl.CustomData is TResElDataPas2JSBaseType) then
begin begin
JSBaseType:=TResElDataPas2JSBaseType(ParamResolved.TypeEl.CustomData).JSBaseType; JSBaseType:=TResElDataPas2JSBaseType(ParamResolved.TypeEl.CustomData).JSBaseType;
@ -5995,15 +6023,6 @@ begin
end; end;
end; end;
if bsMethodCallChecks in AContext.ScannerBoolSwitches then
begin
if (C=TPasClassType)
or (C=TPasClassOfType) then
begin
end;
end;
exit; exit;
end end
else if C.InheritsFrom(TPasVariable) then else if C.InheritsFrom(TPasVariable) then
@ -12470,8 +12489,8 @@ var
begin begin
Result:=''; Result:='';
{$IFDEF VerbosePas2JS} {$IFDEF VerbosePas2JS}
writeln('TPasToJSConverter.CreateReferencePath START El=',GetObjName(El),' Parent=',GetObjName(El.Parent),' Context=',GetObjName(AContext),' SelfContext=',GetObjName(AContext.GetSelfContext)); //writeln('TPasToJSConverter.CreateReferencePath START El=',GetObjName(El),' Parent=',GetObjName(El.Parent),' Context=',GetObjName(AContext),' SelfContext=',GetObjName(AContext.GetSelfContext));
AContext.WriteStack; //AContext.WriteStack;
{$ENDIF} {$ENDIF}
if (El is TPasType) and (AContext<>nil) then if (El is TPasType) and (AContext<>nil) then
El:=AContext.Resolver.ResolveAliasType(TPasType(El)); El:=AContext.Resolver.ResolveAliasType(TPasType(El));

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

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