浏览代码

* constant evaluation for assinged added

peter 23 年之前
父节点
当前提交
cb11c08d49
共有 1 个文件被更改,包括 22 次插入2 次删除
  1. 22 2
      compiler/ninl.pas

+ 22 - 2
compiler/ninl.pas

@@ -1494,7 +1494,7 @@ implementation
                             left:=nil;
                             left:=nil;
                             resulttypepass(result);
                             resulttypepass(result);
                             exit;
                             exit;
-                          end;  
+                          end;
                       end;
                       end;
                     else
                     else
                       CGMessage(type_e_mismatch);
                       CGMessage(type_e_mismatch);
@@ -1516,6 +1516,23 @@ implementation
 
 
               in_assigned_x:
               in_assigned_x:
                 begin
                 begin
+                   { assigned(nil) is always false }
+                   if (tcallparanode(left).left.nodetype=niln) then
+                    begin
+                      hp:=cordconstnode.create(0,booltype);
+                      result:=hp;
+                      goto myexit;
+                    end;
+                   { assigned(pointer(n)) is only false when n=0 }
+                   if (tcallparanode(left).left.nodetype=pointerconstn) then
+                    begin
+                      if tpointerconstnode(tcallparanode(left).left).value=0 then
+                       hp:=cordconstnode.create(0,booltype)
+                      else
+                       hp:=cordconstnode.create(1,booltype);
+                      result:=hp;
+                      goto myexit;
+                    end;
                    set_varstate(left,true);
                    set_varstate(left,true);
                    resulttype:=booltype;
                    resulttype:=booltype;
                 end;
                 end;
@@ -2324,7 +2341,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.67  2001-12-28 14:09:21  jonas
+  Revision 1.68  2002-01-19 11:53:56  peter
+    * constant evaluation for assinged added
+
+  Revision 1.67  2001/12/28 14:09:21  jonas
     * fixed web bug 1735 (argument of inc/dec must be made unique) ("merged")
     * fixed web bug 1735 (argument of inc/dec must be made unique) ("merged")
 
 
   Revision 1.66  2001/12/10 14:26:22  jonas
   Revision 1.66  2001/12/10 14:26:22  jonas