* fixed various crashes

compiler/ncal.pas

@@ -2163,7 +2163,8 @@ type
          else
           begin
             { When this is method the methodpointer must be available }
-            if procdefinition.owner.symtabletype=objectsymtable then
+            if (right=nil) and
+               (procdefinition.owner.symtabletype=objectsymtable) then
               internalerror(200305061);
           end;
 
@@ -2729,7 +2730,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.151  2003-05-11 21:37:03  peter
+  Revision 1.152  2003-05-13 15:18:49  peter
+    * fixed various crashes
+
+  Revision 1.151  2003/05/11 21:37:03  peter
     * moved implicit exception frame from ncgutil to psub
     * constructor/destructor helpers moved from cobj/ncgutil to psub
 

compiler/pdecsub.pas

@@ -796,61 +796,75 @@ implementation
             begin
               consume(_FUNCTION);
               pd:=parse_proc_head(aclass,potype_none);
-              if token<>_COLON then
-               begin
-                  if (
-                      not(is_interface(pd._class)) and
-                      not(pd.forwarddef)
-                     ) or
-                     (m_repeat_forward in aktmodeswitches) then
-                  begin
-                    consume(_COLON);
-                    consume_all_until(_SEMICOLON);
-                  end;
-               end
+              if assigned(pd) then
+                begin
+                  if try_to_consume(_COLON) then
+                   begin
+                     inc(testcurobject);
+                     single_type(pd.rettype,hs,false);
+                     pd.test_if_fpu_result;
+                     if (pd.rettype.def.deftype=stringdef) and
+                        (tstringdef(pd.rettype.def).string_typ<>st_shortstring) then
+                       include(current_procinfo.flags,pi_needs_implicit_finally);
+                     dec(testcurobject);
+                   end
+                  else
+                   begin
+                      if (
+                          not(is_interface(pd._class)) and
+                          not(pd.forwarddef)
+                         ) or
+                         (m_repeat_forward in aktmodeswitches) then
+                      begin
+                        consume(_COLON);
+                        consume_all_until(_SEMICOLON);
+                      end;
+                   end;
+                  if isclassmethod then
+                   include(pd.procoptions,po_classmethod);
+                end
               else
-               begin
-                 consume(_COLON);
-                 inc(testcurobject);
-                 single_type(pd.rettype,hs,false);
-                 pd.test_if_fpu_result;
-                 if (pd.rettype.def.deftype=stringdef) and
-                    (tstringdef(pd.rettype.def).string_typ<>st_shortstring) then
-                   include(current_procinfo.flags,pi_needs_implicit_finally);
-                 dec(testcurobject);
-               end;
-              if isclassmethod then
-               include(pd.procoptions,po_classmethod);
+                begin
+                  { recover }
+                  consume(_COLON);
+                  consume_all_until(_SEMICOLON);
+                end;
             end;
 
           _PROCEDURE :
             begin
               consume(_PROCEDURE);
               pd:=parse_proc_head(aclass,potype_none);
-              pd.rettype:=voidtype;
-              if isclassmethod then
-               include(pd.procoptions,po_classmethod);
+              if assigned(pd) then
+                begin
+                  pd.rettype:=voidtype;
+                  if isclassmethod then
+                    include(pd.procoptions,po_classmethod);
+                end;
             end;
 
           _CONSTRUCTOR :
             begin
               consume(_CONSTRUCTOR);
               pd:=parse_proc_head(aclass,potype_constructor);
-              if not assigned(pd._class) then
-               internalerror(200304263);
-              { Set return type, class constructors return the
-                created instance, object constructors return boolean }
-              if is_class(pd._class) then
-               pd.rettype.setdef(pd._class)
-              else
-               pd.rettype:=booltype;
+              if assigned(pd) and
+                 assigned(pd._class) then
+                begin
+                  { Set return type, class constructors return the
+                    created instance, object constructors return boolean }
+                  if is_class(pd._class) then
+                   pd.rettype.setdef(pd._class)
+                  else
+                   pd.rettype:=booltype;
+                end;
             end;
 
           _DESTRUCTOR :
             begin
               consume(_DESTRUCTOR);
               pd:=parse_proc_head(aclass,potype_destructor);
-              pd.rettype:=voidtype;
+              if assigned(pd) then
+                pd.rettype:=voidtype;
             end;
 
           _OPERATOR :
@@ -869,39 +883,49 @@ implementation
                end;
               consume(token);
               pd:=parse_proc_head(aclass,potype_operator);
-              if pd.parast.symtablelevel>normal_function_level then
-                Message(parser_e_no_local_operator);
-              if token<>_ID then
+              if assigned(pd) then
                 begin
