瀏覽代碼

* some bugs with interfaces and NIL fixed

florian 25 年之前
父節點
當前提交
5694e05857
共有 5 個文件被更改,包括 46 次插入19 次删除
  1. 7 4
      compiler/htypechk.pas
  2. 5 2
      compiler/i386/n386add.pas
  3. 9 2
      compiler/i386/n386cnv.pas
  4. 18 7
      compiler/nadd.pas
  5. 7 4
      compiler/types.pas

+ 7 - 4
compiler/htypechk.pas

@@ -189,11 +189,11 @@ implementation
            { <> and = are defined for classes }
            (
             (ld^.deftype=objectdef) and
-            not((treetyp in [equaln,unequaln]) and (is_class(ld) or is_interface(ld)))
+            not((treetyp in [equaln,unequaln]) and is_class_or_interface(ld))
            ) or
            (
             (rd^.deftype=objectdef) and
-            not((treetyp in [equaln,unequaln]) and (is_class(rd) or is_interface(rd)))
+            not((treetyp in [equaln,unequaln]) and is_class_or_interface(rd))
            )
            or
            { allow other operators that + on strings }
@@ -887,7 +887,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.15  2000-11-12 22:20:37  peter
+  Revision 1.16  2000-11-13 11:30:54  florian
+    * some bugs with interfaces and NIL fixed
+
+  Revision 1.15  2000/11/12 22:20:37  peter
     * create generic toutputsection for binary writers
 
   Revision 1.14  2000/11/04 14:25:19  florian
@@ -934,4 +937,4 @@ end.
 
   Revision 1.2  2000/07/13 11:32:41  michael
   + removed logs
-}
+}

+ 5 - 2
compiler/i386/n386add.pas

@@ -923,7 +923,7 @@ interface
 
                  (right.resulttype^.deftype=pointerdef) or
 
-                 (is_class(right.resulttype) and is_class(left.resulttype)) or
+                 (is_class_or_interface(right.resulttype) and is_class_or_interface(left.resulttype)) or
 
                  (left.resulttype^.deftype=classrefdef) or
 
@@ -2288,7 +2288,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2000-11-04 14:25:23  florian
+  Revision 1.4  2000-11-13 11:30:56  florian
+    * some bugs with interfaces and NIL fixed
+
+  Revision 1.3  2000/11/04 14:25:23  florian
     + merged Attila's changes for interfaces, not tested yet
 
   Revision 1.2  2000/10/31 22:02:56  peter

+ 9 - 2
compiler/i386/n386cnv.pas

@@ -1211,6 +1211,7 @@ implementation
     procedure ti386typeconvnode.second_class_to_intf;
       var
          hreg : tregister;
+         l1 : pasmlabel;
       begin
          case left.location.loc of
             LOC_MEM,
@@ -1231,9 +1232,12 @@ implementation
               hreg:=left.location.register;
             else internalerror(121120001);
          end;
-
+         emit_reg_reg(A_TEST,S_L,hreg,hreg);
+         getlabel(l1);
+         emitjmp(C_Z,l1);
          emit_const_reg(A_ADD,S_L,pobjectdef(left.resulttype)^.implementedinterfaces^.ioffsets(
            pobjectdef(left.resulttype)^.implementedinterfaces^.searchintf(resulttype))^,hreg);
+         emitlab(l1);
          location.loc:=LOC_REGISTER;
          location.register:=hreg;
       end;
@@ -1479,7 +1483,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2000-11-12 23:24:14  florian
+  Revision 1.6  2000-11-13 11:30:56  florian
+    * some bugs with interfaces and NIL fixed
+
+  Revision 1.5  2000/11/12 23:24:14  florian
     * interfaces are basically running
 
   Revision 1.4  2000/11/11 16:00:10  jonas

+ 18 - 7
compiler/nadd.pas

@@ -890,19 +890,27 @@ implementation
               convdone:=true;
            end
          else
-
-           if is_class_or_interface(rd) and is_class_or_interface(ld) then
+           if is_class_or_interface(rd) or is_class_or_interface(ld) then
             begin
               location.loc:=LOC_REGISTER;
-              if pobjectdef(rd)^.is_related(pobjectdef(ld)) then
-                right:=gentypeconvnode(right,ld)
+              if is_class_or_interface(rd) and is_class_or_interface(ld) then
+                begin
+                   if pobjectdef(rd)^.is_related(pobjectdef(ld)) then
+                     right:=gentypeconvnode(right,ld)
+                   else
+                     left:=gentypeconvnode(left,rd);
+                end
+              else if is_class_or_interface(rd) then
+                left:=gentypeconvnode(left,rd)
               else
-                left:=gentypeconvnode(left,rd);
+                right:=gentypeconvnode(right,ld);
+
               firstpass(right);
               firstpass(left);
               calcregisters(self,1,0,0);
               case nodetype of
-                 equaln,unequaln : ;
+                 equaln,unequaln:
+                   ;
                  else CGMessage(type_e_mismatch);
               end;
               convdone:=true;
@@ -1229,7 +1237,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.15  2000-11-04 14:25:20  florian
+  Revision 1.16  2000-11-13 11:30:55  florian
+    * some bugs with interfaces and NIL fixed
+
+  Revision 1.15  2000/11/04 14:25:20  florian
     + merged Attila's changes for interfaces, not tested yet
 
   Revision 1.14  2000/10/31 22:02:47  peter

+ 7 - 4
compiler/types.pas

@@ -1584,7 +1584,7 @@ implementation
                   b:=1;
                 end
                else
-               { Class specific }
+               { Class/interface specific }
                 if is_class_or_interface(def_to) then
                  begin
                    { void pointer also for delphi mode }
@@ -1595,8 +1595,8 @@ implementation
                       b:=1;
                     end
                    else
-                   { nil is compatible with class instances }
-                    if (fromtreetype=niln) and is_class(def_to) then
+                   { nil is compatible with class instances and interfaces }
+                    if (fromtreetype=niln) then
                      begin
                        doconv:=tc_equal;
                        b:=1;
@@ -1719,7 +1719,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.21  2000-11-12 23:24:12  florian
+  Revision 1.22  2000-11-13 11:30:55  florian
+    * some bugs with interfaces and NIL fixed
+
+  Revision 1.21  2000/11/12 23:24:12  florian
     * interfaces are basically running
 
   Revision 1.20  2000/11/11 16:13:31  peter