Browse Source

* changed goto usage in tcallnode.pass_typecheck into try/finally (and at
the same time solved some issues where "exit" instead of "goto errorexit"
was used)

git-svn-id: trunk@29817 -

Jonas Maebe 10 years ago
parent
commit
863e81315e
1 changed files with 415 additions and 415 deletions
  1. 415 415
      compiler/ncal.pas

+ 415 - 415
compiler/ncal.pas

@@ -2880,8 +2880,6 @@ implementation
         statements : tstatementnode;
         statements : tstatementnode;
         converted_result_data : ttempcreatenode;
         converted_result_data : ttempcreatenode;
         calltype: tdispcalltype;
         calltype: tdispcalltype;
-      label
-        errorexit;
       begin
       begin
          result:=nil;
          result:=nil;
          candidates:=nil;
          candidates:=nil;
@@ -2889,460 +2887,462 @@ implementation
          oldcallnode:=aktcallnode;
          oldcallnode:=aktcallnode;
          aktcallnode:=self;
          aktcallnode:=self;
 
 
-         { determine length of parameter list }
-         pt:=tcallparanode(left);
-         paralength:=0;
-         while assigned(pt) do
-          begin
-            inc(paralength);
-            pt:=tcallparanode(pt.right);
-          end;
+         try
+           { determine length of parameter list }
+           pt:=tcallparanode(left);
+           paralength:=0;
+           while assigned(pt) do
+            begin
+              inc(paralength);
+              pt:=tcallparanode(pt.right);
+            end;
 
 
-         { determine the type of the parameters }
-         if assigned(left) then
-          begin
-            tcallparanode(left).get_paratype;
-            if codegenerror then
-              goto errorexit;
-          end;
+           { determine the type of the parameters }
+           if assigned(left) then
+            begin
+              tcallparanode(left).get_paratype;
+              if codegenerror then
+                exit;
+            end;
 
 
-         if assigned(methodpointer) then
-           typecheckpass(methodpointer);
+           if assigned(methodpointer) then
+             typecheckpass(methodpointer);
 
 
-         { procedure variable ? }
-         if assigned(right) then
-           begin
-              set_varstate(right,vs_read,[vsf_must_be_valid]);
-              typecheckpass(right);
-              if codegenerror then
-               exit;
+           { procedure variable ? }
+           if assigned(right) then
+             begin
+                set_varstate(right,vs_read,[vsf_must_be_valid]);
+                typecheckpass(right);
+                if codegenerror then
+                  exit;
 
 
-              procdefinition:=tabstractprocdef(right.resultdef);
+                procdefinition:=tabstractprocdef(right.resultdef);
 
 
-              { Compare parameters from right to left }
-              paraidx:=procdefinition.Paras.count-1;
-              { Skip default parameters }
-              if not(po_varargs in procdefinition.procoptions) then
-                begin
-                  { ignore hidden parameters }
-                  while (paraidx>=0) and (vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) do
-                    dec(paraidx);
-                  for i:=1 to procdefinition.maxparacount-paralength do
-                    begin
-                      if paraidx<0 then
-                        internalerror(200402265);
-                      if not assigned(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym) then
-                        begin
-                          CGMessage1(parser_e_wrong_parameter_size,'<Procedure Variable>');
-                          goto errorexit;
-                        end;
+                { Compare parameters from right to left }
+                paraidx:=procdefinition.Paras.count-1;
+                { Skip default parameters }
+                if not(po_varargs in procdefinition.procoptions) then
+                  begin
+                    { ignore hidden parameters }
+                    while (paraidx>=0) and (vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) do
                       dec(paraidx);
                       dec(paraidx);
