sbcl stuff

2020-01-20 14:13:08 -05:00 · 2020-01-20 14:13:08 -05:00 · 5d91dbb667
commit 5d91dbb667
parent 1d1dbc34df
335 changed files with 119806 additions and 1 deletions
--- a/sbcl/.quicklisp/dists/quicklisp/software/slime-v2.24/contrib/test/slime-indentation-tests.el
+++ b/sbcl/.quicklisp/dists/quicklisp/software/slime-v2.24/contrib/test/slime-indentation-tests.el
@ -0,0 +1,81 @@
+(require 'slime-indentation)
+(require 'slime-tests)
+
+(define-common-lisp-style "common-lisp-indent-test"
+    ;; Used to specify a few complex indentation specs for testing.
+    (:inherit "basic")
+    (:indentation
+     (complex-indent.1 ((&whole 4 (&whole 1 1 1 1 (&whole 1 1) &rest 1)
+                                &body) &body))
+     (complex-indent.2 (4 (&whole 4 &rest 1) &body))
+     (complex-indent.3 (4 &body))))
+
+(defun slime-indentation-mess-up-indentation ()
+    (while (not (eobp))
+      (forward-line 1)
+      (unless (looking-at "^$")
+        (cl-case (random 2)
+          (0
+           ;; Delete all leading whitespace -- except for
+           ;; comment lines.
+           (while (and (looking-at " ") (not (looking-at " ;")))
+             (delete-char 1)))
+          (1
+           ;; Insert whitespace random.
+           (let ((n (1+ (random 24))))
+             (while (> n 0) (cl-decf n) (insert " ")))))))
+    (buffer-string))
+
+(eval-and-compile
+  (defun slime-indentation-test-form (test-name bindings expected)
+    `(define-slime-ert-test ,test-name ()
+       ,(format "An indentation test named `%s'" test-name)
+       (with-temp-buffer
+         (lisp-mode)
+         (setq indent-tabs-mode nil)
+         (common-lisp-set-style "common-lisp-indent-test")
+         (let ,(cons `(expected ,expected) bindings)
+           (insert expected)
+           (goto-char (point-min))
+           (let ((mess (slime-indentation-mess-up-indentation)))
+             (when (string= mess expected)
+               (ert-fail "Could not mess up indentation?"))
+             (indent-region (point-min) (point-max))
+             (delete-trailing-whitespace)
+             (should (equal expected (buffer-string))))))))
+  
+  (defun slime-indentation-test-forms-for-file (file)
+    (with-current-buffer
+        (find-file-noselect (concat slime-path
+                                    "/contrib/test/slime-cl-indent-test.txt"))
+      (goto-char (point-min))
+      (cl-loop
+       while (re-search-forward ";;; Test:[\t\n\s]*\\(.*\\)[\t\n\s]" nil t)
+       for test-name = (intern (match-string-no-properties 1))
+       for bindings =
+       (save-restriction
+         (narrow-to-region (point)
+                           (progn (forward-comment
+                                   (point-max))
+                                  (point)))
+         (save-excursion
+           (goto-char (point-min))
+           (cl-loop while
+                    (re-search-forward
+                     "\\([^\s]*\\)[\t\n\s]*:[\t\n\s]*\\(.*\\)[\t\n\s]" nil t)
+                    collect (list
+                             (intern (match-string-no-properties 1))
+                             (car
+                              (read-from-string (match-string-no-properties 2)))))))
+       for expected = (buffer-substring-no-properties (point)
+                                                      (scan-sexps (point)
+                                                                  1))
+       collect (slime-indentation-test-form test-name bindings expected)))))
+
+(defmacro slime-indentation-define-tests ()
+    `(progn
+       ,@(slime-indentation-test-forms-for-file "slime-cl-indent-test.txt")))
+
+(slime-indentation-define-tests)
+
+(provide 'slime-indentation-tests)