* forbid passing derived classes to call by reference parent classes (for objects, this is still allowed), resolves #13135

git-svn-id: trunk@13551 -

.gitattributes

@@ -9164,6 +9164,7 @@ tests/webtbs/tw13075.pp svneol=native#text/plain
 tests/webtbs/tw1310.pp svneol=native#text/plain
 tests/webtbs/tw13110.pp svneol=native#text/plain
 tests/webtbs/tw13133.pp svneol=native#text/plain
+tests/webtbs/tw13135.pp svneol=native#text/plain
 tests/webtbs/tw1318.pp svneol=native#text/plain
 tests/webtbs/tw13186.pp svneol=native#text/plain
 tests/webtbs/tw13187.pp svneol=native#text/plain

compiler/htypechk.pas

@@ -503,7 +503,7 @@ implementation
         { Display info when multiple candidates are found }
         candidates.dump_info(V_Debug);
 {$endif EXTDEBUG}
-        cand_cnt:=candidates.choose_best(operpd,false);
+        cand_cnt:=candidates.choose_best(tabstractprocdef(operpd),false);
 
         { exit when no overloads are found }
         if cand_cnt=0 then
@@ -649,7 +649,7 @@ implementation
         { Display info when multiple candidates are found }
         candidates.dump_info(V_Debug);
 {$endif EXTDEBUG}
-        cand_cnt:=candidates.choose_best(operpd,false);
+        cand_cnt:=candidates.choose_best(tabstractprocdef(operpd),false);
 
         { exit when no overloads are found }
         if cand_cnt=0 then
@@ -1519,16 +1519,8 @@ implementation
               { if they are objects              }
               if (def_from.typ=objectdef) and
                  (
-                  (
-                   not(m_delphi in current_settings.modeswitches) and
-                   (tobjectdef(def_from).objecttype in [odt_object,odt_class]) and
-                   (tobjectdef(def_to).objecttype in [odt_object,odt_class])
-                  ) or
-                  (
-                   (m_delphi in current_settings.modeswitches) and
-                   (tobjectdef(def_from).objecttype=odt_object) and
-                   (tobjectdef(def_to).objecttype=odt_object)
-                  )
+                  (tobjectdef(def_from).objecttype=odt_object) and
+                  (tobjectdef(def_to).objecttype=odt_object)
                  ) and
                  (tobjectdef(def_from).is_related(tobjectdef(def_to))) then
                 eq:=te_convert_l1;

compiler/ncal.pas

@@ -738,7 +738,7 @@ implementation
                      { release temp after next use }
                      addstatement(statements,ctempdeletenode.create_normal_temp(temp));
                      addstatement(statements,ctemprefnode.create(temp));
-                     typecheckpass(block);
+                     typecheckpass(tnode(block));
                      left:=block;
                    end;
 
@@ -2842,13 +2842,13 @@ implementation
          { (simplify depends on typecheck info)        }
          if assigned(callinitblock) then
            begin
-             typecheckpass(callinitblock);
-             dosimplify(callinitblock);
+             typecheckpass(tnode(callinitblock));
+             dosimplify(tnode(callinitblock));
            end;
          if assigned(callcleanupblock) then
            begin
-             typecheckpass(callcleanupblock);
-             dosimplify(callcleanupblock);
+             typecheckpass(tnode(callcleanupblock));
+             dosimplify(tnode(callcleanupblock));
            end;
 
          { Continue with checking a normal call or generate the inlined code }
@@ -2885,7 +2885,7 @@ implementation
            check_stack_parameters;
 
          if assigned(callinitblock) then
-           firstpass(callinitblock);
+           firstpass(tnode(callinitblock));
 
          { function result node (tempref or simple load) }
          if assigned(funcretnode) then
@@ -2904,7 +2904,7 @@ implementation
            firstpass(methodpointer);
 
          if assigned(callcleanupblock) then
-           firstpass(callcleanupblock);
+           firstpass(tnode(callcleanupblock));
 
          if not (block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) then
            include(current_procinfo.flags,pi_do_call);
@@ -3358,9 +3358,9 @@ implementation
         { consider it must not be inlined if called
           again inside the args or itself }
         exclude(procdefinition.procoptions,po_inline);
-        typecheckpass(inlineblock);
-        dosimplify(inlineblock);
-        firstpass(inlineblock);
+        typecheckpass(tnode(inlineblock));
+        dosimplify(tnode(inlineblock));
+        firstpass(tnode(inlineblock));
         include(procdefinition.procoptions,po_inline);
         result:=inlineblock;
 

compiler/ncgcal.pas

@@ -935,7 +935,7 @@ implementation
            internalerror(200305264);
 
          if assigned(callinitblock) then
-           secondpass(callinitblock);
+           secondpass(tnode(callinitblock));
 
          regs_to_save_int:=paramanager.get_volatile_registers_int(procdefinition.proccalloption);
          regs_to_save_fpu:=paramanager.get_volatile_registers_fpu(procdefinition.proccalloption);
@@ -1203,7 +1203,7 @@ implementation
 
          { convert persistent temps for parameters and function result to normal temps }
          if assigned(callcleanupblock) then
