* properly fixed assigned() mess (by handling it separately in ncginl)

-> all assigned()-related tests in the test suite work again

compiler/nadd.pas

@@ -1055,23 +1055,6 @@ implementation
           begin
             if not(nodetype in [equaln,unequaln]) then
              CGMessage(type_e_mismatch);
-            { convert both to voidpointer, because methodpointers are 8 bytes }
-            { even though only the first 4 bytes must be compared (JM)        }
-            if ([m_delphi,m_tp7] * aktmodeswitches <> []) then
-              begin
-                if (lt = loadn) then
-                  begin
-                    left := caddrnode.create(left);
-                    resulttypepass(left);
-                  end;
-                if (rt = loadn) then
-                  begin
-                    right := caddrnode.create(right);
-                    resulttypepass(right);
-                  end;
-              end;
-            inserttypeconv_explicit(left,voidpointertype);
-            inserttypeconv_explicit(right,voidpointertype);
           end
 
        { support dynamicarray=nil,dynamicarray<>nil }
@@ -1903,7 +1886,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.103  2003-12-30 16:30:50  jonas
+  Revision 1.104  2003-12-31 20:47:02  jonas
+    * properly fixed assigned() mess (by handling it separately in ncginl)
+      -> all assigned()-related tests in the test suite work again
+
+  Revision 1.103  2003/12/30 16:30:50  jonas
     * fixed previous commit for tp and delphi modes
 
   Revision 1.102  2003/12/29 22:33:08  jonas

compiler/ncginl.pas

@@ -47,6 +47,7 @@ interface
           procedure second_ln_real; virtual;
           procedure second_cos_real; virtual;
           procedure second_sin_real; virtual;
+          procedure second_assigned; virtual;
        end;
 
 implementation
@@ -140,6 +141,10 @@ implementation
               begin
                  second_cos_real;
               end;
+            in_assigned_x:
+              begin
+                second_assigned;
+              end;
 {$ifdef SUPPORT_MMX}
             in_mmx_pcmpeqb..in_mmx_pcmpgtw:
               begin
@@ -650,13 +655,32 @@ implementation
         internalerror(20020718);
       end;
 
+{*****************************************************************************
+                         ASSIGNED GENERIC HANDLING
+*****************************************************************************}
+
+    procedure tcginlinenode.second_assigned;
+      begin
+        secondpass(tcallparanode(left).left);
+        { force left to be an OS_ADDR, since in case of method procvars }
+        { the size is 2*OS_ADDR (JM)                                    }
+        cg.a_cmp_const_loc_label(exprasmlist,OS_ADDR,OC_NE,0,tcallparanode(left).left.location,truelabel);
+        cg.a_jmp_always(exprasmlist,falselabel);
+        location_reset(location,LOC_JUMP,OS_NO);
+      end;
+
+
 begin
    cinlinenode:=tcginlinenode;
 end.
 
 {
   $Log$
-  Revision 1.49  2003-12-06 01:15:22  florian
+  Revision 1.50  2003-12-31 20:47:02  jonas
+    * properly fixed assigned() mess (by handling it separately in ncginl)
+      -> all assigned()-related tests in the test suite work again
+
+  Revision 1.49  2003/12/06 01:15:22  florian
     * reverted Peter's alloctemp patch; hopefully properly
 
   Revision 1.48  2003/12/03 23:13:20  peter

compiler/ninl.pas

@@ -1603,14 +1603,26 @@ implementation
 
               in_assigned_x:
                 begin
-                   result := caddnode.create(unequaln,tcallparanode(left).left,cnilnode.create);
-                   tcallparanode(left).left := nil;
-                   { free left, because otherwise some code at 'myexit' tries  }
-                   { to run get_paratype for it, which crashes since left.left }
-                   { is now nil                                                }
-                   left.free;
-                   left := nil;
-                   goto myexit;
+                  { the parser has already made sure the expression is valid }
+
+                  { handle constant expressions }
+                  if is_constnode(tcallparanode(left).left) or
+                     (tcallparanode(left).left.nodetype = pointerconstn) then
+                    begin
+                      { let an add node figure it out }
+                      result := caddnode.create(unequaln,tcallparanode(left).left,cnilnode.create);
+                      tcallparanode(left).left := nil;
+                      { free left, because otherwise some code at 'myexit' tries  }
+                      { to run get_paratype for it, which crashes since left.left }
+                      { is now nil                                                }
+                      left.free;
+                      left := nil;
+                      goto myexit;
+                    end;
+                  { otherwise handle separately, because there could be a procvar, which }
+                  { is 2*sizeof(pointer), while we must only check the first pointer     }
+                  set_varstate(tcallparanode(left).left,vs_used,true);
+                  resulttype:=booltype;
                 end;
 
               in_ofs_x :
@@ -2076,8 +2088,8 @@ implementation
 
           in_assigned_x:
             begin
-               { should be removed in resulttype pass }
-               internalerror(2002080201);
+              expectloc := LOC_JUMP;
+              registers32:=1;
             end;
 
           in_pred_x,
@@ -2354,7 +2366,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.125  2003-12-27 22:27:55  peter
+  Revision 1.126  2003-12-31 20:47:02  jonas
+    * properly fixed assigned() mess (by handling it separately in ncginl)
+      -> all assigned()-related tests in the test suite work again
+
+  Revision 1.125  2003/12/27 22:27:55  peter
     * support type convs for write typed
 
   Revision 1.124  2003/12/08 21:17:12  jonas