branch: externals/relint
commit d2b71948b8fd3736c4892a249f34455eac0d86be
Author: Mattias Engdegård <[email protected]>
Commit: Mattias Engdegård <[email protected]>
Evaluate `dolist' and `while'
`dolist' is special-cased for speed right now, but could also be
expanded and handled by `while' if implemented. `while' is capped at
100 iterations to guarantee reasonable progress.
---
relint.el | 30 ++++++++++++++++++++++++++++++
test/7.elisp | 21 +++++++++++++++++++++
test/7.expected | 6 ++++++
3 files changed, 57 insertions(+)
diff --git a/relint.el b/relint.el
index 1e89278..90fc73b 100644
--- a/relint.el
+++ b/relint.el
@@ -769,6 +769,36 @@ not be evaluated safely."
(relint--eval `(let* ,(cdr bindings) ,@(cdr body))))
(relint--eval-body (cdr body)))))
+ ;; dolist: simulate its operation. We could also expand it,
+ ;; but this is somewhat faster.
+ ((eq head 'dolist)
+ (unless (and (>= (length body) 2)
+ (consp (car body)))
+ (throw 'relint-eval 'no-value))
+ (let ((var (nth 0 (car body)))
+ (seq-arg (nth 1 (car body)))
+ (res-arg (nth 2 (car body))))
+ (unless (symbolp var)
+ (throw 'relint-eval 'no-value))
+ (let ((seq (relint--eval-list seq-arg)))
+ (while (consp seq)
+ (let ((relint--locals (cons (list var (car seq))
+ relint--locals)))
+ (relint--eval-body (cdr body)))
+ (setq seq (cdr seq))))
+ (and res-arg (relint--eval res-arg))))
+
+ ;; while: this slows down simulation noticeably, but catches some
+ ;; mistakes.
+ ((eq head 'while)
+ (let ((condition (car body))
+ (loops 0))
+ (while (and (relint--eval condition)
+ (< loops 100))
+ (relint--eval-body (cdr body))
+ (setq loops (1+ loops)))
+ nil))
+
;; Loose comma: can occur if we unwittingly stumbled into a backquote
;; form. Just eval the arg and hope for the best.
((eq head '\,)
diff --git a/test/7.elisp b/test/7.elisp
new file mode 100644
index 0000000..b0ed01c
--- /dev/null
+++ b/test/7.elisp
@@ -0,0 +1,21 @@
+;;; Relint test file 7 -*- emacs-lisp -*-
+
+(defun my-dolist-fun (seq)
+ (let ((s ""))
+ (dolist (c seq)
+ (setq s (concat s (char-to-string c))))
+ s))
+
+(defun test-dolist ()
+ (looking-at (my-dolist-fun '(?a ?b ?^))))
+
+(defun my-while-fun ()
+ (let ((s "")
+ (c ?!))
+ (while (< c ?&)
+ (setq s (concat s (char-to-string c)))
+ (setq c (1+ c)))
+ s))
+
+(defun test-while ()
+ (looking-at (my-while-fun)))
diff --git a/test/7.expected b/test/7.expected
new file mode 100644
index 0000000..5275a63
--- /dev/null
+++ b/test/7.expected
@@ -0,0 +1,6 @@
+7.elisp:10:15: In call to looking-at: Unescaped literal `^' (pos 2)
+ "ab^"
+ ..^
+7.elisp:21:15: In call to looking-at: Unescaped literal `$' (pos 3)
+ "!\"#$%"
+ ....^