-                   if not(m_result in aktmodeswitches) then
-                     consume(_ID);
+                  if pd.parast.symtablelevel>normal_function_level then
+                    Message(parser_e_no_local_operator);
+                  if token<>_ID then
+                    begin
+                       if not(m_result in aktmodeswitches) then
+                         consume(_ID);
+                    end
+                  else
+                    begin
+                      pd.resultname:=orgpattern;
+                      consume(_ID);
+                    end;
+                  if not try_to_consume(_COLON) then
+                    begin
+                      consume(_COLON);
+                      pd.rettype:=generrortype;
+                      consume_all_until(_SEMICOLON);
+                    end
+                  else
+                   begin
+                     single_type(pd.rettype,hs,false);
+                     pd.test_if_fpu_result;
+                     if (optoken in [_EQUAL,_GT,_LT,_GTE,_LTE]) and
+                        ((pd.rettype.def.deftype<>orddef) or
+                         (torddef(pd.rettype.def).typ<>bool8bit)) then
+                        Message(parser_e_comparative_operator_return_boolean);
+                     if (optoken=_ASSIGNMENT) and
+                        equal_defs(pd.rettype.def,
+                           tvarsym(pd.parast.symindex.first).vartype.def) then
+                       message(parser_e_no_such_assignment)
+                     else if not isoperatoracceptable(pd,optoken) then
+                       Message(parser_e_overload_impossible);
+                   end;
                 end
               else
                 begin
-                  pd.resultname:=orgpattern;
-                  consume(_ID);
-                end;
-              if not try_to_consume(_COLON) then
-                begin
+                  { recover }
+                  try_to_consume(_ID);
                   consume(_COLON);
-                  pd.rettype:=generrortype;
                   consume_all_until(_SEMICOLON);
-                end
-              else
-               begin
-                 single_type(pd.rettype,hs,false);
-                 pd.test_if_fpu_result;
-                 if (optoken in [_EQUAL,_GT,_LT,_GTE,_LTE]) and
-                    ((pd.rettype.def.deftype<>orddef) or
-                     (torddef(pd.rettype.def).typ<>bool8bit)) then
-                    Message(parser_e_comparative_operator_return_boolean);
-                 if (optoken=_ASSIGNMENT) and
-                    equal_defs(pd.rettype.def,
-                       tvarsym(pd.parast.symindex.first).vartype.def) then
-                   message(parser_e_no_such_assignment)
-                 else if not isoperatoracceptable(pd,optoken) then
-                   Message(parser_e_overload_impossible);
-               end;
+                end;
             end;
         end;
         { support procedure proc;stdcall export; in Delphi mode only }
@@ -2200,7 +2224,10 @@ const
 end.
 {
   $Log$
-  Revision 1.122  2003-05-09 17:47:03  peter
+  Revision 1.123  2003-05-13 15:18:49  peter
+    * fixed various crashes
+
+  Revision 1.122  2003/05/09 17:47:03  peter
     * self moved to hidden parameter
     * removed hdisposen,hnewn,selfn
 

compiler/psub.pas

@@ -234,88 +234,91 @@ implementation
       begin
         generate_entry_block:=internalstatements(newstatement,true);
 
-        { a constructor needs a help procedure }
-        if (current_procdef.proctypeoption=potype_constructor) then
+        if assigned(current_procdef._class) then
           begin
-            if is_class(current_procdef._class) then
+            { a constructor needs a help procedure }
+            if (current_procdef.proctypeoption=potype_constructor) then
               begin
-                if (cs_implicit_exceptions in aktmoduleswitches) then
-                  include(current_procinfo.flags,pi_needs_implicit_finally);
-                srsym:=search_class_member(current_procdef._class,'NEWINSTANCE');
+                if is_class(current_procdef._class) then
+                  begin
+                    if (cs_implicit_exceptions in aktmoduleswitches) then
+                      include(current_procinfo.flags,pi_needs_implicit_finally);
+                    srsym:=search_class_member(current_procdef._class,'NEWINSTANCE');
+                    if assigned(srsym) and
+                       (srsym.typ=procsym) then
+                      begin
+                        { if vmt<>0 then newinstance }
+                        addstatement(newstatement,cifnode.create(
+                            caddnode.create(unequaln,
+                                load_vmt_pointer_node,
+                                cnilnode.create),
+                            cassignmentnode.create(
+                                ctypeconvnode.create_explicit(
+                                    load_self_pointer_node,
+                                    voidpointertype),
+                                ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_vmt_pointer_node)),
+                            nil));
+                      end
+                    else
+                      internalerror(200305108);
+                  end
+                else
+                  if is_object(current_procdef._class) then
+                    begin
+                      htype.setdef(current_procdef._class);
+                      htype.setdef(tpointerdef.create(htype));
+                      { parameter 3 : vmt_offset }
+                      { parameter 2 : address of pointer to vmt,
+                        this is required to allow setting the vmt to -1 to indicate
+                        that memory was allocated }
+                      { parameter 1 : self pointer }
+                      para:=ccallparanode.create(
+                                cordconstnode.create(current_procdef._class.vmt_offset,s32bittype,false),
+                            ccallparanode.create(
+                                ctypeconvnode.create_explicit(
+                                    load_vmt_pointer_node,
+                                    voidpointertype),
+                            ccallparanode.create(
+                                ctypeconvnode.create_explicit(
+                                    load_self_pointer_node,
+                                    voidpointertype),
+                            nil)));
+                      addstatement(newstatement,cassignmentnode.create(
+                          ctypeconvnode.create_explicit(
+                              load_self_pointer_node,
+                              voidpointertype),
+                          ccallnode.createintern('fpc_help_constructor',para)));
+                    end
+                else
+                  internalerror(200305103);
+                { if self=nil then fail }
+                addstatement(newstatement,cifnode.create(
+                    caddnode.create(equaln,
+                        load_self_pointer_node,
+                        cnilnode.create),
+                    cfailnode.create,
+                    nil));
+              end;
+
+            { maybe call BeforeDestruction for classes }
+            if (current_procdef.proctypeoption=potype_destructor) and
+               is_class(current_procdef._class) then
+              begin
+                srsym:=search_class_member(current_procdef._class,'BEFOREDESTRUCTION');
                 if assigned(srsym) and
                    (srsym.typ=procsym) then
                   begin
