Browse Source

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

git-svn-id: trunk@42534 -
Mattias Gaertner 6 years ago
parent
commit
aa7eb7bce3

+ 16 - 4
packages/fcl-passrc/src/pasresolver.pp

@@ -22060,7 +22060,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
@@ -22081,7 +22083,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
@@ -22112,7 +22116,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
@@ -22214,7 +22223,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

+ 2 - 1
packages/fcl-passrc/tests/tcresolver.pas

@@ -7385,7 +7385,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;
 
 
@@ -10205,6 +10205,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 - 0
packages/pastojs/tests/tcmodules.pas

@@ -13238,6 +13238,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
@@ -13276,6 +13277,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;