Skip to content

Commit

Permalink
Use OClosures for enclosed expressions on Emacs ≥ 29
Browse files Browse the repository at this point in the history
OClosures solves the problem in a much better way.

Authored-by: Stefan Monnier
  • Loading branch information
snogge committed Feb 22, 2024
1 parent 6cb9d1b commit 457d6a3
Showing 1 changed file with 22 additions and 8 deletions.
30 changes: 22 additions & 8 deletions buttercup.el
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
;;; buttercup.el --- Behavior-Driven Emacs Lisp Testing -*-lexical-binding:t-*-

;; Copyright (C) 2015-2017 Jorgen Schaefer <[email protected]>
;; Copyright (C) 2018-2023 Ola Nilsson <[email protected]>
;; Copyright (C) 2018-2024 Ola Nilsson <[email protected]>

;; Version: 1.33
;; Author: Jorgen Schaefer <[email protected]>
Expand Down Expand Up @@ -64,9 +64,16 @@
"Bad test expression"
'buttercup-internals-error)

(eval-and-compile
(when (fboundp 'oclosure-define) ;Emacs≥29
(oclosure-define (buttercup--thunk (:predicate buttercup--thunk-p))
"An elisp expression as a function and original code."
expr)))

(defun buttercup--enclosed-expr (fun)
"Given a zero-arg function FUN, return its unevaluated expression.
"Given a FUN `buttercup-thunk', return its unevaluated expression.
For Emacs < 29:
The function MUST be byte-compiled or have one of the following
forms:
Expand All @@ -77,6 +84,9 @@ and the return value will be EXPR, unevaluated. The quoted EXPR
is useful if EXPR is a macro call, in which case the `quote'
ensures access to the un-expanded form."
(cl-assert (functionp fun) t "Expected FUN to be a function")
(if (and (fboundp 'buttercup--thunk-p) ;Emacs≥29
(buttercup--thunk-p fun))
(buttercup--thunk--expr fun)
(pcase fun
;; This should be the normal case, a closure with unknown enclosed
;; variables, empty arglist and a body containing
Expand All @@ -103,7 +113,7 @@ ensures access to the un-expanded form."
((and (pred byte-code-function-p) (guard (member (aref fun 0) '(nil 0))))
(aref fun 1))
;; Error
(_ (signal 'buttercup-enclosed-expression-error (format "Not a zero-arg one-expression closure: %S" fun)))))
(_ (signal 'buttercup-enclosed-expression-error (format "Not a zero-arg one-expression closure: %S" fun))))))

(defun buttercup--expr-and-value (fun)
"Given a function, return its quoted expression and value.
Expand Down Expand Up @@ -171,11 +181,15 @@ Does not have the IGNORE-MISSING and SPLIT parameters."
(define-error 'buttercup-pending "Buttercup test is pending" 'buttercup-error-base)

(defun buttercup--wrap-expr (expr)
"Wrap EXPR to be used by `buttercup-expect'."
`(lambda ()
(quote ,expr)
(buttercup--mark-stackframe)
,expr))
"Wrap EXPR in a `buttercup--thunk' to be used by `buttercup-expect'."
(if (fboundp 'oclosure-lambda) ;Emacs≥29
`(oclosure-lambda (buttercup--thunk (expr ',expr)) ()
(buttercup--mark-stackframe)
,expr)
`(lambda ()
(quote ,expr)
(buttercup--mark-stackframe)
,expr)))

(defmacro expect (arg &optional matcher &rest args)
"Expect a condition to be true.
Expand Down

0 comments on commit 457d6a3

Please sign in to comment.