Browse Source

* fixed bug #596
* fixed some problems with procedure variables and procedures of object,
especially in TP mode. Procedure of object doesn't apply only to classes,
it is also allowed for objects !!

florian 26 years ago
parent
commit
1609dde2ca
7 changed files with 74 additions and 19 deletions
  1. 15 5
      compiler/cg386ld.pas
  2. 9 2
      compiler/pass_1.pas
  3. 7 2
      compiler/pexpr.pas
  4. 9 3
      compiler/tccnv.pas
  5. 14 1
      compiler/tcld.pas
  6. 8 3
      compiler/tcmem.pas
  7. 12 3
      compiler/types.pas

+ 15 - 5
compiler/cg386ld.pas

@@ -293,16 +293,20 @@ implementation
                               begin
                               begin
                                  hregister:=p^.left^.location.register;
                                  hregister:=p^.left^.location.register;
                                  ungetregister32(p^.left^.location.register);
                                  ungetregister32(p^.left^.location.register);
-                                 { such code is allowed !
-                                   CGMessage(cg_e_illegal_expression); }
+                                 if not(pobjectdef(p^.left^.resulttype)^.is_class) then
+                                   CGMessage(cg_e_illegal_expression);
                               end;
                               end;
 
 
                             LOC_MEM,
                             LOC_MEM,
                             LOC_REFERENCE:
                             LOC_REFERENCE:
                               begin
                               begin
                                  hregister:=R_EDI;
                                  hregister:=R_EDI;
-                                 emit_ref_reg(A_MOV,S_L,
-                                   newreference(p^.left^.location.reference),R_EDI);
+                                 if pobjectdef(p^.left^.resulttype)^.is_class then
+                                   emit_ref_reg(A_MOV,S_L,
+                                     newreference(p^.left^.location.reference),R_EDI)
+                                 else
+                                   emit_ref_reg(A_LEA,S_L,
+                                     newreference(p^.left^.location.reference),R_EDI);
                                  del_reference(p^.left^.location.reference);
                                  del_reference(p^.left^.location.reference);
                                  ungetiftemp(p^.left^.location.reference);
                                  ungetiftemp(p^.left^.location.reference);
                               end;
                               end;
@@ -980,7 +984,13 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.83  1999-09-01 09:37:14  peter
+  Revision 1.84  1999-09-11 09:08:31  florian
+    * fixed bug 596
+    * fixed some problems with procedure variables and procedures of object,
+      especially in TP mode. Procedure of object doesn't apply only to classes,
+      it is also allowed for objects !!
+
+  Revision 1.83  1999/09/01 09:37:14  peter
     * removed warning
     * removed warning
 
 
   Revision 1.82  1999/09/01 09:26:21  peter
   Revision 1.82  1999/09/01 09:26:21  peter

+ 9 - 2
compiler/pass_1.pas

@@ -131,7 +131,8 @@ implementation
                            CGMessage(cg_n_inefficient_code)
                            CGMessage(cg_n_inefficient_code)
                          else
                          else
                            begin
                            begin
-                              hp^.left^.right^.left:=getcopy(hp^.right^.right);
+                              hp^.left^.right^.left:=hp^.right^.right;
+                              hp^.right^.right:=nil;
                               disposetree(hp^.right);
                               disposetree(hp^.right);
                               hp^.right:=nil;
                               hp^.right:=nil;
                            end;
                            end;
@@ -367,7 +368,13 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.103  1999-08-04 00:23:09  florian
+  Revision 1.104  1999-09-11 09:08:31  florian
+    * fixed bug 596
+    * fixed some problems with procedure variables and procedures of object,
+      especially in TP mode. Procedure of object doesn't apply only to classes,
+      it is also allowed for objects !!
+
+  Revision 1.103  1999/08/04 00:23:09  florian
     * renamed i386asm and i386base to cpuasm and cpubase
     * renamed i386asm and i386base to cpuasm and cpubase
 
 
   Revision 1.102  1999/05/27 19:44:42  peter
   Revision 1.102  1999/05/27 19:44:42  peter

