[Openmcl-cvs-notifications] r13195 - in /trunk/source: compiler/nx-basic.lisp level-1/l1-utils.lisp

[gz at clozure.com]

Author: gz
Date: Thu Nov 12 14:11:32 2009
New Revision: 13195

Log:
Add variable *strict-checking* to control checking for e.g. non-portable th=
ough valid code.  For now it only controls one case - if true, defconstant =
redefinition will require the new value to be eql to the old one.

Modified:
    trunk/source/compiler/nx-basic.lisp
    trunk/source/level-1/l1-utils.lisp

Modified: trunk/source/compiler/nx-basic.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/nx-basic.lisp (original)
+++ trunk/source/compiler/nx-basic.lisp Thu Nov 12 14:11:32 2009
@@ -535,6 +535,9 @@
      (eval-when (:load-toplevel :execute)
        , at body))))
 =

+(defvar *strict-checking* nil
+  "If true, issues warnings/errors in more cases, e.g. for valid but non-p=
ortable code")
+
 =

 ;; Should be true if compiler warnings UI doesn't use source locations, fa=
lse if it does.
 (defvar *merge-compiler-warnings* t "If false, don't merge compiler warnin=
gs with different source locations")

Modified: trunk/source/level-1/l1-utils.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/l1-utils.lisp (original)
+++ trunk/source/level-1/l1-utils.lisp Thu Nov 12 14:11:32 2009
@@ -420,7 +420,8 @@
     (if (constant-symbol-p var)
       (let* ((old-value (%sym-global-value var)))
 	(unless (eq old-value (%unbound-marker-8))
-	  (if (similar-as-constants-p (%sym-global-value var) value)
+	  (if (or (eql old-value value)
+                  (and (not *strict-checking*) (similar-as-constants-p old=
-value value)))
 	    (return)
 	    ;; This should really be a cell error, allow options other than
 	    ;; redefining (such as don't redefine and continue)...