* fixed some reported bugs

compiler/ncal.pas

@@ -1137,12 +1137,15 @@ type
         { also, this checking can only be done if the constructor is directly
           called, indirect constructor calls cannot be checked.
         }
-        if assigned(methodpointer) and
-           (methodpointer.resulttype.def.deftype = classrefdef) and
-           (methodpointer.nodetype in [typen,loadvmtaddrn]) then
+        if assigned(methodpointer) then
           begin
-            if (tclassrefdef(methodpointer.resulttype.def).pointertype.def.deftype = objectdef) then
-              objectdf := tobjectdef(tclassrefdef(methodpointer.resulttype.def).pointertype.def);
+            if (methodpointer.resulttype.def.deftype = objectdef) then
+              objectdf:=tobjectdef(methodpointer.resulttype.def)
+            else
+              if (methodpointer.resulttype.def.deftype = classrefdef) and
+                 (tclassrefdef(methodpointer.resulttype.def).pointertype.def.deftype = objectdef) and
+                 (methodpointer.nodetype in [typen,loadvmtaddrn]) then
+                objectdf:=tobjectdef(tclassrefdef(methodpointer.resulttype.def).pointertype.def);
           end;
         if not assigned(objectdf) then
           exit;
@@ -2163,7 +2166,7 @@ type
                while assigned(hpt) and (hpt.nodetype in [subscriptn,vecn]) do
                 hpt:=tunarynode(hpt).left;
 
-               if (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) and
+               if (procdefinition.proctypeoption=potype_constructor) and
                   assigned(symtableproc) and
                   (symtableproc.symtabletype=withsymtable) and
                   (tnode(twithsymtable(symtableproc).withrefnode).nodetype=temprefn) then
@@ -2646,7 +2649,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.174  2003-07-25 09:54:57  jonas
+  Revision 1.175  2003-08-10 17:25:23  peter
+    * fixed some reported bugs
+
+  Revision 1.174  2003/07/25 09:54:57  jonas
     * fixed bogus abstract method warnings
 
   Revision 1.173  2003/06/25 18:31:23  peter

compiler/ncgflw.pas

@@ -109,7 +109,7 @@ implementation
          lcont,lbreak,lloop,
          oldclabel,oldblabel : tasmlabel;
          otlabel,oflabel : tasmlabel;
-
+         oldflowcontrol : tflowcontrol;
       begin
          location_reset(location,LOC_VOID,OS_NO);
 
@@ -117,6 +117,7 @@ implementation
          objectlibrary.getlabel(lcont);
          objectlibrary.getlabel(lbreak);
          { arrange continue and breaklabels: }
+         oldflowcontrol:=flowcontrol;
          oldclabel:=aktcontinuelabel;
          oldblabel:=aktbreaklabel;
 
