[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-4-94-g5e5
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-4-94-g5e5351f |
|
Date: |
Sun, 08 Nov 2009 00:16:00 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=5e5351f8f83103da4ddd508f5b68f83d4342ec43
The branch, master has been updated
via 5e5351f8f83103da4ddd508f5b68f83d4342ec43 (commit)
via 6f6f0dac0188db7b5bb3cd84dce0c9fb015cf53f (commit)
via 19977b7ce0f112534feb75c2eb2d497e596bae4e (commit)
via bd36e901321eee0310d9ad14ff698ec85c006d26 (commit)
via 632e7c3200ced96635912932397d26813464c83b (commit)
via af5ed549271a8939f8b02599dc6eb6fd5c174bea (commit)
from 5658035c9c7c2688ca90cd6241c1687bde8c992c (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 5e5351f8f83103da4ddd508f5b68f83d4342ec43
Author: Ludovic Courtès <address@hidden>
Date: Sun Nov 8 01:15:23 2009 +0100
Update `.gitignore'.
commit 6f6f0dac0188db7b5bb3cd84dce0c9fb015cf53f
Author: Ludovic Courtès <address@hidden>
Date: Sun Nov 8 01:13:46 2009 +0100
Fix C99-style comments.
* libguile/generalized-vectors.c, libguile/programs.c, libguile/vm.c:
Replace C99-style comments by plain old C89 comments.
commit 19977b7ce0f112534feb75c2eb2d497e596bae4e
Author: Ludovic Courtès <address@hidden>
Date: Sun Nov 8 01:12:35 2009 +0100
Compile with `-Warity-mismatch'.
* am/guilec (GUILE_WARNINGS): New variable; add `-Warity-mismatch'.
(.scm.go): Use it.
commit bd36e901321eee0310d9ad14ff698ec85c006d26
Author: Ludovic Courtès <address@hidden>
Date: Sun Nov 8 01:11:19 2009 +0100
Add tests for `unbound-variable-analysis'.
* test-suite/tests/tree-il.test ("warnings")["unbound
variable"]("optional arguments are visible", "keyword arguments are
visible"): New tests.
commit 632e7c3200ced96635912932397d26813464c83b
Author: Ludovic Courtès <address@hidden>
Date: Sun Nov 8 01:08:54 2009 +0100
Fix optional argument handling in `unused-variable-analysis'.
* module/language/tree-il/analyze.scm (unused-variable-analysis): Fix
optional argument handling in <lambda-case>.
commit af5ed549271a8939f8b02599dc6eb6fd5c174bea
Author: Ludovic Courtès <address@hidden>
Date: Sun Nov 8 01:02:08 2009 +0100
Add support for keyword arguments in `arity-mismatch-analysis'.
* module/language/tree-il/analyze.scm
(validate-arity)[filter-keyword-args]: New procedure.
[arity]: Get accurate arity for programs, return ALLOW-OTHER-KEYS? as
an additional value.
Update to `arity' change; use `filter-keyword-args'.
* test-suite/tests/tree-il.test ("warnings")["arity mismatch"]("keyword
not passed and quiet", "keyword passed and quiet", "keyword passed to
global and quiet", "extra keyword", "extra keywords allowed"): New
tests.
-----------------------------------------------------------------------
Summary of changes:
am/guilec | 4 +-
libguile/generalized-vectors.c | 2 +-
libguile/programs.c | 4 +-
libguile/vm.c | 2 +-
module/language/tree-il/analyze.scm | 76 +++++++++++++++++++++++------------
test-suite/standalone/.gitignore | 1 +
test-suite/tests/tree-il.test | 62 ++++++++++++++++++++++++++++-
7 files changed, 119 insertions(+), 32 deletions(-)
diff --git a/am/guilec b/am/guilec
index 00366d8..fec1d36 100644
--- a/am/guilec
+++ b/am/guilec
@@ -1,6 +1,8 @@
# -*- makefile -*-
GOBJECTS = $(SOURCES:%.scm=%.go)
+GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch
+
moddir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)/$(modpath)
nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES)
ccachedir = $(pkglibdir)/$(GUILE_EFFECTIVE_VERSION)/ccache/$(modpath)
@@ -32,4 +34,4 @@ SUFFIXES = .scm .go
.scm.go:
GUILE_AUTO_COMPILE=0 \
$(top_builddir)/meta/uninstalled-env \
- guile-tools compile -Wunbound-variable -o "$@" "$<"
+ guile-tools compile $(GUILE_WARNINGS) -o "$@" "$<"
diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c
index 2d437a4..4e3b924 100644
--- a/libguile/generalized-vectors.c
+++ b/libguile/generalized-vectors.c
@@ -178,7 +178,7 @@ SCM_DEFINE (scm_generalized_vector_to_list,
"generalized-vector->list", 1, 0, 0,
ssize_t pos, i = 0;
scm_t_array_handle h;
scm_generalized_vector_get_handle (v, &h);
- // FIXME CHECKME
+ /* FIXME CHECKME */
for (pos = h.dims[0].ubnd, i = (h.dims[0].ubnd - h.dims[0].lbnd + 1);
i >= 0;
pos += h.dims[0].inc)
diff --git a/libguile/programs.c b/libguile/programs.c
index 7399fa0..646443a 100644
--- a/libguile/programs.c
+++ b/libguile/programs.c
@@ -26,8 +26,8 @@
#include "instructions.h"
#include "modules.h"
#include "programs.h"
-#include "procprop.h" // scm_sym_name
-#include "srcprop.h" // scm_sym_filename
+#include "procprop.h" /* scm_sym_name */
+#include "srcprop.h" /* scm_sym_filename */
#include "vm.h"
diff --git a/libguile/vm.c b/libguile/vm.c
index df02f05..1c5efd2 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -158,7 +158,7 @@ vm_dispatch_hook (struct scm_vm *vp, SCM hook, SCM
hook_args)
return;
scm_dynwind_begin (0);
- // FIXME, stack holder should be the vm
+ /* FIXME, stack holder should be the vm */
vp->trace_frame = scm_c_make_vm_frame (SCM_BOOL_F, vp->fp, vp->sp, vp->ip,
0);
scm_dynwind_unwind_handler (enfalsen_frame, vp, SCM_F_WIND_EXPLICITLY);
diff --git a/module/language/tree-il/analyze.scm
b/module/language/tree-il/analyze.scm
index 1478b8d..286dc51 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -23,6 +23,7 @@
#:use-module (srfi srfi-9)
#:use-module (system base syntax)
#:use-module (system base message)
+ #:use-module (system vm program)
#:use-module (language tree-il)
#:export (analyze-lexicals
analyze-tree
@@ -570,9 +571,8 @@
(make-binding-info vars (cons gensym refs)
(cons src locs)))
((<lambda-case> req opt inits rest kw vars)
- ;; FIXME keywords.
(let ((names `(,@req
- ,@(map car (or opt '()))
+ ,@(or opt '())
,@(if rest (list rest) '())
,@(if kw (map cadr (cdr kw)) '()))))
(make-binding-info (extend vars names) refs
@@ -761,7 +761,7 @@
;;; Arity analysis.
;;;
-;; <arity-info> records contains information about lexical definitions of
+;; <arity-info> records contain information about lexical definitions of
;; procedures currently in scope, top-level procedure definitions that have
;; been encountered, and calls to top-level procedures that have been
;; encountered.
@@ -776,6 +776,26 @@
;; Validate the argument count of APPLICATION, a tree-il application of
;; PROC, emitting a warning in case of argument count mismatch.
+ (define (filter-keyword-args keywords allow-other-keys? args)
+ ;; Filter keyword arguments from ARGS and return the resulting list.
+ ;; KEYWORDS is the list of allowed keywords, and ALLOW-OTHER-KEYS?
+ ;; specified whethere keywords not listed in KEYWORDS are allowed.
+ (let loop ((args args)
+ (result '()))
+ (if (null? args)
+ (reverse result)
+ (let ((arg (car args)))
+ (if (and (const? arg)
+ (or (memq (const-exp arg) keywords)
+ (and allow-other-keys?
+ (keyword? (const-exp arg)))))
+ (loop (if (pair? (cdr args))
+ (cddr args)
+ '())
+ result)
+ (loop (cdr args)
+ (cons arg result)))))))
+
(define (arity proc)
;; Return the arity of PROC, which can be either a tree-il or a
;; procedure.
@@ -783,44 +803,48 @@
(or (and (or (null? x) (pair? x))
(length x))
0))
- (cond ;; FIXME: Handle programs to get accurate arity info?
- ;; ((program? proc)
- ;; (let ((a (program-arities proc)))
- ;; (values (program-name proc)
- ;; (arity:nreq a) (arity:nopt a) (arity:rest? a)
- ;; (arity:kw a))))
+ (cond ((program? proc)
+ (let ((a (car (last-pair (program-arities proc)))))
+ (values (program-name proc)
+ (arity:nreq a) (arity:nopt a) (arity:rest? a)
+ (map car (arity:kw a)) (arity:allow-other-keys? a))))
((procedure? proc)
(let ((arity (procedure-property proc 'arity)))
(values (procedure-name proc)
- (car arity) (cadr arity) (caddr arity) 0)))
+ (car arity) (cadr arity) (caddr arity)
+ #f #f)))
(else
(let loop ((name #f)
(proc proc))
(record-case proc
((<lambda-case> req opt rest kw)
- (values name (len req) (len opt) rest (len kw)))
+ (values name (len req) (len opt) rest
+ (and (pair? kw) (map car (cdr kw)))
+ (and (pair? kw) (car kw))))
((<lambda> meta body)
(loop (assoc-ref meta 'name) body))
(else
- (values #f #f #f #f #f)))))))
+ (values #f #f #f #f #f #f)))))))
(let ((args (application-args application))
(src (tree-il-src application)))
(call-with-values (lambda () (arity proc))
- (lambda (name req opt rest kw)
- ;; FIXME: handle keyword arguments
- (if (and req opt)
- (let ((count (length args)))
- (if (or (< count req)
- (and (not rest)
- (> count (+ req opt))))
- (warning 'arity-mismatch src
- (or name
- (with-output-to-string
- (lambda ()
- (write proc))))
- (and lexical? (= 0 kw)))))
- #t))))
+ (lambda (name req opt rest kw aok?)
+ (let ((args (if (pair? kw)
+ (filter-keyword-args kw aok? args)
+ args)))
+ (if (and req opt)
+ (let ((count (length args)))
+ (if (or (< count req)
+ (and (not rest)
+ (> count (+ req opt))))
+ (warning 'arity-mismatch src
+ (or name
+ (with-output-to-string
+ (lambda ()
+ (write proc))))
+ lexical?)))
+ #t)))))
#t)
(define arity-analysis
diff --git a/test-suite/standalone/.gitignore b/test-suite/standalone/.gitignore
index 1943936..94b4307 100644
--- a/test-suite/standalone/.gitignore
+++ b/test-suite/standalone/.gitignore
@@ -11,3 +11,4 @@
/test-fast-slot-ref
/test-scm-take-locale-symbol
/test-scm-take-u8vector
+/test-loose-ends
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 4104271..01ce39e 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -674,6 +674,20 @@
#:env m
#:opts %opts-w-unbound)))))))
+ (pass-if "optional arguments are visible"
+ (null? (call-with-warnings
+ (lambda ()
+ (compile '(lambda* (x #:optional y z) (list x y z))
+ #:opts %opts-w-unbound
+ #:to 'assembly)))))
+
+ (pass-if "keyword arguments are visible"
+ (null? (call-with-warnings
+ (lambda ()
+ (compile '(lambda* (x #:key y z) (list x y z))
+ #:opts %opts-w-unbound
+ #:to 'assembly)))))
+
(pass-if "GOOPS definitions are visible"
(let ((m (make-module))
(v (gensym)))
@@ -808,4 +822,50 @@
(define (foo x) (cons))")))
(read-and-compile in
#:opts %opts-w-arity
- #:to 'assembly))))))))
+ #:to 'assembly))))))
+
+ (pass-if "keyword not passed and quiet"
+ (null? (call-with-warnings
+ (lambda ()
+ (compile '(let ((f (lambda* (x #:key y) y)))
+ (f 2))
+ #:opts %opts-w-arity
+ #:to 'assembly)))))
+
+ (pass-if "keyword passed and quiet"
+ (null? (call-with-warnings
+ (lambda ()
+ (compile '(let ((f (lambda* (x #:key y) y)))
+ (f 2 #:y 3))
+ #:opts %opts-w-arity
+ #:to 'assembly)))))
+
+ (pass-if "keyword passed to global and quiet"
+ (null? (call-with-warnings
+ (lambda ()
+ (let ((in (open-input-string "
+ (use-modules (system base compile))
+ (compile '(+ 2 3) #:env (current-module))")))
+ (read-and-compile in
+ #:opts %opts-w-arity
+ #:to 'assembly))))))
+
+ (pass-if "extra keyword"
+ (let ((w (call-with-warnings
+ (lambda ()
+ (compile '(let ((f (lambda* (x #:key y) y)))
+ (f 2 #:Z 3))
+ #:opts %opts-w-arity
+ #:to 'assembly)))))
+ (and (= (length w) 1)
+ (number? (string-contains (car w)
+ "wrong number of arguments to")))))
+
+ (pass-if "extra keywords allowed"
+ (null? (call-with-warnings
+ (lambda ()
+ (compile '(let ((f (lambda* (x #:key y #:allow-other-keys)
+ y)))
+ (f 2 #:Z 3))
+ #:opts %opts-w-arity
+ #:to 'assembly)))))))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-4-94-g5e5351f,
Ludovic Courtès <=