+ 7 - 2
compiler/pexpr.pas

@@ -543,7 +543,6 @@ unit pexpr;
                    consume(_RKLAMMER);
                    consume(_RKLAMMER);
                 end
                 end
               else p1^.left:=nil;
               else p1^.left:=nil;
-
               { do firstpass because we need the  }
               { do firstpass because we need the  }
               { result type                       }
               { result type                       }
               Store_valid:=Must_be_valid;
               Store_valid:=Must_be_valid;
@@ -2093,7 +2092,13 @@ _LECKKLAMMER : begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.139  1999-09-10 18:48:07  florian
+  Revision 1.140  1999-09-11 09:08:33  florian
+    * fixed bug 596
+    * fixed some problems with procedure variables and procedures of object,
+      especially in TP mode. Procedure of object doesn't apply only to classes,
+      it is also allowed for objects !!
+
+  Revision 1.139  1999/09/10 18:48:07  florian
     * some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
     * some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
     * most things for stored properties fixed
     * most things for stored properties fixed
 
 

+ 9 - 3
compiler/tccnv.pas

@@ -656,8 +656,8 @@ implementation
                   begin
                   begin
                     {if p^.left^.right=nil then
                     {if p^.left^.right=nil then
                      begin}
                      begin}
-                       if (p^.left^.symtableprocentry^.owner^.symtabletype=objectsymtable) and
-                          (pobjectdef(p^.left^.symtableprocentry^.owner^.defowner)^.is_class) then
+                       if (p^.left^.symtableprocentry^.owner^.symtabletype=objectsymtable){ and
+                          (pobjectdef(p^.left^.symtableprocentry^.owner^.defowner)^.is_class) }then
                         hp:=genloadmethodcallnode(pprocsym(p^.left^.symtableprocentry),p^.left^.symtableproc,
                         hp:=genloadmethodcallnode(pprocsym(p^.left^.symtableprocentry),p^.left^.symtableproc,
                               getcopy(p^.left^.methodpointer))
                               getcopy(p^.left^.methodpointer))
                        else
                        else
@@ -928,7 +928,13 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.46  1999-08-13 15:43:59  peter
+  Revision 1.47  1999-09-11 09:08:34  florian
+    * fixed bug 596
+    * fixed some problems with procedure variables and procedures of object,
+      especially in TP mode. Procedure of object doesn't apply only to classes,
+      it is also allowed for objects !!
+
+  Revision 1.46  1999/08/13 15:43:59  peter
     * fixed proc->procvar conversion for tp_procvar mode, it now uses
     * fixed proc->procvar conversion for tp_procvar mode, it now uses
       also the genload(method)call() function
       also the genload(method)call() function
 
 

+ 14 - 1
compiler/tcld.pas

@@ -188,6 +188,13 @@ implementation
                    if assigned(pprocsym(p^.symtableentry)^.definition^.nextoverloaded) then
                    if assigned(pprocsym(p^.symtableentry)^.definition^.nextoverloaded) then
                      CGMessage(parser_e_no_overloaded_procvars);
                      CGMessage(parser_e_no_overloaded_procvars);
                    p^.resulttype:=pprocsym(p^.symtableentry)^.definition;
                    p^.resulttype:=pprocsym(p^.symtableentry)^.definition;