@@ -168,7 +169,7 @@ implementation
          aktcontinuelabel:=oldclabel;
          aktbreaklabel:=oldblabel;
          { a break/continue in a while/repeat block can't be seen outside }
-         flowcontrol:=flowcontrol-[fc_break,fc_continue];
+         flowcontrol:=oldflowcontrol+(flowcontrol-[fc_break,fc_continue]);
       end;
 
 
@@ -354,10 +355,11 @@ implementation
          opsize : tcgsize;
          count_var_is_signed,do_loopvar_at_end : boolean;
          cmp_const:Tconstexprint;
+         oldflowcontrol : tflowcontrol;
 
       begin
          location_reset(location,LOC_VOID,OS_NO);
-
+         oldflowcontrol:=flowcontrol;
          oldclabel:=aktcontinuelabel;
          oldblabel:=aktbreaklabel;
          objectlibrary.getlabel(aktcontinuelabel);
@@ -702,8 +704,8 @@ implementation
 
          aktcontinuelabel:=oldclabel;
          aktbreaklabel:=oldblabel;
-         { a break/continue in a for block can't be seen outside }
-         flowcontrol:=flowcontrol-[fc_break,fc_continue];
+         { a break/continue in a while/repeat block can't be seen outside }
+         flowcontrol:=oldflowcontrol+(flowcontrol-[fc_break,fc_continue]);
       end;
 
 
@@ -1539,7 +1541,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.74  2003-08-09 18:56:54  daniel
+  Revision 1.75  2003-08-10 17:25:23  peter
+    * fixed some reported bugs
+
+  Revision 1.74  2003/08/09 18:56:54  daniel
     * cs_regalloc renamed to cs_regvars to avoid confusion with register
       allocator
     * Some preventive changes to i386 spillinh code

compiler/ncgmem.pas

@@ -42,10 +42,6 @@ interface
           procedure pass_2;override;
        end;
 
-       tcgdoubleaddrnode = class(tdoubleaddrnode)
-          procedure pass_2;override;
-       end;
-
        tcgderefnode = class(tderefnode)
           procedure pass_2;override;
        end;
@@ -185,40 +181,16 @@ implementation
          location_release(exprasmlist,left.location);
          location_reset(location,LOC_REGISTER,OS_ADDR);
          location.register:=rg.getaddressregister(exprasmlist);
-         {@ on a procvar means returning an address to the procedure that
-           is stored in it.}
-         { yes but left.symtableentry can be nil
-           for example on self !! }
-         { symtableentry can be also invalid, if left is no tree node }
+         { @ on a procvar means returning an address to the procedure that
+           is stored in it }
          if (m_tp_procvar in aktmodeswitches) and
             (left.nodetype=loadn) and
+            (tloadnode(left).resulttype.def.deftype=procvardef) and
             assigned(tloadnode(left).symtableentry) and
-            (tloadnode(left).symtableentry.typ=varsym) and
-            (tvarsym(tloadnode(left).symtableentry).vartype.def.deftype=procvardef) then
-           cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.reference,
-             location.register)
+            (tloadnode(left).symtableentry.typ=varsym) then
+           cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.reference,location.register)
          else
-          begin
-           cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,
-             location.register);
-          end;
-      end;
-
-
-{*****************************************************************************
-                         TCGDOUBLEADDRNODE
-*****************************************************************************}
-
-    procedure tcgdoubleaddrnode.pass_2;
-      begin
-         secondpass(left);
-
-         location_release(exprasmlist,left.location);
-         location_reset(location,LOC_REGISTER,OS_ADDR);
-         location.register:=rg.getaddressregister(exprasmlist);
-
-         cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,
-           location.register);
+           cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,location.register);
       end;
 
 
@@ -479,7 +451,6 @@ implementation
          poslabel,
          neglabel : tasmlabel;
          hreg : tregister;
-         i:Tsuperregister;
       {$ifndef newra}
          pushed : tpushedsavedint;
       {$endif}
@@ -890,7 +861,6 @@ implementation
 begin
    cloadvmtaddrnode:=tcgloadvmtaddrnode;
    caddrnode:=tcgaddrnode;
-   cdoubleaddrnode:=tcgdoubleaddrnode;
    cderefnode:=tcgderefnode;
    csubscriptnode:=tcgsubscriptnode;
    cwithnode:=tcgwithnode;
@@ -898,7 +868,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.68  2003-08-09 18:56:54  daniel
+  Revision 1.69  2003-08-10 17:25:23  peter
+    * fixed some reported bugs
+
+  Revision 1.68  2003/08/09 18:56:54  daniel
     * cs_regalloc renamed to cs_regvars to avoid confusion with register
       allocator
     * Some preventive changes to i386 spillinh code

compiler/ncnv.pas

@@ -1294,6 +1294,8 @@ implementation
                 that has an extra addrn }
               if (m_tp_procvar in aktmodeswitches) and
                  (resulttype.def.deftype<>procvardef) and
+                 { ignore internal typecasts to access methodpointer fields }
+                 (resulttype.def<>methodpointertype.def) and
                  (left.resulttype.def.deftype=procvardef) and
                  (not is_void(tprocvardef(left.resulttype.def).rettype.def)) then
                begin