-                    end;
-                end;
-              while (paraidx>=0) and (vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) do
-                dec(paraidx);
-              pt:=tcallparanode(left);
-              lastpara:=paralength;
-              while (paraidx>=0) and assigned(pt) do
-                begin
-                  { only goto next para if we're out of the varargs }
-                  if not(po_varargs in procdefinition.procoptions) or
-                     (lastpara<=procdefinition.maxparacount) then
-                   begin
-                     repeat
-                       dec(paraidx);
-                     until (paraidx<0) or not(vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions);
-                   end;
-                  pt:=tcallparanode(pt.right);
-                  dec(lastpara);
-                end;
-              if assigned(pt) or
-                 ((paraidx>=0) and
-                  not assigned(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym)) then
-                begin
-                   if assigned(pt) then
-                     current_filepos:=pt.fileinfo;
-                   CGMessage1(parser_e_wrong_parameter_size,'<Procedure Variable>');
-                   goto errorexit;
-                end;
-           end
-         else
-         { not a procedure variable }
-           begin
-              { do we know the procedure to call ? }
-              if not(assigned(procdefinition)) then
-                begin
-                  { ignore possible private for properties or in delphi mode for anon. inherited (FK) }
-                  ignorevisibility:=(nf_isproperty in flags) or
-                                    ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags));
-                  candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,ignorevisibility,
-                    not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags,
-                    callnodeflags*[cnf_anon_inherited,cnf_inherited]=[],cnf_anon_inherited in callnodeflags);
-
-                   { no procedures found? then there is something wrong
-                     with the parameter size or the procedures are
-                     not accessible }
-                   if candidates.count=0 then
-                    begin
-                      { when it's an auto inherited call and there
-                        is no procedure found, but the procedures
-                        were defined with overload directive and at
-                        least two procedures are defined then we ignore
-                        this inherited by inserting a nothingn. Only
-                        do this ugly hack in Delphi mode as it looks more
-                        like a bug. It's also not documented }
-                      if (m_delphi in current_settings.modeswitches) and
-                         (cnf_anon_inherited in callnodeflags) and
-                         (symtableprocentry.owner.symtabletype=ObjectSymtable) and
-                         (po_overload in tprocdef(symtableprocentry.ProcdefList[0]).procoptions) and
-                         (symtableprocentry.ProcdefList.Count>=2) then
-                        result:=cnothingnode.create
-                      else
-                        begin
-                          { in tp mode we can try to convert to procvar if
-                            there are no parameters specified }
-                          if not(assigned(left)) and
-                             not(cnf_inherited in callnodeflags) and
-                             ((m_tp_procvar in current_settings.modeswitches) or
-                              (m_mac_procvar in current_settings.modeswitches)) and
-                             (not assigned(methodpointer) or
-                              (methodpointer.nodetype <> typen)) then
-                            begin
-                              hpt:=cloadnode.create(tprocsym(symtableprocentry),symtableproc);
-                              if assigned(methodpointer) then
-                                tloadnode(hpt).set_mp(methodpointer.getcopy);
-                              typecheckpass(hpt);
-                              result:=hpt;
-                            end
-                          else
-                            begin
-                              CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,symtableprocentry.realname);
-                              symtableprocentry.write_parameter_lists(nil);
-                            end;
-                        end;
-                      candidates.free;
-                      goto errorexit;
-                    end;
+                    for i:=1 to procdefinition.maxparacount-paralength do
+                      begin
+                        if paraidx<0 then
+                          internalerror(200402265);
+                        if not assigned(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym) then
+                          begin
+                            CGMessage1(parser_e_wrong_parameter_size,'<Procedure Variable>');
+                            exit;
+                          end;
+                        dec(paraidx);
+                      end;
+                  end;
+                while (paraidx>=0) and (vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) do
+                  dec(paraidx);
+                pt:=tcallparanode(left);
+                lastpara:=paralength;
+                while (paraidx>=0) and assigned(pt) do
+                  begin
+                    { only goto next para if we're out of the varargs }
+                    if not(po_varargs in procdefinition.procoptions) or
+                       (lastpara<=procdefinition.maxparacount) then
+                     begin
+                       repeat
+                         dec(paraidx);
+                       until (paraidx<0) or not(vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions);
+                     end;
+                    pt:=tcallparanode(pt.right);
+                    dec(lastpara);
+                  end;
+                if assigned(pt) or
+                   ((paraidx>=0) and
+                    not assigned(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym)) then
+                  begin
+                     if assigned(pt) then
+                       current_filepos:=pt.fileinfo;
+                     CGMessage1(parser_e_wrong_parameter_size,'<Procedure Variable>');
+                     exit;
+                  end;
+             end
+           else
+           { not a procedure variable }
+             begin
+                { do we know the procedure to call ? }
+                if not(assigned(procdefinition)) then
+                  begin
+                    { ignore possible private for properties or in delphi mode for anon. inherited (FK) }
+                    ignorevisibility:=(nf_isproperty in flags) or
+                                      ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags));
+                    candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,ignorevisibility,
+                      not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags,
+                      callnodeflags*[cnf_anon_inherited,cnf_inherited]=[],cnf_anon_inherited in callnodeflags);
+
+                     { no procedures found? then there is something wrong
+                       with the parameter size or the procedures are
+                       not accessible }
+                     if candidates.count=0 then
+                      begin
+                        { when it's an auto inherited call and there
+                          is no procedure found, but the procedures
+                          were defined with overload directive and at
+                          least two procedures are defined then we ignore
+                          this inherited by inserting a nothingn. Only
+                          do this ugly hack in Delphi mode as it looks more
+                          like a bug. It's also not documented }
+                        if (m_delphi in current_settings.modeswitches) and
+                           (cnf_anon_inherited in callnodeflags) and
+                           (symtableprocentry.owner.symtabletype=ObjectSymtable) and
+                           (po_overload in tprocdef(symtableprocentry.ProcdefList[0]).procoptions) and
+                           (symtableprocentry.ProcdefList.Count>=2) then
+                          result:=cnothingnode.create
+                        else
+                          begin
+                            { in tp mode we can try to convert to procvar if
+                              there are no parameters specified }
+                            if not(assigned(left)) and
+                               not(cnf_inherited in callnodeflags) and
+                               ((m_tp_procvar in current_settings.modeswitches) or
+                                (m_mac_procvar in current_settings.modeswitches)) and
+                               (not assigned(methodpointer) or
+                                (methodpointer.nodetype <> typen)) then
+                              begin
+                                hpt:=cloadnode.create(tprocsym(symtableprocentry),symtableproc);
+                                if assigned(methodpointer) then
+                                  tloadnode(hpt).set_mp(methodpointer.getcopy);
+                                typecheckpass(hpt);
+                                result:=hpt;
+                              end
+                            else
+                              begin
+                                CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,symtableprocentry.realname);
+                                symtableprocentry.write_parameter_lists(nil);
+                              end;
+                          end;
+                        candidates.free;
+                        exit;
+                      end;
 
 
-                   { Retrieve information about the candidates }
-                   candidates.get_information;
+                     { Retrieve information about the candidates }
+                     candidates.get_information;
 {$ifdef EXTDEBUG}
 {$ifdef EXTDEBUG}
