changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/lib/skel/tests.lisp

changeset 384: 8fe057887c17
parent: a0f64fed8f2a
child: 121a0253aa3c
author: Richard Westhaver <ellis@rwest.io>
date: Wed, 29 May 2024 23:29:40 -0400
permissions: -rw-r--r--
description: skel refactor1 
     1 ;;; skel/tests.lisp --- skel tests
     2 (defpackage :skel/tests
     3   (:use :cl :skel :rt :log :obj :dat/sxp)
     4   (:import-from :uiop :file-exists-p))
     5 
     6 (in-package :skel/tests)
     7 
     8 (defsuite :skel)
     9 (in-suite :skel)
    10 
    11 (defvar %tmp)
    12 (defun tmp-path (ext)
    13   (setq %tmp (format nil "/tmp/~A.~A" (gensym) ext)))
    14 
    15 (defun do-tmp-path (file &rest body)
    16   (prog1 body
    17     (when (file-exists-p file) (delete-file file))))
    18 
    19 (defun skels (c)
    20   (let ((s))
    21     (loop for i from 1 to c
    22 	  do (push (id (make-instance 'sk-project :name (gensym))) s))
    23     s))
    24 
    25 (deftest sanity ()
    26   "IDs should be reasonably unique."
    27   (is (eq t (apply #'/= (skels 1000)))))
    28 
    29 (deftest header-comments ()
    30   "Make sure header comments are generated correctly. 
    31 
    32 This covers variations of make-source-header-comment, make-source-file-header,
    33 make-shebang-comment, and make-shebang-file-header."
    34   (is (eq (type-of (make-shebang-file-header 
    35 		    (make-shebang-comment "/dev/null")))
    36 	  'file-header))
    37   (is (eq (type-of (make-source-file-header 
    38 		    (make-source-header-comment 
    39 		     "foo-test"
    40 		     :timestamp t
    41 		     :description "nothing to see here"
    42 		     :opts '("Definitely-Not_Emacs: T;"))))
    43 	  'file-header)))
    44 
    45 (deftest skelfile ()
    46   "Ensure skelfiles are created and loaded correctly and that they signal
    47 the appropriate restarts."
    48   (do-tmp-path (tmp-path "sk")
    49     ;; (is (sk-write-file (make-instance 'sk-project :name "nada" :path "test") :path %tmp :if-exists :supersede))
    50     (ignore-errors (delete-file %tmp))
    51     (setf %tmp (tmp-path "sk"))
    52     (is (init-skelfile %tmp))
    53     (is (load-skelfile %tmp))
    54     (is (build-ast (sk-read-file (make-instance 'sk-project) %tmp)))))
    55 
    56 (deftest skelrc ()
    57   "Ensure skelrc files are created and loaded correctly."
    58   (do-tmp-path (tmp-path "skrc")))
    59 
    60 (deftest makefile ()
    61   "Make sure makefiles are making out ok."
    62     (do-tmp-path (tmp-path "mk")
    63       (flet ((mk (&optional path) (make-instance 'makefile :name (gensym)
    64 							   :path (or path %tmp) :description "barfood"))
    65 	     (src (path) (make-instance 'sk-source :path path))
    66 	     (cmd (body) (make-instance 'sk-command :body body))
    67 	     (rule (tr sr) (make-sk-rule tr sr nil)))
    68 	(is (null (sk-write-file (mk) :if-exists :supersede :path (tmp-path "mk"))))
    69 	(let* ((tr1 (tmp-path "t1"))
    70 	       (tr2 (tmp-path "t2"))
    71 	       (sr (src (tmp-path "s1")))
    72 	       (r1 (rule tr1 sr))
    73 	       (r2 (rule sr tr2))
    74 	       (mk1 (mk "test.mk")))
    75 	  (is (push-mk-rule r1 mk1))
    76 	  (is (push-mk-rule r2 mk1))
    77 	  ;; NOTE: not really useful yet
    78 	  ;; (is (push-rule r2 mk1 t))
    79 	  ;; (is (push-rule r1 mk1 t))
    80 	  (is (push-mk-directive 
    81 	       (cmd "ifeq ($(DEBUG),1) echo foo 
    82 endif")
    83 	       mk1))
    84 	  ;; (is (push-directive (cmd "") mk1))
    85 	  (is (push-mk-var '(a b) mk1))
    86 	  (is (push-mk-var '(b c) mk1))
    87 	  ;; FIXME
    88 	  ;; (is (null (sk-write-file mk1 :if-exists :supersede :path (tmp-path "mk"))))
    89 	  ))))
    90 
    91 (deftest vm ()
    92   "EXPERIMENTAL"
    93   (is (let ((vm (make-sk-vm 201)))
    94 	(dotimes (i 200)
    95 	  (sks-pop vm))
    96 	t))
    97   (let ((vm (make-sk-vm 1)))
    98     (is (sks-pop vm))
    99     (signals simple-error (sks-pop vm))))