@@ -2111,7 +2113,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.115  2003-06-05 20:05:55  peter
+  Revision 1.116  2003-08-10 17:25:23  peter
+    * fixed some reported bugs
+
+  Revision 1.115  2003/06/05 20:05:55  peter
     * removed changesettype because that will change the definition
       of the setdef forever and can result in a different between
       original interface and current implementation definition

compiler/nmem.pas

@@ -53,13 +53,6 @@ interface
        end;
        taddrnodeclass = class of taddrnode;
 
-       tdoubleaddrnode = class(tunarynode)
-          constructor create(l : tnode);virtual;
-          function pass_1 : tnode;override;
-          function det_resulttype:tnode;override;
-       end;
-       tdoubleaddrnodeclass = class of tdoubleaddrnode;
-
        tderefnode = class(tunarynode)
           constructor create(l : tnode);virtual;
           function pass_1 : tnode;override;
@@ -109,7 +102,6 @@ interface
     var
        cloadvmtaddrnode : tloadvmtaddrnodeclass;
        caddrnode : taddrnodeclass;
-       cdoubleaddrnode : tdoubleaddrnodeclass;
        cderefnode : tderefnodeclass;
        csubscriptnode : tsubscriptnodeclass;
        cvecnode : tvecnodeclass;
@@ -405,56 +397,6 @@ implementation
       end;
 
 
-{*****************************************************************************
-                           TDOUBLEADDRNODE
-*****************************************************************************}
-
-    constructor tdoubleaddrnode.create(l : tnode);
-      begin
-         inherited create(doubleaddrn,l);
-      end;
-
-
-    function tdoubleaddrnode.det_resulttype:tnode;
-      begin
-        result:=nil;
-         resulttypepass(left);
-         if codegenerror then
-          exit;
-
-         inc(parsing_para_level);
-         set_varstate(left,false);
-         dec(parsing_para_level);
-
-         if (left.resulttype.def.deftype)<>procvardef then
-           CGMessage(cg_e_illegal_expression);
-
-         resulttype:=voidpointertype;
-      end;
-
-
-    function tdoubleaddrnode.pass_1 : tnode;
-      begin
-         result:=nil;
-         make_not_regable(left);
-         firstpass(left);
-         if codegenerror then
-           exit;
-
-         if (left.expectloc<>LOC_REFERENCE) then
-           CGMessage(cg_e_illegal_expression);
-
-         registers32:=left.registers32;
-         registersfpu:=left.registersfpu;
-{$ifdef SUPPORT_MMX}
-         registersmmx:=left.registersmmx;
-{$endif SUPPORT_MMX}
-         if registers32<1 then
-           registers32:=1;
-         expectloc:=LOC_REGISTER;
-      end;
-
-
 {*****************************************************************************
                              TDEREFNODE
 *****************************************************************************}
@@ -905,7 +847,6 @@ implementation
 begin
   cloadvmtaddrnode := tloadvmtaddrnode;
   caddrnode := taddrnode;
-  cdoubleaddrnode := tdoubleaddrnode;
   cderefnode := tderefnode;
   csubscriptnode := tsubscriptnode;
   cvecnode := tvecnode;
@@ -913,7 +854,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.59  2003-06-17 19:24:08  jonas
+  Revision 1.60  2003-08-10 17:25:23  peter
+    * fixed some reported bugs
+
+  Revision 1.59  2003/06/17 19:24:08  jonas
     * fixed conversion of fpc_*str_unique to compilerproc
 
   Revision 1.58  2003/06/17 16:34:44  jonas

compiler/nobj.pas