-                   { Display info when multiple candidates are found }
-                   if candidates.count>1 then
-                     candidates.dump_info(V_Debug);
+                     { Display info when multiple candidates are found }
+                     if candidates.count>1 then
+                       candidates.dump_info(V_Debug);
 {$endif EXTDEBUG}
 {$endif EXTDEBUG}
 
 
-                   { Choose the best candidate and count the number of
-                     candidates left }
-                   cand_cnt:=candidates.choose_best(procdefinition,
-                     assigned(left) and
-                     not assigned(tcallparanode(left).right) and
-                     (tcallparanode(left).left.resultdef.typ=variantdef));
+                     { Choose the best candidate and count the number of
+                       candidates left }
+                     cand_cnt:=candidates.choose_best(procdefinition,
+                       assigned(left) and
+                       not assigned(tcallparanode(left).right) and
+                       (tcallparanode(left).left.resultdef.typ=variantdef));
 
 
-                   { All parameters are checked, check if there are any
-                     procedures left }
-                   if cand_cnt>0 then
-                    begin
-                      { Multiple candidates left? }
-                      if cand_cnt>1 then
-                       begin
-                         CGMessage(type_e_cant_choose_overload_function);
+                     { All parameters are checked, check if there are any
+                       procedures left }
+                     if cand_cnt>0 then
+                      begin
+                        { Multiple candidates left? }
+                        if cand_cnt>1 then
+                         begin
+                           CGMessage(type_e_cant_choose_overload_function);
 {$ifdef EXTDEBUG}
 {$ifdef EXTDEBUG}
-                         candidates.dump_info(V_Hint);
+                           candidates.dump_info(V_Hint);
 {$else EXTDEBUG}
 {$else EXTDEBUG}
-                         candidates.list(false);
+                           candidates.list(false);
 {$endif EXTDEBUG}
 {$endif EXTDEBUG}
-                         { we'll just use the first candidate to make the
-                           call }
-                       end;
+                           { we'll just use the first candidate to make the
+                             call }
+                         end;
 
 
-                      { assign procdefinition }
-                      if symtableproc=nil then
-                        symtableproc:=procdefinition.owner;
-                    end
-                   else
-                    begin
-                      { No candidates left, this must be a type error,
-                        because wrong size is already checked. procdefinition
-                        is filled with the first (random) definition that is
-                        found. We use this definition to display a nice error
-                        message that the wrong type is passed }
-                      candidates.find_wrong_para;
-                      candidates.list(true);
+                        { assign procdefinition }
+                        if symtableproc=nil then
+                          symtableproc:=procdefinition.owner;
+                      end
+                     else
+                      begin
+                        { No candidates left, this must be a type error,
+                          because wrong size is already checked. procdefinition
+                          is filled with the first (random) definition that is
+                          found. We use this definition to display a nice error
+                          message that the wrong type is passed }
+                        candidates.find_wrong_para;
+                        candidates.list(true);
 {$ifdef EXTDEBUG}
 {$ifdef EXTDEBUG}