-           secondpass(callcleanupblock);
+           secondpass(tnode(callcleanupblock));
 
          { release temps and finalize unused return values, must be
            after the callcleanupblock because that converts temps

compiler/ninl.pas

@@ -1062,9 +1062,9 @@ implementation
         left := nil;
 
         if is_typed then
-          found_error:=handle_typed_read_write(filepara,Ttertiarynode(params),newstatement)
+          found_error:=handle_typed_read_write(filepara,Ttertiarynode(params),tnode(newstatement))
         else
-          found_error:=handle_text_read_write(filepara,Ttertiarynode(params),newstatement);
+          found_error:=handle_text_read_write(filepara,Ttertiarynode(params),tnode(newstatement));
 
         { if we found an error, simply delete the generated blocknode }
         if found_error then
@@ -2647,7 +2647,7 @@ implementation
                    if assigned(tempnode) then
                      addstatement(newstatement,ctempdeletenode.create(tempnode));
                    { firstpass it }
-                   firstpass(newblock);
+                   firstpass(tnode(newblock));
                    { return new node }
                    result := newblock;
                  end;

compiler/nutils.pas

@@ -115,10 +115,10 @@ implementation
             end;
           calln:
             begin
-              result := foreachnode(procmethod,tcallnode(n).callinitblock,f,arg) or result;
+              result := foreachnode(procmethod,tnode(tcallnode(n).callinitblock),f,arg) or result;
               result := foreachnode(procmethod,tcallnode(n).methodpointer,f,arg) or result;
               result := foreachnode(procmethod,tcallnode(n).funcretnode,f,arg) or result;
-              result := foreachnode(procmethod,tcallnode(n).callcleanupblock,f,arg) or result;
+              result := foreachnode(procmethod,tnode(tcallnode(n).callcleanupblock),f,arg) or result;
             end;
           ifn, whilerepeatn, forn, tryexceptn, tryfinallyn:
             begin
@@ -194,10 +194,10 @@ implementation
             end;
           calln:
             begin
-              result := foreachnodestatic(procmethod,tcallnode(n).callinitblock,f,arg) or result;
+              result := foreachnodestatic(procmethod,tnode(tcallnode(n).callinitblock),f,arg) or result;
               result := foreachnodestatic(procmethod,tcallnode(n).methodpointer,f,arg) or result;
               result := foreachnodestatic(procmethod,tcallnode(n).funcretnode,f,arg) or result;
-              result := foreachnodestatic(procmethod,tcallnode(n).callcleanupblock,f,arg) or result;
+              result := foreachnodestatic(procmethod,tnode(tcallnode(n).callcleanupblock),f,arg) or result;
             end;
           ifn, whilerepeatn, forn, tryexceptn, tryfinallyn:
             begin

compiler/optloop.pas

@@ -416,9 +416,9 @@ unit optloop;
         { clue everything together }
         if assigned(initcode) then
           begin
-            do_firstpass(initcode);
-            do_firstpass(calccode);
-            do_firstpass(deletecode);
+            do_firstpass(tnode(initcode));
+            do_firstpass(tnode(calccode));
+            do_firstpass(tnode(deletecode));
             { create a new for node, the old one will be released by the compiler }
             with tfornode(node) do
               begin

compiler/pstatmnt.pas

@@ -544,7 +544,7 @@ implementation
                   hdef:=tpointerdef.create(p.resultdef);
                 { load address of the value in a temp }
                 tempnode:=ctempcreatenode.create_withnode(hdef,sizeof(pint),tt_persistent,true,p);
-                typecheckpass(tempnode);
+                typecheckpass(tnode(tempnode));
                 valuenode:=p;
                 refnode:=ctemprefnode.create(tempnode);
                 fillchar(refnode.fileinfo,sizeof(tfileposinfo),0);

compiler/psub.pas

@@ -616,7 +616,7 @@ implementation
             addstatement(newstatement,bodyexitcode);
             addstatement(newstatement,final_asmnode);
           end;
-        do_firstpass(newblock);
+        do_firstpass(tnode(newblock));
         code:=newblock;
         current_filepos:=oldfilepos;
       end;

packages/fcl-process/src/process.pp

@@ -82,7 +82,7 @@ Type
     procedure SetActive(const Value: Boolean);
     procedure SetEnvironment(const Value: TStrings);
     function  PeekExitStatus: Boolean;
-  Protected  
+  Protected
     FRunning : Boolean;
     FExitCode : Cardinal;
     FInputStream  : TOutputPipeStream;
@@ -134,7 +134,7 @@ Type
     Property WindowWidth : Cardinal Read dwXSize Write SetWindowWidth;
     Property FillAttribute : Cardinal read FFillAttribute Write FFillAttribute;
   end;
-  
+
   EProcess = Class(Exception);
 
 implementation
@@ -178,9 +178,9 @@ end;
 Procedure TProcess.FreeStreams;
 begin
   If FStderrStream<>FOutputStream then
-    FreeStream(FStderrStream);
-  FreeStream(FOutputStream);
-  FreeStream(FInputStream);
+    FreeStream(THandleStream(FStderrStream));
+  FreeStream(THandleStream(FOutputStream));
+  FreeStream(THandleStream(FInputStream));
 end;
 
 
@@ -221,17 +221,17 @@ end;
 
 procedure TProcess.CloseInput;
 begin
-  FreeStream(FInputStream);
+  FreeStream(THandleStream(FInputStream));
 end;
 
 procedure TProcess.CloseOutput;
 begin
-  FreeStream(FOutputStream);
+  FreeStream(THandleStream(FOutputStream));
 end;
 
 procedure TProcess.CloseStderr;
 begin
-  FreeStream(FStderrStream);
+  FreeStream(THandleStream(FStderrStream));
 end;
 
 Procedure TProcess.SetWindowColumns (Value : Cardinal);

tests/webtbs/tw13135.pp

@@ -0,0 +1,22 @@
+{ %fail }
+{$mode objfpc}
+
+type
+  ta = class
+  end;
+
+  tb = class(ta)
+  end;
+
+procedure test(var a: ta);
+begin
+  a.free;
+  a:=ta.create;
+  // now b contains an instance of type "ta"
+end;
+
+var
+  b: tb;
+begin
+  test(b);
+end.