~ chicken-core (chicken-5) 34c7f2e97286cef6a27510670b79249bab160393
commit 34c7f2e97286cef6a27510670b79249bab160393
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Mon Apr 12 12:21:35 2010 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Mon Apr 12 12:21:35 2010 +0200
added ##sys#notice and how csi/chicken set it according to command-line options; converted some warnings to use notice
diff --git a/batch-driver.scm b/batch-driver.scm
index 423bf272..b989c28b 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -199,6 +199,8 @@
(set! inline-locally #t)
(set! inline-globally #t))
(set! disabled-warnings (map string->symbol (collect-options 'disable-warning)))
+ (when (or verbose do-scrutinize)
+ (set! ##sys#notices-enabled #t))
(when (memq 'no-warnings options)
(dribble "Warnings are disabled")
(set! ##sys#warnings-enabled #f) )
@@ -451,7 +453,8 @@
(display-line-number-database) )
(when (and unit-name dynamic)
- (compiler-warning 'usage "library unit `~a' compiled in dynamic mode" unit-name) )
+ (##sys#notice
+ (sprintf "library unit `~a' compiled in dynamic mode" unit-name) ) )
(set! ##sys#line-number-database line-number-database-2)
(set! line-number-database-2 #f)
diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index ed7524cf..3ee16eea 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -486,7 +486,7 @@
(expand rclauses #t)
`(##core#begin ,@(cdr clause)) )
(else?
- (##sys#warn
+ (##sys#notice
"non-`else' clause following `else' clause in `cond'"
(##sys#strip-syntax clause))
(expand rclauses #t)
diff --git a/compiler.scm b/compiler.scm
index cb856acb..aa31df8a 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -1909,7 +1909,8 @@
(compiler-warning 'var "local assignment to unused variable `~S' may be unintended" sym) )
(when (and (not (variable-visible? sym))
(not (variable-mark sym '##compiler#constant)) )
- (compiler-warning 'var "global variable `~S' is never used" sym) ) )
+ (##sys#notice
+ (sprintf "global variable `~S' is never used" sym) ) ) )
;; Make 'boxed, if 'assigned & 'captured:
(when (and assigned captured)
diff --git a/csi.scm b/csi.scm
index 58ae43d7..1d992bbf 100644
--- a/csi.scm
+++ b/csi.scm
@@ -64,6 +64,7 @@ EOF
(set! ##sys#repl-print-length-limit 2048)
(set! ##sys#features (cons #:csi ##sys#features))
+(set! ##sys#notices-enabled #t)
;;; Print all sorts of information:
@@ -780,7 +781,8 @@ EOF
(do ([x (read in) (read in)])
((eof-object? x))
(rec (receive (eval x))) ) ) )
- (when quietflag (set! ##sys#eval-debug-level 0))
+ (when quietflag
+ (set! ##sys#eval-debug-level 0))
(when (member* '("-h" "-help" "--help") args)
(print-usage)
(exit 0) )
@@ -833,6 +835,8 @@ EOF
(parentheses-synonyms #f)
(symbol-escape #f) )
(unless (or (member* '("-n" "-no-init") args) script) (loadinit))
+ (when batch
+ (set! ##sys#notices-enabled #f))
(do ([args args (cdr args)])
((null? args)
(unless batch
diff --git a/eval.scm b/eval.scm
index 315ecc0c..94bd62b2 100644
--- a/eval.scm
+++ b/eval.scm
@@ -726,7 +726,9 @@
[(##core#declare)
(if (memq #:compiling ##sys#features)
(for-each (lambda (d) (##compiler#process-declaration d se)) (cdr x))
- (##sys#warn "declarations are ignored in interpreted code" x) )
+ (##sys#notice
+ "declarations are ignored in interpreted code"
+ x) )
(compile '(##core#undefined) e #f tf cntr se) ]
[(##core#define-inline ##core#define-constant)
diff --git a/expand.scm b/expand.scm
index fc9421bf..6affc568 100644
--- a/expand.scm
+++ b/expand.scm
@@ -911,13 +911,13 @@
(set! prims (cons imp prims)))
(and-let* ((a (assq id (import-env)))
((not (eq? aid (cdr a)))))
- (##sys#warn "re-importing already imported identifier" id))))
+ (##sys#notice "re-importing already imported identifier" id))))
vsv)
(for-each
(lambda (imp)
(and-let* ((a (assq (car imp) (macro-env)))
((not (eq? (cdr imp) (cdr a)))))
- (##sys#warn "re-importing already imported syntax" (car imp))) )
+ (##sys#notice "re-importing already imported syntax" (car imp))) )
vss)
(when reexp?
(unless cm
@@ -1141,7 +1141,7 @@
(expand rclauses #t)
`(##core#begin ,@(cdr clause)))
(else?
- (##sys#warn
+ (##sys#notice
"non-`else' clause following `else' clause in `cond'"
(##sys#strip-syntax clause))
(expand rclauses #t)
@@ -1191,7 +1191,7 @@
(expand rclauses #t)
`(##core#begin ,@(cdr clause)) )
(else?
- (##sys#warn
+ (##sys#notice
"non-`else' clause following `else' clause in `case'"
(##sys#strip-syntax clause))
(expand rclauses #t)
@@ -1524,9 +1524,9 @@
(define (check-for-redef sym env senv)
(and-let* ((a (assq sym env)))
- (##sys#warn "redefinition of imported value binding" sym) )
+ (##sys#notice "redefinition of imported value binding" sym) )
(and-let* ((a (assq sym senv)))
- (##sys#warn "redefinition of imported syntax binding" sym)))
+ (##sys#notice "redefinition of imported syntax binding" sym)))
(define (##sys#register-export sym mod)
(when mod
diff --git a/library.scm b/library.scm
index 82c2dbe6..50dffbd2 100644
--- a/library.scm
+++ b/library.scm
@@ -202,11 +202,17 @@ EOF
(##sys#signal-hook #:error #f)))
(define ##sys#warnings-enabled #t)
+(define ##sys#notices-enabled (##sys#fudge 13))
(define (##sys#warn msg . args)
(when ##sys#warnings-enabled
(apply ##sys#signal-hook #:warning msg args) ) )
+(define (##sys#notice msg . args)
+ (when (and ##sys#notices-enabled
+ ##sys#warnings-enabled)
+ (apply ##sys#signal-hook #:notice msg args) ) )
+
(define (enable-warnings . bool)
(if (pair? bool)
(set! ##sys#warnings-enabled (car bool))
@@ -3518,8 +3524,10 @@ EOF
'condition
'(user-interrupt)
'() ) ) ]
- [(#:warning)
- (##sys#print "\nWarning: " #f ##sys#standard-error)
+ [(#:warning #:notice)
+ (##sys#print
+ (if (eq? mode #:warning) "\nWarning: " "\nNote: ")
+ #f ##sys#standard-error)
(##sys#print msg #f ##sys#standard-error)
(if (or (null? args) (fx> (length args) 1))
(##sys#write-char-0 #\newline ##sys#standard-error)
diff --git a/optimizer.scm b/optimizer.scm
index 14a39f27..596bc44f 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -90,10 +90,9 @@
(scan val e)
(let ((p (alist-ref var previous)))
(when (and p (not (memq var unsafe)))
- (compiler-warning
- 'var
- "dropping assignment of unused value to global variable `~s'"
- var)
+ (##sys#notice
+ (sprintf "dropping assignment of unused value to global variable `~s'"
+ var))
(copy-node!
(make-node '##core#undefined '() '())
p))
diff --git a/rules.make b/rules.make
index 7569437e..08563244 100644
--- a/rules.make
+++ b/rules.make
@@ -1048,8 +1048,8 @@ check: $(CHICKEN_SHARED_EXECUTABLE) $(CSI_SHARED_EXECUTABLE) $(CSC_PROGRAM)
stage1:
$(MAKE) -f $(SRCDIR)Makefile.$(PLATFORM) PLATFORM=$(PLATFORM) \
SRCDIR=$(SRCDIR) STATICBUILD=1 DEBUGBUILD=1 CHICKEN=$(CHICKEN) \
- confclean clean $(CHICKEN_PROGRAM)
- $(COPY_COMMAND) $(CHICKEN_PROGRAM) $(CHICKEN_PROGRAM)-stage1$(EXE)
+ confclean clean $(CHICKEN_PROGRAM)$(EXE)
+ $(COPY_COMMAND) $(CHICKEN_PROGRAM)$(EXE) $(CHICKEN_PROGRAM)-stage1$(EXE)
-chmod +x $(CHICKEN_PROGRAM)-stage1$(EXE)
-touch *.scm
$(MAKE) -f $(SRCDIR)Makefile.$(PLATFORM) SRCDIR=$(SRCDIR) stage2
@@ -1059,7 +1059,7 @@ stage1:
stage2:
$(MAKE) -f $(SRCDIR)Makefile.$(PLATFORM) PLATFORM=$(PLATFORM) \
SRCDIR=$(SRCDIR) STATICBUILD=1 DEBUGBUILD=1 \
- CHICKEN=./$(CHICKEN_PROGRAM)-stage1 clean $(CHICKEN_PROGRAM)
+ CHICKEN=./$(CHICKEN_PROGRAM)-stage1 clean $(CHICKEN_PROGRAM)$(EXE)
$(COPY_COMMAND) $(CHICKEN_PROGRAM) $(CHICKEN_PROGRAM)-stage2$(EXE)
-chmod +x $(CHICKEN_PROGRAM)-stage2$(EXE)
-touch *.scm
@@ -1070,5 +1070,6 @@ stage2:
# or runtime libraries
stage3:
$(MAKE) -f $(SRCDIR)Makefile.$(PLATFORM) PLATFORM=$(PLATFORM) \
- SRCDIR=$(SRCDIR) CONFIG=$(CONFIG) CHICKEN=./$(CHICKEN_PROGRAM)-stage2 \
+ SRCDIR=$(SRCDIR) CONFIG=$(CONFIG) \
+ CHICKEN=./$(CHICKEN_PROGRAM)-stage2 \
confclean clean all
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 99515b98..4794cef0 100644
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -1,5 +1,8 @@
#!/bin/sh
-# runtests.sh
+# runtests.sh - run CHICKEN testsuite
+#
+# - Note: this needs a proper shell, so it will not work with plain mingw
+# (just the compiler and the Windows shell, without MSYS)
set -e
TEST_DIR=`pwd`
Trap