-                    { if vmt<>0 then newinstance }
+                    { if vmt<>0 then beforedestruction }
                     addstatement(newstatement,cifnode.create(
                         caddnode.create(unequaln,
                             load_vmt_pointer_node,
                             cnilnode.create),
-                        cassignmentnode.create(
-                            ctypeconvnode.create_explicit(
-                                load_self_pointer_node,
-                                voidpointertype),
-                            ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_vmt_pointer_node)),
+                        ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
                         nil));
                   end
                 else
-                  internalerror(200305108);
-              end
-            else
-              if is_object(current_procdef._class) then
-                begin
-                  htype.setdef(current_procdef._class);
-                  htype.setdef(tpointerdef.create(htype));
-                  { parameter 3 : vmt_offset }
-                  { parameter 2 : address of pointer to vmt,
-                    this is required to allow setting the vmt to -1 to indicate
-                    that memory was allocated }
-                  { parameter 1 : self pointer }
-                  para:=ccallparanode.create(
-                            cordconstnode.create(current_procdef._class.vmt_offset,s32bittype,false),
-                        ccallparanode.create(
-                            ctypeconvnode.create_explicit(
-                                load_vmt_pointer_node,
-                                voidpointertype),
-                        ccallparanode.create(
-                            ctypeconvnode.create_explicit(
-                                load_self_pointer_node,
-                                voidpointertype),
-                        nil)));
-                  addstatement(newstatement,cassignmentnode.create(
-                      ctypeconvnode.create_explicit(
-                          load_self_pointer_node,
-                          voidpointertype),
-                      ccallnode.createintern('fpc_help_constructor',para)));
-                end
-            else
-              internalerror(200305103);
-            { if self=nil then fail }
-            addstatement(newstatement,cifnode.create(
-                caddnode.create(equaln,
-                    load_self_pointer_node,
-                    cnilnode.create),
-                cfailnode.create,
-                nil));
-          end;
-
-        { maybe call BeforeDestruction for classes }
-        if (current_procdef.proctypeoption=potype_destructor) and
-           is_class(current_procdef._class) then
-          begin
-            srsym:=search_class_member(current_procdef._class,'BEFOREDESTRUCTION');
-            if assigned(srsym) and
-               (srsym.typ=procsym) then
-              begin
-                { if vmt<>0 then beforedestruction }
-                addstatement(newstatement,cifnode.create(
-                    caddnode.create(unequaln,
-                        load_vmt_pointer_node,
-                        cnilnode.create),
-                    ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
-                    nil));
-              end
-            else
-              internalerror(200305104);
+                  internalerror(200305104);
+              end;
           end;
       end;
 
@@ -328,74 +331,77 @@ implementation
       begin
         generate_exit_block:=internalstatements(newstatement,true);
 
-        { maybe call AfterConstruction for classes }
-        if (current_procdef.proctypeoption=potype_constructor) and
-           is_class(current_procdef._class) then
+        if assigned(current_procdef._class) then
           begin