-                      candidates.dump_info(V_Hint);
+                        candidates.dump_info(V_Hint);
 {$endif EXTDEBUG}
 {$endif EXTDEBUG}
 
 
-                      { We can not proceed, release all procs and exit }
-                      candidates.free;
-                      goto errorexit;
-                    end;
+                        { We can not proceed, release all procs and exit }
+                        candidates.free;
+                        exit;
+                      end;
 
 
-                   candidates.free;
-               end; { end of procedure to call determination }
-           end;
+                     candidates.free;
+                 end; { end of procedure to call determination }
+             end;
 
 
-          { check for hints (deprecated etc) }
-          if procdefinition.typ = procdef then
-            check_hints(tprocdef(procdefinition).procsym,tprocdef(procdefinition).symoptions,tprocdef(procdefinition).deprecatedmsg);
+            { check for hints (deprecated etc) }
+            if procdefinition.typ = procdef then
+              check_hints(tprocdef(procdefinition).procsym,tprocdef(procdefinition).symoptions,tprocdef(procdefinition).deprecatedmsg);
 
 
-          { add reference to corresponding procsym; may not be the one
-            originally found/passed to the constructor because of overloads }
-          if procdefinition.typ = procdef then
-            addsymref(tprocdef(procdefinition).procsym);
+            { add reference to corresponding procsym; may not be the one
+              originally found/passed to the constructor because of overloads }
+            if procdefinition.typ = procdef then
+              addsymref(tprocdef(procdefinition).procsym);
 
 
-          { add needed default parameters }
-          if (paralength<procdefinition.maxparacount) then
-           begin
-             paraidx:=0;
-             i:=0;
-             while (i<paralength) do
-              begin
-                if paraidx>=procdefinition.Paras.count then
-                  internalerror(200306181);
-                if not(vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) then
-                  inc(i);
-                inc(paraidx);
-              end;
-             while (paraidx<procdefinition.paras.count) and (vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) do
-               inc(paraidx);
-             while (paraidx<procdefinition.paras.count) do
-              begin
-                if not assigned(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym) then
-                 internalerror(200212142);
-                left:=ccallparanode.create(genconstsymtree(
-                    tconstsym(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym)),left);
-                { Ignore vs_hidden parameters }
-                repeat
+            { add needed default parameters }
+            if (paralength<procdefinition.maxparacount) then
+             begin
+               paraidx:=0;
+               i:=0;
+               while (i<paralength) do
+                begin
+                  if paraidx>=procdefinition.Paras.count then
+                    internalerror(200306181);
+                  if not(vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) then
+                    inc(i);
                   inc(paraidx);
                   inc(paraidx);