@@ -1163,14 +1163,9 @@ implementation
                                   { class abstract and it's not allow to      }
                                   { generates an instance                     }
                                   if (po_abstractmethod in procdefcoll^.data.procoptions) then
-                                    begin
-                                       include(_class.objectoptions,oo_has_abstract);
-                                       List.concat(Tai_const_symbol.Createname('FPC_ABSTRACTERROR'));
-                                    end
+                                    List.concat(Tai_const_symbol.Createname('FPC_ABSTRACTERROR'))
                                   else
-                                    begin
-                                      List.concat(Tai_const_symbol.createname(procdefcoll^.data.mangledname));
-                                    end;
+                                    List.concat(Tai_const_symbol.createname(procdefcoll^.data.mangledname));
                                end;
                           end;
                         procdefcoll:=procdefcoll^.next;
@@ -1333,7 +1328,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.44  2003-06-01 21:38:06  peter
+  Revision 1.45  2003-08-10 17:25:23  peter
+    * fixed some reported bugs
+
+  Revision 1.44  2003/06/01 21:38:06  peter
     * getregisterfpu size parameter added
     * op_const_reg size parameter added
     * sparc updates

compiler/node.pas

@@ -70,7 +70,6 @@ interface
           subscriptn,       {Field in a record/object}
           derefn,           {Dereferences a pointer}
           addrn,            {Represents the @ operator}
-          doubleaddrn,      {Represents the @@ operator}
           ordconstn,        {Represents an ordinal value}
           typeconvn,        {Represents type-conversion/typecast}
           calln,            {Represents a call node}
@@ -149,7 +148,6 @@ interface
           'subscriptn',
           'derefn',
           'addrn',
-          'doubleaddrn',
           'ordconstn',
           'typeconvn',
           'calln',
@@ -982,7 +980,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.62  2003-05-26 21:17:17  peter
+  Revision 1.63  2003-08-10 17:25:23  peter
+    * fixed some reported bugs
+
+  Revision 1.62  2003/05/26 21:17:17  peter
     * procinlinenode removed
     * aktexit2label removed, fast exit removed
     + tcallnode.inlined_pass_2 added

compiler/pass_2.pas

@@ -96,7 +96,6 @@ implementation
              'subscriptn',  {subscriptn}
              'dderef',       {derefn}
              'addr',        {addrn}
-             'doubleaddr',  {doubleaddrn}
              'ordconst',    {ordconstn}
              'typeconv',    {typeconvn}
              'calln',       {calln}
@@ -316,7 +315,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.61  2003-07-06 17:58:22  peter
+  Revision 1.62  2003-08-10 17:25:23  peter
+    * fixed some reported bugs
+
+  Revision 1.61  2003/07/06 17:58:22  peter
     * framepointer fixes for sparc
     * parent framepointer code more generic
 

compiler/pexpr.pas

@@ -1358,7 +1358,8 @@ implementation
                 procsym :
                   begin
                     { are we in a class method ? }
-                    possible_error:=(srsym.owner.symtabletype=objectsymtable) and
+                    possible_error:=(srsymtable.symtabletype<>withsymtable) and
+                                    (srsym.owner.symtabletype=objectsymtable) and
                                     not(is_interface(tdef(srsym.owner.defowner))) and
                                     assigned(current_procinfo) and
                                     (po_classmethod in current_procinfo.procdef.procoptions);
@@ -2412,7 +2413,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.123  2003-06-13 21:19:31  peter
+  Revision 1.124  2003-08-10 17:25:23  peter
+    * fixed some reported bugs
+
+  Revision 1.123  2003/06/13 21:19:31  peter
     * current_procdef removed, use current_procinfo.procdef instead
 
   Revision 1.122  2003/06/03 21:02:57  peter

compiler/pinline.pas

@@ -355,9 +355,6 @@ implementation
                exit;
              end;
             classh:=tobjectdef(tpointerdef(p1.resulttype.def).pointertype.def);
-            { check for an abstract class }
-            if (oo_has_abstract in classh.objectoptions) then
-              Message(sym_e_no_instance_of_abstract_object);
             { use the objectdef for loading the VMT }
             p2:=p1;
             p1:=ctypenode.create(tpointerdef(p1.resulttype.def).pointertype);
@@ -682,7 +679,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.15  2003-05-17 13:30:08  jonas
+  Revision 1.16  2003-08-10 17:25:23  peter
+    * fixed some reported bugs
+
+  Revision 1.15  2003/05/17 13:30:08  jonas
     * changed tt_persistant to tt_persistent :)
     * tempcreatenode now doesn't accept a boolean anymore for persistent
       temps, but a ttemptype, so you can also create ansistring temps etc