-            srsym:=search_class_member(current_procdef._class,'AFTERCONSTRUCTION');
-            if assigned(srsym) and
-               (srsym.typ=procsym) then
+            { maybe call AfterConstruction for classes }
+            if (current_procdef.proctypeoption=potype_constructor) and
+               is_class(current_procdef._class) then
               begin
-                { if vmt<>0 then afterconstruction }
-                addstatement(newstatement,cifnode.create(
-                    caddnode.create(unequaln,
-                        load_vmt_pointer_node,
-                        cnilnode.create),
-                    ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
-                    nil));
-              end
-            else
-              internalerror(200305106);
-          end;
-
-        { a destructor needs a help procedure }
-        if (current_procdef.proctypeoption=potype_destructor) then
-          begin
-            if is_class(current_procdef._class) then
-              begin
-                srsym:=search_class_member(current_procdef._class,'FREEINSTANCE');
+                srsym:=search_class_member(current_procdef._class,'AFTERCONSTRUCTION');
                 if assigned(srsym) and
                    (srsym.typ=procsym) then
                   begin
-                    { if self<>0 and vmt=1 then freeinstance }
+                    { if vmt<>0 then afterconstruction }
                     addstatement(newstatement,cifnode.create(
-                        caddnode.create(andn,
-                            caddnode.create(unequaln,
-                                load_self_pointer_node,
-                                cnilnode.create),
-                            caddnode.create(equaln,
-                                ctypeconvnode.create(
-                                    load_vmt_pointer_node,
-                                    voidpointertype),
-                                cpointerconstnode.create(1,voidpointertype))),
+                        caddnode.create(unequaln,
+                            load_vmt_pointer_node,
+                            cnilnode.create),
                         ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
                         nil));
                   end
                 else
-                  internalerror(200305108);
-              end
-            else
-              if is_object(current_procdef._class) then
-                begin
-                  { parameter 3 : vmt_offset }
-                  { parameter 2 : pointer to vmt }
-                  { parameter 1 : self pointer }
-                  para:=ccallparanode.create(
-                            cordconstnode.create(current_procdef._class.vmt_offset,s32bittype,false),
-                        ccallparanode.create(
-                            ctypeconvnode.create_explicit(
-                                load_vmt_pointer_node,
-                                voidpointertype),
-                        ccallparanode.create(
-                            ctypeconvnode.create_explicit(
-                                load_self_pointer_node,
-                                voidpointertype),
-                        nil)));
-                  addstatement(newstatement,
-                      ccallnode.createintern('fpc_help_destructor',para));
-                end
-            else
-              internalerror(200305105);
+                  internalerror(200305106);
+              end;
+
+            { a destructor needs a help procedure }
+            if (current_procdef.proctypeoption=potype_destructor) then
+              begin
+                if is_class(current_procdef._class) then
+                  begin
+                    srsym:=search_class_member(current_procdef._class,'FREEINSTANCE');
+                    if assigned(srsym) and
+                       (srsym.typ=procsym) then
+                      begin
+                        { if self<>0 and vmt=1 then freeinstance }
+                        addstatement(newstatement,cifnode.create(
+                            caddnode.create(andn,
+                                caddnode.create(unequaln,
+                                    load_self_pointer_node,
+                                    cnilnode.create),
+                                caddnode.create(equaln,
+                                    ctypeconvnode.create(
+                                        load_vmt_pointer_node,
+                                        voidpointertype),
+                                    cpointerconstnode.create(1,voidpointertype))),
+                            ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node),
+                            nil));
+                      end
+                    else
+                      internalerror(200305108);
+                  end
+                else
+                  if is_object(current_procdef._class) then
+                    begin
+                      { parameter 3 : vmt_offset }
+                      { parameter 2 : pointer to vmt }
+                      { parameter 1 : self pointer }
+                      para:=ccallparanode.create(
+                                cordconstnode.create(current_procdef._class.vmt_offset,s32bittype,false),
+                            ccallparanode.create(
+                                ctypeconvnode.create_explicit(
+                                    load_vmt_pointer_node,
+                                    voidpointertype),
+                            ccallparanode.create(
+                                ctypeconvnode.create_explicit(
+                                    load_self_pointer_node,
+                                    voidpointertype),
+                            nil)));
+                      addstatement(newstatement,
+                          ccallnode.createintern('fpc_help_destructor',para));
+                    end
+                else
+                  internalerror(200305105);
+              end;
           end;
       end;
 
@@ -1098,7 +1104,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.109  2003-05-11 21:37:03  peter
+  Revision 1.110  2003-05-13 15:18:49  peter
+    * fixed various crashes
+
+  Revision 1.109  2003/05/11 21:37:03  peter
     * moved implicit exception frame from ncgutil to psub
     * constructor/destructor helpers moved from cobj/ncgutil to psub