test-suite/tests/elisp-compiler.test

   1 ;;;; elisp-compiler.test --- Test the compiler for Elisp.
   2 ;;;;
   3 ;;;; Copyright (C) 2009 Free Software Foundation, Inc.
   4 ;;;; Daniel Kraft
   5 ;;;;
   6 ;;;; This library is free software; you can redistribute it and/or
   7 ;;;; modify it under the terms of the GNU Lesser General Public
   8 ;;;; License as published by the Free Software Foundation; either
   9 ;;;; version 3 of the License, or (at your option) any later version.
  10 ;;;;
  11 ;;;; This library is distributed in the hope that it will be useful,
  12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 ;;;; Lesser General Public License for more details.
  15 ;;;;
  16 ;;;; You should have received a copy of the GNU Lesser General Public
  17 ;;;; License along with this library; if not, write to the Free Software
  18 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  19
  20 (define-module (test-elisp-compiler)
  21   :use-module (test-suite lib)
  22   :use-module (system base compile)
  23   :use-module (language elisp runtime))
  24
  25
  26 ; Macros to handle the compilation conveniently.
  27
  28 (define-syntax compile-test
  29   (syntax-rules (pass-if pass-if-exception)
  30     ((_ (pass-if test-name exp))
  31      (pass-if test-name (compile 'exp #:from 'elisp #:to 'value)))
  32     ((_ (pass-if-equal test-name result exp))
  33      (pass-if test-name (equal? result
  34                                 (compile 'exp #:from 'elisp #:to 'value))))
  35     ((_ (pass-if-exception test-name exc exp))
  36      (pass-if-exception test-name exc
  37                         (compile 'exp #:from 'elisp #:to 'value)))))
  38
  39 (define-syntax with-test-prefix/compile
  40   (syntax-rules ()
  41     ((_ section-name exp ...)
  42      (with-test-prefix section-name (compile-test exp) ...))))
  43
  44
  45 ; Test control structures.
  46 ; ========================
  47
  48 (with-test-prefix/compile "Sequencing"
  49
  50   (pass-if-equal "progn" 1
  51     (progn (setq a 0)
  52            (setq a (1+ a))
  53            a)))
  54
  55 (with-test-prefix/compile "Conditionals"
  56
  57   (pass-if-equal "succeeding if" 1
  58     (if t 1 2))
  59   (pass-if-equal "failing if" 3
  60     (if nil
  61       1
  62       (setq a 2)
  63       (setq a (1+ a))
  64       a))
  65
  66   (pass-if-equal "empty cond" nil-value
  67     (cond))
  68   (pass-if-equal "all failing cond" nil-value
  69     (cond (nil) (nil)))
  70   (pass-if-equal "only condition" 5
  71     (cond (nil) (5)))
  72   (pass-if-equal "succeeding cond value" 42
  73     (cond (nil) (t 42) (t 0)))
  74   (pass-if-equal "succeeding cond side-effect" 42
  75     (progn (setq a 0)
  76            (cond (nil) (t (setq a 42) 1) (t (setq a 0)))
  77            a)))
  78
  79 (with-test-prefix/compile "Combining Conditions"
  80
  81   (pass-if-equal "empty and" t-value (and))
  82   (pass-if-equal "failing and" nil-value (and 1 2 nil 3))
  83   (pass-if-equal "succeeding and" 3 (and 1 2 3))
  84
  85   (pass-if-equal "empty or" nil-value (or))
  86   (pass-if-equal "failing or" nil-value (or nil nil nil))
  87   (pass-if-equal "succeeding or" 1 (or nil 1 nil 2 nil 3)))
  88
  89 (with-test-prefix/compile "Iteration"
  90
  91   (pass-if-equal "failing while" 0
  92     (progn (setq a 0)
  93            (while nil (setq a 1))
  94            a))
  95   (pass-if-equal "running while" 120
  96     (progn (setq prod 1
  97                  i 1)
  98            (while (<= i 5)
  99              (setq prod (* i prod))
 100              (setq i (1+ i)))
 101            prod)))
 102
 103
 104 ; Test handling of variables.
 105 ; ===========================
 106
 107 (with-test-prefix/compile "Variable Setting/Referencing"
 108
 109   ; TODO: Check for variable-void error
 110
 111   (pass-if-equal "setq and reference" 6
 112     (progn (setq a 1
 113                  b 2
 114                  c 3)
 115            (+ a b c))))
 116
 117 (with-test-prefix/compile "Let and Let*"
 118
 119   (pass-if-equal "let without value" nil-value
 120     (let (a (b 5)) a))
 121   (pass-if-equal "basic let" 0
 122     (progn (setq a 0)
 123            (let ((a 1)
 124                  (b a))
 125              b)))
 126   (pass-if-equal "let*" 1
 127     (progn (setq a 0)
 128            (let* ((a 1)
 129                   (b a))
 130              b)))
 131
 132   (pass-if "local scope"
 133     (progn (setq a 0)
 134            (setq b (let (a)
 135                      (setq a 1)
 136                      a))
 137            (and (= a 0)
 138                 (= b 1)))))
 139
 140 (with-test-prefix/compile "defconst and defvar"
 141
 142   (pass-if-equal "defconst without docstring" 3.141
 143     (progn (setq pi 3)
 144            (defconst pi 3.141)
 145            pi))
 146   (pass-if-equal "defconst value" 'pi
 147     (defconst pi 3.141 "Pi"))
 148
 149   (pass-if-equal "defvar without value" 42
 150     (progn (setq a 42)
 151            (defvar a)
 152            a))
 153   (pass-if-equal "defvar on already defined variable" 42
 154     (progn (setq a 42)
 155            (defvar a 1 "Some docstring is also ok")
 156            a))
 157   ; FIXME: makunbound a!
 158   (pass-if-equal "defvar on undefined variable" 1
 159     (progn (defvar a 1)
 160            a))
 161   (pass-if-equal "defvar value" 'a
 162     (defvar a)))
 163
 164
 165 ; Functions and lambda expressions.
 166 ; =================================
 167
 168 (with-test-prefix/compile "Lambda Expressions"
 169
 170   (pass-if-equal "required arguments" 3
 171     ((lambda (a b c) c) 1 2 3))
 172
 173   (pass-if-equal "optional argument" 3
 174     ((function (lambda (a &optional b c) c)) 1 2 3))
 175   (pass-if-equal "optional missing" nil-value
 176     ((lambda (&optional a) a)))
 177
 178   (pass-if-equal "rest argument" '(3 4 5)
 179     ((lambda (a b &rest c) c) 1 2 3 4 5))
 180   (pass-if-equal "rest missing" nil-value
 181     ((lambda (a b &rest c) c) 1 2)))
 182
 183 (with-test-prefix/compile "Function Definitions"
 184
 185   (pass-if-equal "defun" 3
 186     (progn (defun test (a b) (+ a b))
 187            (test 1 2)))
 188   (pass-if-equal "defun value" 'test
 189     (defun test (a b) (+ a b))))
 190
 191 (with-test-prefix/compile "Calling Functions"
 192
 193   (pass-if-equal "recursion" 120
 194     (progn (defun factorial (n prod)
 195              (if (zerop n)
 196                prod
 197                (factorial (1- n) (* prod n))))
 198            (factorial 5 1)))
 199
 200   (pass-if "dynamic scoping"
 201     (progn (setq a 0)
 202            (defun foo ()
 203              (setq a (1+ a))
 204              a)
 205            (defun bar (a)
 206              (foo))
 207            (and (= 43 (bar 42))
 208                 (zerop a)))))