+                   { if the owner of the procsym is a object,  }
+                   { left must be set, if left isn't set       }
+                   { it can be only self                       }
+                   { this code is only used in TP procvar mode }
+                   if not(assigned(p^.left)) and
+                     (pprocsym(p^.symtableentry)^.owner^.symtabletype=objectsymtable) then
+                      p^.left:=genselfnode(procinfo._class);
                    { method pointer ? }
                    { method pointer ? }
                    if assigned(p^.left) then
                    if assigned(p^.left) then
                      begin
                      begin
@@ -496,7 +503,13 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.42  1999-09-10 18:48:11  florian
+  Revision 1.43  1999-09-11 09:08:34  florian
+    * fixed bug 596
+    * fixed some problems with procedure variables and procedures of object,
+      especially in TP mode. Procedure of object doesn't apply only to classes,
+      it is also allowed for objects !!
+
+  Revision 1.42  1999/09/10 18:48:11  florian
     * some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
     * some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
     * most things for stored properties fixed
     * most things for stored properties fixed
 
 

+ 8 - 3
compiler/tcmem.pas

@@ -191,8 +191,7 @@ implementation
                    else
                    else
                       begin
                       begin
                         { generate a methodcallnode or proccallnode }
                         { generate a methodcallnode or proccallnode }
-                        if (p^.left^.symtableprocentry^.owner^.symtabletype=objectsymtable) and
-                           (pobjectdef(p^.left^.symtableprocentry^.owner^.defowner)^.is_class) then
+                        if (p^.left^.symtableprocentry^.owner^.symtabletype=objectsymtable) then
                          begin
                          begin
                            hp:=genloadmethodcallnode(pprocsym(p^.left^.symtableprocentry),p^.left^.symtableproc,
                            hp:=genloadmethodcallnode(pprocsym(p^.left^.symtableprocentry),p^.left^.symtableproc,
                              getcopy(p^.left^.methodpointer));
                              getcopy(p^.left^.methodpointer));
@@ -594,7 +593,13 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.25  1999-08-23 23:34:15  pierre
+  Revision 1.26  1999-09-11 09:08:34  florian
+    * fixed bug 596
+    * fixed some problems with procedure variables and procedures of object,
+      especially in TP mode. Procedure of object doesn't apply only to classes,
+      it is also allowed for objects !!
+
+  Revision 1.25  1999/08/23 23:34:15  pierre
    * one more register needed if hnewn with CREGISTER
    * one more register needed if hnewn with CREGISTER
 
 
   Revision 1.24  1999/08/05 16:53:25  peter
   Revision 1.24  1999/08/05 16:53:25  peter

+ 12 - 3
compiler/types.pas

@@ -254,9 +254,12 @@ implementation
            exit;
            exit;
          { check for method pointer }
          { check for method pointer }
          ismethod:=assigned(def1^.owner) and
          ismethod:=assigned(def1^.owner) and
-                   (def1^.owner^.symtabletype=objectsymtable) and
+                   (def1^.owner^.symtabletype=objectsymtable);
+                   { I think methods of objects are also not compatible }
+                   { with procedure variables! (FK)
+                   and
                    assigned(def1^.owner^.defowner) and
                    assigned(def1^.owner^.defowner) and
-                   (pobjectdef(def1^.owner^.defowner)^.is_class);
+                   (pobjectdef(def1^.owner^.defowner)^.is_class); }
          if (ismethod and not (po_methodpointer in def2^.procoptions)) or
          if (ismethod and not (po_methodpointer in def2^.procoptions)) or
             (not(ismethod) and (po_methodpointer in def2^.procoptions)) then
             (not(ismethod) and (po_methodpointer in def2^.procoptions)) then
           begin
           begin
@@ -981,7 +984,13 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.85  1999-08-13 21:27:08  peter
+  Revision 1.86  1999-09-11 09:08:35  florian
+    * fixed bug 596
+    * fixed some problems with procedure variables and procedures of object,
+      especially in TP mode. Procedure of object doesn't apply only to classes,
+      it is also allowed for objects !!
+
+  Revision 1.85  1999/08/13 21:27:08  peter
     * more fixes for push_addr
     * more fixes for push_addr
 
 
   Revision 1.84  1999/08/13 15:38:23  peter
   Revision 1.84  1999/08/13 15:38:23  peter