* 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,7 +796,19 @@ implementation
             begin
               consume(_FUNCTION);
               pd:=parse_proc_head(aclass,potype_none);
-              if token<>_COLON then
+              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
@@ -807,37 +819,37 @@ implementation
                         consume(_COLON);
                         consume_all_until(_SEMICOLON);
                       end;
-               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);
+                end
+              else
+                begin
+                  { recover }
+                  consume(_COLON);
+                  consume_all_until(_SEMICOLON);
+                end;
             end;
 
           _PROCEDURE :
             begin
               consume(_PROCEDURE);
               pd:=parse_proc_head(aclass,potype_none);
+              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
+              if assigned(pd) and
-               internalerror(200304263);
+                 assigned(pd._class) then
+                begin
                   { Set return type, class constructors return the
                     created instance, object constructors return boolean }
                   if is_class(pd._class) then
@@ -845,11 +857,13 @@ implementation
                   else
                    pd.rettype:=booltype;
                 end;
+            end;
 
           _DESTRUCTOR :
             begin
               consume(_DESTRUCTOR);
               pd:=parse_proc_head(aclass,potype_destructor);
+              if assigned(pd) then
                 pd.rettype:=voidtype;
             end;
 
@@ -869,6 +883,8 @@ implementation
                end;
               consume(token);
               pd:=parse_proc_head(aclass,potype_operator);
+              if assigned(pd) then
+                begin
                   if pd.parast.symtablelevel>normal_function_level then
                     Message(parser_e_no_local_operator);
                   if token<>_ID then
@@ -902,6 +918,14 @@ implementation
                      else if not isoperatoracceptable(pd,optoken) then
                        Message(parser_e_overload_impossible);
                    end;
+                end
+              else
+                begin
+                  { recover }
+                  try_to_consume(_ID);
+                  consume(_COLON);
+                  consume_all_until(_SEMICOLON);
+                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,6 +234,8 @@ implementation
       begin
         generate_entry_block:=internalstatements(newstatement,true);
 
+        if assigned(current_procdef._class) then
+          begin
             { a constructor needs a help procedure }
             if (current_procdef.proctypeoption=potype_constructor) then
               begin
@@ -318,6 +320,7 @@ implementation
                   internalerror(200305104);
               end;
           end;
+      end;
 
 
     function generate_exit_block:tblocknode;
@@ -328,6 +331,8 @@ implementation
       begin
         generate_exit_block:=internalstatements(newstatement,true);
 
+        if assigned(current_procdef._class) then
+          begin
             { maybe call AfterConstruction for classes }
             if (current_procdef.proctypeoption=potype_constructor) and
                is_class(current_procdef._class) then
@@ -398,6 +403,7 @@ implementation
                   internalerror(200305105);
               end;
           end;
+      end;
 
 
     function generate_except_block:tblocknode;
@@ -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