summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2020-05-08 16:32:40 +0200
committerAndy Wingo <wingo@pobox.com>2020-05-08 16:35:04 +0200
commite9c0f3071dedb0f6b39757e920cdc182435c8725 (patch)
tree4b1117f8ab107fa274ee9c1ff01fabdaf0aee67e
parent220934c49d2629ebf826cc377541694334f44e7e (diff)
downloadguile-e9c0f3071dedb0f6b39757e920cdc182435c8725.tar.gz
Warning and optimization levels always small integers
* module/language/tree-il/analyze.scm (make-analyzer): Expect an int for optimization level. * module/scripts/compile.scm (%options, show-warning-help): No more -Wnone / Wall; use -W0 or -W9 instead. * module/system/base/compile.scm (level-validator): Validate small int. (compute-analyzer, add-default-optimizations): Likewise. * test-suite/tests/optargs.test (without-compiler-warnings): * test-suite/tests/tree-il.test (call-with-warnings): Parameterize level to 0, not #f. * bootstrap/Makefile.am (GUILE_WARNINGS): Use -W0, not -Wnone.
-rw-r--r--bootstrap/Makefile.am2
-rw-r--r--module/language/tree-il/analyze.scm5
-rw-r--r--module/scripts/compile.scm10
-rw-r--r--module/system/base/compile.scm13
-rw-r--r--test-suite/tests/optargs.test2
-rw-r--r--test-suite/tests/tree-il.test2
6 files changed, 13 insertions, 21 deletions
diff --git a/bootstrap/Makefile.am b/bootstrap/Makefile.am
index ddcbfe54a..2753b6950 100644
--- a/bootstrap/Makefile.am
+++ b/bootstrap/Makefile.am
@@ -21,7 +21,7 @@
## Fifth Floor, Boston, MA 02110-1301 USA
-GUILE_WARNINGS = -Wnone
+GUILE_WARNINGS = -W0
# Loading eval.go happens before boot and therefore before modules are
# resolved. For some reason if compiled without resolve-primitives,
# attempts to resolve primitives at boot fail; weird. Should fix this
diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index 7b5612bcf..c63d161be 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -1098,10 +1098,7 @@ resort, return #t when EXP refers to the global variable SPECIAL-NAME."
#(format 1 ,format-analysis)))
(define (make-analyzer warning-level warnings)
- (define (enabled-for-level? level)
- (match warning-level
- ((? boolean?) warning-level)
- ((? exact-integer?) (>= warning-level level))))
+ (define (enabled-for-level? level) (<= level warning-level))
(let ((analyses (filter-map (match-lambda
(#(kind level analysis)
(and (or (enabled-for-level? level)
diff --git a/module/scripts/compile.scm b/module/scripts/compile.scm
index ea6377b48..7b6daea85 100644
--- a/module/scripts/compile.scm
+++ b/module/scripts/compile.scm
@@ -87,12 +87,6 @@
("help"
(show-warning-help)
(exit 0))
- ("all"
- (alist-cons 'warning-level #t
- (alist-delete 'warning-level result)))
- ("none"
- (alist-cons 'warning-level #f
- (alist-delete 'warning-level result)))
((? string->number)
(let ((n (string->number arg)))
(unless (and (exact-integer? n) (<= 0 n))
@@ -176,8 +170,8 @@ There is NO WARRANTY, to the extent permitted by law.~%"))
(warning-type-description wt)))
%warning-types)
(format #t "~%")
- (format #t "You may also specify warning levels as `-Wnone', `-W0`, `-W1',~%")
- (format #t "`-W2', `-W3', or `-Wall`. The default is `-W1'.~%"))
+ (format #t "You may also specify warning levels as `-W0`, `-W1',~%")
+ (format #t "`-W2', or `-W3'. The default is `-W1'.~%"))
(define (show-optimization-help)
(format #t "The available optimizations are:~%~%")
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 8ffbb294f..7ec2da3c2 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -34,12 +34,11 @@
(define (level-validator x)
- (match x
- ((? boolean?) x)
- ((and (? exact-integer?) (not (? negative?))) x)
- (_ (error
- "bad warning or optimization level: expected #f, #t, or integer >= 0"
- x))))
+ (unless (and (exact-integer? x) (<= 0 x 9))
+ (error
+ "bad warning or optimization level: expected integer between 0 and 9"
+ x))
+ x)
(define default-warning-level (make-parameter 1 level-validator))
(define default-optimization-level (make-parameter 2 level-validator))
@@ -215,6 +214,7 @@
;;;
(define (compute-analyzer lang warning-level opts)
+ (level-validator warning-level)
(match (language-analyzer lang)
(#f (lambda (exp env) (values)))
(proc (proc warning-level
@@ -225,6 +225,7 @@
((_ _ . opts) (lp opts))))))))
(define (add-default-optimizations lang optimization-level opts)
+ (level-validator optimization-level)
(match (language-optimizations-for-level lang)
(#f opts)
(get-opts (append opts (get-opts optimization-level)))))
diff --git a/test-suite/tests/optargs.test b/test-suite/tests/optargs.test
index bd07fb3e4..b44f15a9a 100644
--- a/test-suite/tests/optargs.test
+++ b/test-suite/tests/optargs.test
@@ -48,7 +48,7 @@
;;;
(define-syntax-rule (without-compiler-warnings exp ...)
- (parameterize ((default-warning-level #f)) exp ...))
+ (parameterize ((default-warning-level 0)) exp ...))
(without-compiler-warnings
(with-test-prefix/c&e "let-keywords"
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index c326f6031..863157a09 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -242,7 +242,7 @@
(define (call-with-warnings thunk)
(let ((port (open-output-string)))
;; Disable any warnings added by default.
- (parameterize ((default-warning-level #f))
+ (parameterize ((default-warning-level 0))
(with-fluids ((*current-warning-port* port)
(*current-warning-prefix* ""))
(thunk)))