-                until (paraidx>=procdefinition.paras.count) or
-                  not(vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions);
-              end;
-           end;
+                end;
+               while (paraidx<procdefinition.paras.count) and (vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) do
+                 inc(paraidx);
+               while (paraidx<procdefinition.paras.count) do
+                begin
+                  if not assigned(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym) then
+                   internalerror(200212142);
+                  left:=ccallparanode.create(genconstsymtree(
+                      tconstsym(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym)),left);
+                  { Ignore vs_hidden parameters }
+                  repeat
+                    inc(paraidx);
+                  until (paraidx>=procdefinition.paras.count) or
+                    not(vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions);
+                end;
+             end;
 
 
-          { recursive call? }
-          if assigned(current_procinfo) and
-             (procdefinition=current_procinfo.procdef) then
-            include(current_procinfo.flags,pi_is_recursive);
-
-          { handle predefined procedures }
-          is_const:=(po_internconst in procdefinition.procoptions) and
-                    ((block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) or
-                     (assigned(left) and ((tcallparanode(left).left.nodetype in [realconstn,ordconstn])
-                      and (not assigned(tcallparanode(left).right) or (tcallparanode(left).right.nodetype in [realconstn,ordconstn])))));
-          if (procdefinition.proccalloption=pocall_internproc) or is_const then
-           begin
-             if assigned(left) then
-              begin
-                { convert types to those of the prototype, this is required by functions like ror, rol, sar
-                  some use however a dummy type (Typedfile) so this would break them }
-                if not(tprocdef(procdefinition).extnumber in [fpc_in_Reset_TypedFile,fpc_in_Rewrite_TypedFile]) then
-                  begin
-                    { bind parasyms to the callparanodes and insert hidden parameters }
-                    bind_parasym;
+            { recursive call? }
+            if assigned(current_procinfo) and
+               (procdefinition=current_procinfo.procdef) then
+              include(current_procinfo.flags,pi_is_recursive);
+
+            { handle predefined procedures }
+            is_const:=(po_internconst in procdefinition.procoptions) and
+                      ((block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) or
+                       (assigned(left) and ((tcallparanode(left).left.nodetype in [realconstn,ordconstn])
+                        and (not assigned(tcallparanode(left).right) or (tcallparanode(left).right.nodetype in [realconstn,ordconstn])))));
+            if (procdefinition.proccalloption=pocall_internproc) or is_const then
+             begin
+               if assigned(left) then
+                begin
+                  { convert types to those of the prototype, this is required by functions like ror, rol, sar
+                    some use however a dummy type (Typedfile) so this would break them }
+                  if not(tprocdef(procdefinition).extnumber in [fpc_in_Reset_TypedFile,fpc_in_Rewrite_TypedFile]) then
+                    begin
+                      { bind parasyms to the callparanodes and insert hidden parameters }
+                      bind_parasym;
 
 
-                    { insert type conversions for parameters }
-                    if assigned(left) then
-                      tcallparanode(left).insert_typeconv;
-                  end;
+                      { insert type conversions for parameters }
+                      if assigned(left) then
+                        tcallparanode(left).insert_typeconv;
+                    end;
 
 
-                { ptr and settextbuf need two args }
-                if assigned(tcallparanode(left).right) then
-                 begin
-                   hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,left);
-                   left:=nil;
-                 end
-                else
-                 begin
-                   hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,tcallparanode(left).left);
-                   tcallparanode(left).left:=nil;
-                 end;
-              end
-             else
-              hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,nil);
-             result:=hpt;
-             goto errorexit;
-           end;
+                  { ptr and settextbuf need two args }
+                  if assigned(tcallparanode(left).right) then
+                   begin
+                     hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,left);
+                     left:=nil;
+                   end
+                  else
+                   begin
+                     hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,tcallparanode(left).left);
+                     tcallparanode(left).left:=nil;
+                   end;
+                end
+               else
+                hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,nil);
+               result:=hpt;
+               exit;
+             end;
 
 
-         { ensure that the result type is set }
-         if not(cnf_typedefset in callnodeflags) then
-          begin
-            { constructors return their current class type, not the type where the
-              constructor is declared, this can be different because of inheritance }
-            if (procdefinition.proctypeoption=potype_constructor) and
-               assigned(methodpointer) and
-               assigned(methodpointer.resultdef) and
-               (methodpointer.resultdef.typ=classrefdef) then
-              resultdef:=tclassrefdef(methodpointer.resultdef).pointeddef
-            else
-            { Member call to a (inherited) constructor from the class, the return
-              value is always self, so we change it to voidtype to generate an
-              error and to prevent users from generating non-working code
-              when they expect to clone the current instance, see bug 3662 (PFV) }
+           { ensure that the result type is set }
+           if not(cnf_typedefset in callnodeflags) then
+            begin
+              { constructors return their current class type, not the type where the
+                constructor is declared, this can be different because of inheritance }
               if (procdefinition.proctypeoption=potype_constructor) and
               if (procdefinition.proctypeoption=potype_constructor) and
-                 is_class(tprocdef(procdefinition).struct) and
                  assigned(methodpointer) and
                  assigned(methodpointer) and
-                 (methodpointer.nodetype=loadn) and
-                 (loadnf_is_self in tloadnode(methodpointer).loadnodeflags) then
-                resultdef:=voidtype
+                 assigned(methodpointer.resultdef) and
+                 (methodpointer.resultdef.typ=classrefdef) then
+                resultdef:=tclassrefdef(methodpointer.resultdef).pointeddef
               else
               else
-                resultdef:=procdefinition.returndef;
-           end
-         else
-           resultdef:=typedef;
-
-         { Check object/class for methods }
-         if assigned(methodpointer) then
-          begin
-            { direct call to inherited abstract method, then we
-              can already give a error in the compiler instead
-              of a runtime error }
-            if (cnf_inherited in callnodeflags) and
-               (po_abstractmethod in procdefinition.procoptions) then
-              begin
-                if (m_delphi in current_settings.modeswitches) and
-                  (cnf_anon_inherited in callnodeflags) then
-                  begin
-                    CGMessage(cg_h_inherited_ignored);
-                    result:=cnothingnode.create;
-                    exit;
-                  end
+              { Member call to a (inherited) constructor from the class, the return
+                value is always self, so we change it to voidtype to generate an
+                error and to prevent users from generating non-working code
+                when they expect to clone the current instance, see bug 3662 (PFV) }
+                if (procdefinition.proctypeoption=potype_constructor) and
+                   is_class(tprocdef(procdefinition).struct) and
+                   assigned(methodpointer) and
+                   (methodpointer.nodetype=loadn) and
+                   (loadnf_is_self in tloadnode(methodpointer).loadnodeflags) then
+                  resultdef:=voidtype
                 else
                 else
