paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-09-23 03:59:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: typecast nil to class, interface, dynarray

Browse Source
This commit is contained in:
mattias 2019-07-30 15:37:03 +00:00
parent 0687f40919
commit 689d85f7f7
3 changed files with 20 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
compiler/packages/fcl-passrc/src/pasresolver.pp
View File

@ -21092,7 +21092,9 @@ begin
begin begin
if IsBaseType(FromResolved.LoTypeEl,btPointer) then if IsBaseType(FromResolved.LoTypeEl,btPointer) then
Result:=cExact; // untyped pointer to class instance Result:=cExact; // untyped pointer to class instance
end; end
else if FromResolved.BaseType=btNil then
Result:=cExact; // nil to class or interface
end end
else if C=TPasClassOfType then else if C=TPasClassOfType then
begin begin
@ -21113,7 +21115,9 @@ begin
begin begin
if IsBaseType(FromResolved.LoTypeEl,btPointer) then if IsBaseType(FromResolved.LoTypeEl,btPointer) then
Result:=cExact; // untyped pointer to class-of Result:=cExact; // untyped pointer to class-of
end; end
else if FromResolved.BaseType=btNil then
Result:=cExact; // nil to class-of
end end
else if C=TPasRecordType then else if C=TPasRecordType then
begin begin
@ -21144,7 +21148,12 @@ begin
begin begin
if IsDynArray(ToResolved.LoTypeEl) if IsDynArray(ToResolved.LoTypeEl)
and IsBaseType(FromResolved.LoTypeEl,btPointer) then and IsBaseType(FromResolved.LoTypeEl,btPointer) then
Result:=cExact; // untyped pointer to dynnamic array Result:=cExact; // untyped pointer to dynamic array
end
else if FromResolved.BaseType=btNil then
begin
if IsDynArray(ToResolved.LoTypeEl) then
Result:=cExact; // nil to dynamic array
end; end;
end end
else if (C=TPasProcedureType) or (C=TPasFunctionType) then else if (C=TPasProcedureType) or (C=TPasFunctionType) then
@ -21246,7 +21255,10 @@ begin
else else
Result:=cCompatible; Result:=cCompatible;
end; end;
end; end
else if FromResolved.BaseType=btNil then
// typecast nil to procedure type
Result:=cExact;
end end
else if C=TPasPointerType then else if C=TPasPointerType then
begin begin

3
compiler/packages/fcl-passrc/tests/tcresolver.pas
View File

@ -7275,7 +7275,7 @@ begin
Add('function GetIt: longint; begin end;'); Add('function GetIt: longint; begin end;');
Add('var s: smallint;'); Add('var s: smallint;');
Add('begin'); Add('begin');
Add(' s:=smallint(GetIt);'); Add(' s:=smallint(GetIt);');
ParseProgram; ParseProgram;
end; end;
@ -10053,6 +10053,7 @@ begin
Add(' ProcA(TClassA({@o}o));'); Add(' ProcA(TClassA({@o}o));');
Add(' if TClassA({@o}o).id=3 then ;'); Add(' if TClassA({@o}o).id=3 then ;');
Add(' if (o as TClassA).id=3 then ;'); Add(' if (o as TClassA).id=3 then ;');
Add(' o:=TObject(nil);');
ParseProgram; ParseProgram;
end; end;

2
compiler/packages/pastojs/tests/tcmodules.pas
View File

@ -13111,6 +13111,7 @@ begin
Add(' tcontrol(obj):=tcontrol(tcontrol(obj).getit());'); Add(' tcontrol(obj):=tcontrol(tcontrol(obj).getit());');
Add(' tcontrol(obj):=tcontrol(tcontrol(obj).getit(1));'); Add(' tcontrol(obj):=tcontrol(tcontrol(obj).getit(1));');
Add(' tcontrol(obj):=tcontrol(tcontrol(tcontrol(obj).getit).arr[2]);'); Add(' tcontrol(obj):=tcontrol(tcontrol(tcontrol(obj).getit).arr[2]);');
Add(' obj:=tcontrol(nil);');
ConvertProgram; ConvertProgram;
CheckSource('TestClass_TypeCast', CheckSource('TestClass_TypeCast',
LinesToStr([ // statements LinesToStr([ // statements
@ -13149,6 +13150,7 @@ begin
'$mod.Obj = $mod.Obj.GetIt(0);', '$mod.Obj = $mod.Obj.GetIt(0);',
'$mod.Obj = $mod.Obj.GetIt(1);', '$mod.Obj = $mod.Obj.GetIt(1);',
'$mod.Obj = $mod.Obj.GetIt(0).Arr[2];', '$mod.Obj = $mod.Obj.GetIt(0).Arr[2];',
'$mod.Obj = null;',
''])); '']));
end; end;