Permalink
Browse files

refactor for sandbox-defun

  • Loading branch information...
1 parent 57b07e8 commit 9a6af8e31e790052dbcebb88d18e59210dbab184 @dcluna committed Feb 11, 2013
Showing with 25 additions and 24 deletions.
  1. +9 −22 sandbox.el
  2. +16 −2 spec/sandbox-spec.el
View
@@ -165,30 +165,17 @@ redefunned, return true. "
(stringp (first body)))
(setq docp t))
(sandbox-readonly-check sandbox-fcn)
- (if docp
- (cons 'defun
- (cons sandbox-fcn
- (cons args
- (cons
- (first body)
- (cons
- `(sandbox--check-args ,@args)
- (cons
- '(sit-for 0)
- (cdr body)))))))
- (cons 'defun
- (cons sandbox-fcn
- (cons args
- (cons
- (first body)
- (cons
- `(sandbox--check-args ,@args)
- (cons
- '(sit-for 0)
- (cdr body))))))))))
+ (let ((is-interactive-form (equal '(interactive) (first body))))
+ (if docp
+ ;; puts the docstring in front
+ `(defun sandbox-fcn args ,(first body) (sandbox--check-args ,@args) (sit-for 0) ,(cdr body))
+ `(defun sandbox-fcn args (sandbox--check-args ,@args) (sit-for 0) body)))))
+
+(defun make-sandboxed-form)
(defun sandbox-eval (form)
- (flet (((intern (concat sandbox-prefix "while")) (cond &rest body) (sandbox-while cond body)))
+ (flet (((intern (concat sandbox-prefix "while")) (cond &rest body) (sandbox-while cond body))
+ ((intern (concat sandbox-prefix "defun")) (fcn args &rest body ) (sandbox-defun fcn args body)))
(eval (sandbox form))))
(defvar sandbox-max-list-length 100)
View
@@ -44,7 +44,15 @@
(should-not (sandbox--safe-length-args-p '((2 3) 2) 0 2))))
(describe "sandbox-defun"
- (it "makes "))
+ (it "makes functions in the sandboxed namespace"
+ (progn
+ (sandbox-defun testfn (one two) (+ one two))
+ (should (eq 3 (emacs-sandbox-testfn 1 2)))))
+ (it "handles functions with docstrings too"
+ (progn
+ (sandbox-defun testfn (one two) "test function" (+ one two))
+ (should (eq 3 (emacs-sandbox-testfn 1 2))))))
+
(describe "sandbox-while"
(it "wont allow infinite looping"
@@ -75,7 +83,13 @@
(should-error
(eval (sandbox '(while t
(throw 'omg-should-not-even-be-allowed-to-run!!!)))))
- :type 'void-function))
+ :type 'void-function)
+
+ (it "wont loop forever with sandbox-eval"
+ (should-error
+ (sandbox-eval (sandbox '(while t (setq what-doing "looping")))))))
+
+
(defun emacs-sandbox-message (val))

0 comments on commit 9a6af8e

Please sign in to comment.