-                  CGMessage(cg_e_cant_call_abstract_method);
-              end;
+                  resultdef:=procdefinition.returndef;
+             end
+           else
+             resultdef:=typedef;
 
 
-            { directly calling an interface/protocol/category/class helper
-              method via its type is not possible (always must be called via
-              the actual instance) }
-            if (methodpointer.nodetype=typen) and
-               (is_interface(methodpointer.resultdef) or
-                is_objc_protocol_or_category(methodpointer.resultdef)) then
-              CGMessage1(type_e_class_type_expected,methodpointer.resultdef.typename);
-
-            { if an inherited con- or destructor should be  }
-            { called in a con- or destructor then a warning }
-            { will be made                                  }
-            { con- and destructors need a pointer to the vmt }
-            if (cnf_inherited in callnodeflags) and
-               (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) and
-               is_object(methodpointer.resultdef) and
-               not(current_procinfo.procdef.proctypeoption in [potype_constructor,potype_destructor]) then
-             CGMessage(cg_w_member_cd_call_from_method);
-
-            if methodpointer.nodetype<>typen then
-             begin
-                { Remove all postfix operators }
-                hpt:=methodpointer;
-                while assigned(hpt) and (hpt.nodetype in [subscriptn,vecn]) do
-                  hpt:=tunarynode(hpt).left;
-
-                if ((hpt.nodetype=loadvmtaddrn) or
-                   ((hpt.nodetype=loadn) and assigned(tloadnode(hpt).resultdef) and (tloadnode(hpt).resultdef.typ=classrefdef))) and
-                   not (procdefinition.proctypeoption=potype_constructor) and
-                   not (po_classmethod in procdefinition.procoptions) and
-                   not (po_staticmethod in procdefinition.procoptions) then
-                  { error: we are calling instance method from the class method/static method }
-                  CGMessage(parser_e_only_class_members);
-
-               if (procdefinition.proctypeoption=potype_constructor) and
-                  assigned(symtableproc) and
-                  (symtableproc.symtabletype=withsymtable) and
-                  (tnode(twithsymtable(symtableproc).withrefnode).nodetype=temprefn) then
-                 CGmessage(cg_e_cannot_call_cons_dest_inside_with);
-
-               { skip (absolute and other simple) type conversions -- only now,
-                 because the checks above have to take type conversions into
-                 e.g. class reference types account }
-               hpt:=actualtargetnode(@hpt)^;
-
-               { R.Init then R will be initialized by the constructor,
-                 Also allow it for simple loads }
-               if (procdefinition.proctypeoption=potype_constructor) or
-                  ((hpt.nodetype=loadn) and
-                   (((methodpointer.resultdef.typ=objectdef) and
-                     not(oo_has_virtual in tobjectdef(methodpointer.resultdef).objectoptions)) or
-                    (methodpointer.resultdef.typ=recorddef)
-                   )
-                  ) then
-                 { a constructor will and a method may write something to }
-                 { the fields                                             }
-                 set_varstate(methodpointer,vs_readwritten,[])
-               else
-                 set_varstate(methodpointer,vs_read,[vsf_must_be_valid]);
-             end;
+           { Check object/class for methods }
+           if assigned(methodpointer) then
+            begin
+              { direct call to inherited abstract method, then we
+                can already give a error in the compiler instead
+                of a runtime error }
+              if (cnf_inherited in callnodeflags) and
+                 (po_abstractmethod in procdefinition.procoptions) then
+                begin
+                  if (m_delphi in current_settings.modeswitches) and
+                    (cnf_anon_inherited in callnodeflags) then
+                    begin
+                      CGMessage(cg_h_inherited_ignored);
+                      result:=cnothingnode.create;
+                      exit;
+                    end
+                  else
+                    CGMessage(cg_e_cant_call_abstract_method);
+                end;
 
 
-            { if we are calling the constructor check for abstract
-              methods. Ignore inherited and member calls, because the
-              class is then already created }
-            if (procdefinition.proctypeoption=potype_constructor) and
-               not(cnf_inherited in callnodeflags) and
-               not(cnf_member_call in callnodeflags) then
-              verifyabstractcalls;
-          end
-         else
-          begin
-            { When this is method the methodpointer must be available }
-            if (right=nil) and
-               (procdefinition.owner.symtabletype in [ObjectSymtable,recordsymtable]) and
-               not procdefinition.no_self_node then
-              internalerror(200305061);
-          end;
+              { directly calling an interface/protocol/category/class helper
+                method via its type is not possible (always must be called via
+                the actual instance) }
+              if (methodpointer.nodetype=typen) and
+                 (is_interface(methodpointer.resultdef) or
+                  is_objc_protocol_or_category(methodpointer.resultdef)) then
+                CGMessage1(type_e_class_type_expected,methodpointer.resultdef.typename);
+
+              { if an inherited con- or destructor should be  }
+              { called in a con- or destructor then a warning }
+              { will be made                                  }
+              { con- and destructors need a pointer to the vmt }
+              if (cnf_inherited in callnodeflags) and
+                 (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) and
+                 is_object(methodpointer.resultdef) and
+                 not(current_procinfo.procdef.proctypeoption in [potype_constructor,potype_destructor]) then
+               CGMessage(cg_w_member_cd_call_from_method);
+
+              if methodpointer.nodetype<>typen then
+               begin
+                  { Remove all postfix operators }
+                  hpt:=methodpointer;
+                  while assigned(hpt) and (hpt.nodetype in [subscriptn,vecn]) do
+                    hpt:=tunarynode(hpt).left;
+
+                  if ((hpt.nodetype=loadvmtaddrn) or
+                     ((hpt.nodetype=loadn) and assigned(tloadnode(hpt).resultdef) and (tloadnode(hpt).resultdef.typ=classrefdef))) and
+                     not (procdefinition.proctypeoption=potype_constructor) and
+                     not (po_classmethod in procdefinition.procoptions) and
+                     not (po_staticmethod in procdefinition.procoptions) then
+                    { error: we are calling instance method from the class method/static method }
+                    CGMessage(parser_e_only_class_members);
+
+                 if (procdefinition.proctypeoption=potype_constructor) and
+                    assigned(symtableproc) and
+                    (symtableproc.symtabletype=withsymtable) and
+                    (tnode(twithsymtable(symtableproc).withrefnode).nodetype=temprefn) then
+                   CGmessage(cg_e_cannot_call_cons_dest_inside_with);
+
+                 { skip (absolute and other simple) type conversions -- only now,
+                   because the checks above have to take type conversions into
+                   e.g. class reference types account }
+                 hpt:=actualtargetnode(@hpt)^;
+
+                 { R.Init then R will be initialized by the constructor,
+                   Also allow it for simple loads }
+                 if (procdefinition.proctypeoption=potype_constructor) or
+                    ((hpt.nodetype=loadn) and
+                     (((methodpointer.resultdef.typ=objectdef) and
+                       not(oo_has_virtual in tobjectdef(methodpointer.resultdef).objectoptions)) or
+                      (methodpointer.resultdef.typ=recorddef)
+                     )
+                    ) then
+                   { a constructor will and a method may write something to }
+                   { the fields                                             }
+                   set_varstate(methodpointer,vs_readwritten,[])
+                 else
+                   set_varstate(methodpointer,vs_read,[vsf_must_be_valid]);
+               end;
 
 
-         { Set flag that the procedure uses varargs, also if they are not passed it is still
-           needed for x86_64 to pass the number of SSE registers used }
-         if po_varargs in procdefinition.procoptions then
-           include(callnodeflags,cnf_uses_varargs);
+              { if we are calling the constructor check for abstract
+                methods. Ignore inherited and member calls, because the
+                class is then already created }
+              if (procdefinition.proctypeoption=potype_constructor) and
+                 not(cnf_inherited in callnodeflags) and
+                 not(cnf_member_call in callnodeflags) then
+                verifyabstractcalls;
+            end
+           else
+            begin
+              { When this is method the methodpointer must be available }
+              if (right=nil) and
+                 (procdefinition.owner.symtabletype in [ObjectSymtable,recordsymtable]) and
+                 not procdefinition.no_self_node then
+                internalerror(200305061);
+            end;
 
 
-         { set the appropriate node flag if the call never returns }
-         if po_noreturn in procdefinition.procoptions then
-           include(callnodeflags,cnf_call_never_returns);
+           { Set flag that the procedure uses varargs, also if they are not passed it is still
+             needed for x86_64 to pass the number of SSE registers used }
+           if po_varargs in procdefinition.procoptions then
+             include(callnodeflags,cnf_uses_varargs);
 
 
-         { Change loading of array of const to varargs }
-         if assigned(left) and
-            is_array_of_const(tparavarsym(procdefinition.paras[procdefinition.paras.count-1]).vardef) and
-            (procdefinition.proccalloption in cdecl_pocalls) then
-           convert_carg_array_of_const;
+           { set the appropriate node flag if the call never returns }
+           if po_noreturn in procdefinition.procoptions then
+             include(callnodeflags,cnf_call_never_returns);
 
 
-         { bind parasyms to the callparanodes and insert hidden parameters }
-         bind_parasym;
+           { Change loading of array of const to varargs }
+           if assigned(left) and
+              is_array_of_const(tparavarsym(procdefinition.paras[procdefinition.paras.count-1]).vardef) and
+              (procdefinition.proccalloption in cdecl_pocalls) then
+             convert_carg_array_of_const;
 
 
-         { insert type conversions for parameters }
-         if assigned(left) then
-           tcallparanode(left).insert_typeconv;
+           { bind parasyms to the callparanodes and insert hidden parameters }
+           bind_parasym;
 
 
-         { dispinterface methode invoke? }
-         if assigned(methodpointer) and is_dispinterface(methodpointer.resultdef) then
-           begin
-             case procdefinition.proctypeoption of
-               potype_propgetter: calltype:=dct_propget;
-               potype_propsetter: calltype:=dct_propput;
-             else
-               calltype:=dct_method;
-             end;
-             { if the result is used, we've to insert a call to convert the type to be on the "safe side" }
-             if (cnf_return_value_used in callnodeflags) and not is_void(procdefinition.returndef) then
-               begin
-                 result:=internalstatements(statements);
-                 converted_result_data:=ctempcreatenode.create(procdefinition.returndef,sizeof(procdefinition.returndef),
-                   tt_persistent,true);
-                 addstatement(statements,converted_result_data);
-                 addstatement(statements,cassignmentnode.create(ctemprefnode.create(converted_result_data),
-                   ctypeconvnode.create_internal(
-                     translate_disp_call(methodpointer,parameters,calltype,'',tprocdef(procdefinition).dispid,procdefinition.returndef),
-                   procdefinition.returndef)));
-                 addstatement(statements,ctempdeletenode.create_normal_temp(converted_result_data));
-                 addstatement(statements,ctemprefnode.create(converted_result_data));
-               end
-             else
-               result:=translate_disp_call(methodpointer,parameters,calltype,'',tprocdef(procdefinition).dispid,voidtype);
+           { insert type conversions for parameters }
+           if assigned(left) then
+             tcallparanode(left).insert_typeconv;
 
 
-             { don't free reused nodes }
-             methodpointer:=nil;
-             parameters:=nil;
-           end;
+           { dispinterface methode invoke? }
+           if assigned(methodpointer) and is_dispinterface(methodpointer.resultdef) then
+             begin
+               case procdefinition.proctypeoption of
+                 potype_propgetter: calltype:=dct_propget;
+                 potype_propsetter: calltype:=dct_propput;
+               else
+                 calltype:=dct_method;
+               end;
+               { if the result is used, we've to insert a call to convert the type to be on the "safe side" }
+               if (cnf_return_value_used in callnodeflags) and not is_void(procdefinition.returndef) then
+                 begin
+                   result:=internalstatements(statements);
+                   converted_result_data:=ctempcreatenode.create(procdefinition.returndef,sizeof(procdefinition.returndef),
+                     tt_persistent,true);
+                   addstatement(statements,converted_result_data);
+                   addstatement(statements,cassignmentnode.create(ctemprefnode.create(converted_result_data),
+                     ctypeconvnode.create_internal(
+                       translate_disp_call(methodpointer,parameters,calltype,'',tprocdef(procdefinition).dispid,procdefinition.returndef),
+                     procdefinition.returndef)));
+                   addstatement(statements,ctempdeletenode.create_normal_temp(converted_result_data));
+                   addstatement(statements,ctemprefnode.create(converted_result_data));
+                 end
+               else
+                 result:=translate_disp_call(methodpointer,parameters,calltype,'',tprocdef(procdefinition).dispid,voidtype);
 
 
-      errorexit:
-         aktcallnode:=oldcallnode;
+               { don't free reused nodes }
+               methodpointer:=nil;
+               parameters:=nil;
+             end;
+
+         finally
+           aktcallnode:=oldcallnode;
+         end;
       end;
       end;