compiler/psystem.pas

@@ -385,7 +385,6 @@ implementation
         nodeclass[subscriptn]:=csubscriptnode;
         nodeclass[derefn]:=cderefnode;
         nodeclass[addrn]:=caddrnode;
-        nodeclass[doubleaddrn]:=cdoubleaddrnode;
         nodeclass[ordconstn]:=cordconstnode;
         nodeclass[typeconvn]:=ctypeconvnode;
         nodeclass[calln]:=ccallnode;
@@ -493,7 +492,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.52  2003-05-26 21:17:18  peter
+  Revision 1.53  2003-08-10 17:25:23  peter
+    * fixed some reported bugs
+
+  Revision 1.52  2003/05/26 21:17:18  peter
     * procinlinenode removed
     * aktexit2label removed, fast exit removed
     + tcallnode.inlined_pass_2 added

compiler/scanner.pas

@@ -2371,13 +2371,7 @@ implementation
              '@' :
                begin
                  readchar;
-                 if c='@' then
-                  begin
-                    readchar;
-                    token:=_DOUBLEADDR;
-                  end
-                 else
-                  token:=_KLAMMERAFFE;
+                 token:=_KLAMMERAFFE;
                  goto exit_label;
                end;
 
@@ -2814,7 +2808,10 @@ exit_label:
 end.
 {
   $Log$
-  Revision 1.59  2003-05-25 10:26:43  peter
+  Revision 1.60  2003-08-10 17:25:23  peter
+    * fixed some reported bugs
+
+  Revision 1.59  2003/05/25 10:26:43  peter
     * recursive include depth check
 
   Revision 1.58  2003/04/26 00:30:27  peter

compiler/symconst.pas

@@ -224,7 +224,6 @@ type
     oo_has_vmt,            { the object/class has a vmt }
     oo_has_msgstr,
     oo_has_msgint,
-    oo_has_abstract,       { the object/class has an abstract method => no instances can be created }
     oo_can_have_published { the class has rtti, i.e. you can publish properties }
   );
   tobjectoptions=set of tobjectoption;
@@ -356,7 +355,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.58  2003-06-25 18:31:23  peter
+  Revision 1.59  2003-08-10 17:25:23  peter
+    * fixed some reported bugs
+
+  Revision 1.58  2003/06/25 18:31:23  peter
     * sym,def resolving partly rewritten to support also parent objects
       not directly available through the uses clause
 

compiler/tokens.pas

@@ -67,7 +67,6 @@ type
     _SEMICOLON,
     _KLAMMERAFFE,
     _POINTPOINT,
-    _DOUBLEADDR,
     _EOF,
     _ID,
     _NOID,
@@ -291,7 +290,6 @@ const
       (str:';'             ;special:true ;keyword:m_none;op:NOTOKEN),
       (str:'@'             ;special:true ;keyword:m_none;op:NOTOKEN),
       (str:'..'            ;special:true ;keyword:m_none;op:NOTOKEN),
-      (str:'@@'            ;special:true ;keyword:m_none;op:NOTOKEN),
       (str:'end of file'   ;special:true ;keyword:m_none;op:NOTOKEN),
       (str:'identifier'    ;special:true ;keyword:m_none;op:NOTOKEN),
       (str:'non identifier';special:true ;keyword:m_none;op:NOTOKEN),
@@ -506,7 +504,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.21  2003-03-26 12:50:54  armin
+  Revision 1.22  2003-08-10 17:25:23  peter
+    * fixed some reported bugs
+
+  Revision 1.21  2003/03/26 12:50:54  armin
   * avoid problems with the ide in init/dome
 
   Revision 1.20  2002/11/29 22:31:21  carl