[Emacs-diffs] trunk r113691: * lisp/subr.el (macrop): New function.

[Stefan Monnier]

------------------------------------------------------------
revno: 113691
revision-id: address@hidden
parent: address@hidden
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Sun 2013-08-04 16:18:11 -0400
message:
  * lisp/subr.el (macrop): New function.
  (text-clone--maintaining): New var.
  (text-clone--maintain): Rename from text-clone-maintain.  Use it
  instead of inhibit-modification-hooks.
  
  * lisp/emacs-lisp/nadvice.el (advice--normalize): For aliases to macros, use
  a proxy, so as handle autoloads and redefinitions of the target.
  (advice--defalias-fset, advice-remove): Use advice--symbol-function.
  
  * lisp/emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates):
  Remove bogus (arrayp . stringp) pair.  Add entries for `vectorp'.
  (pcase--mutually-exclusive-p): New function.
  (pcase--split-consp): Use it.
  (pcase--split-pred): Use it.  Optimize the case where `pat' is a qpat
  mutually exclusive with the current predicate.
  
  * test/automated/advice-tests.el (advice-tests-nadvice): Test removal
  before definition.
  (advice-tests-macroaliases): New test.
  
  * lisp/emacs-lisp/edebug.el (edebug-lookup-function): Remove function.
  (edebug-macrop): Remove.  Use `macrop' instead.
  * lisp/emacs-lisp/advice.el (ad-subr-p): Remove.  Use `subrp' instead.
  (ad-macro-p):
  * lisp/eshell/esh-cmd.el (eshell-macrop):
  * lisp/apropos.el (apropos-macrop): Remove.  Use `macrop' instead.
modified:
  etc/NEWS                       news-20100311060928-aoit31wvzf25yr1z-1
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/apropos.el                apropos.el-20091113204419-o5vbwnq5f7feedwu-273
  lisp/emacs-lisp/advice.el      advice.el-20091113204419-o5vbwnq5f7feedwu-605
  lisp/emacs-lisp/edebug.el      edebug.el-20091113204419-o5vbwnq5f7feedwu-483
  lisp/emacs-lisp/nadvice.el     nadvice.el-20121015213644-851fdxs2vximj8nr-1
  lisp/emacs-lisp/pcase.el       pcase.el-20100810123717-8zwve3391p2ywm1h-1
  lisp/eshell/esh-cmd.el         eshcmd.el-20091113204419-o5vbwnq5f7feedwu-1850
  lisp/subr.el                   subr.el-20091113204419-o5vbwnq5f7feedwu-151
  test/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-8588
  test/automated/advice-tests.el advice.el-20121111003311-i96f8i1au0zeaju7-1

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2013-08-04 01:43:26 +0000
+++ b/etc/NEWS  2013-08-04 20:18:11 +0000
@@ -691,7 +691,7 @@
 with the same interpretation as the returned value of `visited-file-modtime'.
 
 ** time-to-seconds is not obsolete any more.
-** New function special-form-p.
+** New functions special-form-p and macrop.
 ** Docstrings can be made dynamic by adding a `dynamic-docstring-function'
 text-property on the first char.
 

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-08-04 06:48:00 +0000
+++ b/lisp/ChangeLog    2013-08-04 20:18:11 +0000
@@ -1,5 +1,30 @@
 2013-08-04  Stefan Monnier  <address@hidden>
 
+       * subr.el (macrop): New function.
+       (text-clone--maintaining): New var.
+       (text-clone--maintain): Rename from text-clone-maintain.  Use it
+       instead of inhibit-modification-hooks.
+
+       * emacs-lisp/nadvice.el (advice--normalize): For aliases to macros, use
+       a proxy, so as handle autoloads and redefinitions of the target.
+       (advice--defalias-fset, advice-remove): Use advice--symbol-function.
+
+       * emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates):
+       Remove bogus (arrayp . stringp) pair.  Add entries for `vectorp'.
+       (pcase--mutually-exclusive-p): New function.
+       (pcase--split-consp): Use it.
+       (pcase--split-pred): Use it.  Optimize the case where `pat' is a qpat
+       mutually exclusive with the current predicate.
+
+       * emacs-lisp/edebug.el (edebug-lookup-function): Remove function.
+       (edebug-macrop): Remove.  Use `macrop' instead.
+       * emacs-lisp/advice.el (ad-subr-p): Remove.  Use `subrp' instead.
+       (ad-macro-p):
+       * eshell/esh-cmd.el (eshell-macrop):
+       * apropos.el (apropos-macrop): Remove.  Use `macrop' instead.
+
+2013-08-04  Stefan Monnier  <address@hidden>
+
        * emacs-lisp/nadvice.el (advice-function-mapc): Rename from advice-mapc.
        (advice-mapc): New function, using it.
        (advice-function-member-p): New function.

=== modified file 'lisp/apropos.el'
--- a/lisp/apropos.el   2013-01-07 22:00:55 +0000
+++ b/lisp/apropos.el   2013-08-04 20:18:11 +0000
@@ -1121,7 +1121,7 @@
          (apropos-print-doc 2
                             (if (commandp symbol)
                                 'apropos-command
-                              (if (apropos-macrop symbol)
+                              (if (macrop symbol)
                                   'apropos-macro
                                 'apropos-function))
                             (not nosubst))
@@ -1139,17 +1139,6 @@
   (prog1 apropos-accumulator
     (setq apropos-accumulator ())))    ; permit gc
 
-(defun apropos-macrop (symbol)
-  "Return t if SYMBOL is a Lisp macro."
-  (and (fboundp symbol)
-       (consp (setq symbol
-                   (symbol-function symbol)))
-       (or (eq (car symbol) 'macro)
-          (if (autoloadp symbol)
-              (memq (nth 4 symbol)
-                    '(macro t))))))
-
-
 (defun apropos-print-doc (i type do-keys)
   (let ((doc (nth i apropos-item)))
     (when (stringp doc)

=== modified file 'lisp/emacs-lisp/advice.el'
--- a/lisp/emacs-lisp/advice.el 2013-08-02 21:16:33 +0000
+++ b/lisp/emacs-lisp/advice.el 2013-08-04 20:18:11 +0000
@@ -2140,14 +2140,6 @@
   "Take a macro function DEFINITION and make a lambda out of it."
   `(cdr ,definition))
 
-(defmacro ad-subr-p (definition)
-  ;;"non-nil if DEFINITION is a subr."
-  (list 'subrp definition))
-
-(defmacro ad-macro-p (definition)
-  ;;"non-nil if DEFINITION is a macro."
-  `(eq (car-safe ,definition) 'macro))
-
 (defmacro ad-lambda-p (definition)
   ;;"non-nil if DEFINITION is a lambda expression."
   `(eq (car-safe ,definition) 'lambda))
@@ -2160,12 +2152,12 @@
 (defmacro ad-compiled-p (definition)
   "Return non-nil if DEFINITION is a compiled byte-code object."
   `(or (byte-code-function-p ,definition)
-    (and (ad-macro-p ,definition)
-     (byte-code-function-p (ad-lambdafy ,definition)))))
+       (and (macrop ,definition)
+            (byte-code-function-p (ad-lambdafy ,definition)))))
 
 (defmacro ad-compiled-code (compiled-definition)
   "Return the byte-code object of a COMPILED-DEFINITION."
-  `(if (ad-macro-p ,compiled-definition)
+  `(if (macrop ,compiled-definition)
     (ad-lambdafy ,compiled-definition)
     ,compiled-definition))
 
@@ -2173,7 +2165,7 @@
   "Return the lambda expression of a function/macro/advice DEFINITION."
   (cond ((ad-lambda-p definition)
         definition)
-       ((ad-macro-p definition)
+       ((macrop definition)
         (ad-lambdafy definition))
        ((ad-advice-p definition)
         (cdr definition))
@@ -2183,7 +2175,7 @@
   "Return the argument list of DEFINITION."
   (require 'help-fns)
   (help-function-arglist
-   (if (or (ad-macro-p definition) (ad-advice-p definition))
+   (if (or (macrop definition) (ad-advice-p definition))
        (cdr definition)
      definition)
    'preserve-names))
@@ -2229,7 +2221,7 @@
 (defun ad-advised-definition-p (definition)
   "Return non-nil if DEFINITION was generated from advice information."
   (if (or (ad-lambda-p definition)
-         (ad-macro-p definition)
+         (macrop definition)
          (ad-compiled-p definition))
       (let ((docstring (ad-docstring definition)))
        (and (stringp docstring)
@@ -2242,8 +2234,8 @@
   ;; representations, so cache entries preactivated with version
   ;; 1 can't be used.
   (cond
-   ((ad-macro-p definition) 'macro2)
-   ((ad-subr-p definition) 'subr2)
+   ((macrop definition) 'macro2)
+   ((subrp definition) 'subr2)
    ((or (ad-lambda-p definition) (ad-compiled-p definition)) 'fun2)
    ((ad-advice-p definition) 'advice2))) ;; FIXME: Can this ever happen?
 
@@ -2273,7 +2265,7 @@
   "True if FUNCTION has an interpreted definition that can be compiled."
   (and (ad-has-proper-definition function)
        (or (ad-lambda-p (symbol-function function))
-          (ad-macro-p (symbol-function function)))
+          (macrop (symbol-function function)))
        (not (ad-compiled-p (symbol-function function)))))
 
 (defvar warning-suppress-types)         ;From warnings.el.
@@ -2902,7 +2894,7 @@
    ((eq ad-default-compilation-action 'never) nil)
    ((eq ad-default-compilation-action 'always) t)
    ((eq ad-default-compilation-action 'like-original)
-    (or (ad-subr-p (ad-get-orig-definition function))
+    (or (subrp (ad-get-orig-definition function))
         (ad-compiled-p (ad-get-orig-definition function))))
    ;; everything else means `maybe':
    (t (featurep 'byte-compile))))
@@ -3249,7 +3241,7 @@
              `((ad-set-cache
                 ',function
                 ;; the function will get compiled:
-                ,(cond ((ad-macro-p (car preactivation))
+                ,(cond ((macrop (car preactivation))
                         `(ad-macrofy
                           (function
                            ,(ad-lambdafy

=== modified file 'lisp/emacs-lisp/edebug.el'
--- a/lisp/emacs-lisp/edebug.el 2013-07-26 15:09:04 +0000
+++ b/lisp/emacs-lisp/edebug.el 2013-08-04 20:18:11 +0000
@@ -295,19 +295,6 @@
        (eq (selected-window)
           (next-window (next-window (selected-window))))))
 
-(defsubst edebug-lookup-function (object)
-  (while (and (symbolp object) (fboundp object))
-    (setq object (symbol-function object)))
-  object)
-
-(defun edebug-macrop (object)
-  "Return the macro named by OBJECT, or nil if it is not a macro."
-  (setq object (edebug-lookup-function object))
-  (if (and (listp object)
-          (eq 'macro (car object))
-          (functionp (cdr object)))
-      object))
-
 (defun edebug-sort-alist (alist function)
   ;; Return the ALIST sorted with comparison function FUNCTION.
   ;; This uses 'sort so the sorting is destructive.
@@ -1416,7 +1403,7 @@
                                        ; but leave it in for compatibility.
        ))
      ;; No edebug-form-spec provided.
-     ((edebug-macrop head)
+     ((macrop head)
       (if edebug-eval-macro-args
          (edebug-forms cursor)
        (edebug-sexps cursor)))

=== modified file 'lisp/emacs-lisp/nadvice.el'
--- a/lisp/emacs-lisp/nadvice.el        2013-08-04 06:48:00 +0000
+++ b/lisp/emacs-lisp/nadvice.el        2013-08-04 20:18:11 +0000
@@ -314,9 +314,8 @@
    ((special-form-p def)
     ;; Not worth the trouble trying to handle this, I think.
     (error "Advice impossible: %S is a special form" symbol))
-   ((and (symbolp def)
-        (eq 'macro (car-safe (ignore-errors (indirect-function def)))))
-    (let ((newval (cons 'macro (cdr (indirect-function def)))))
+   ((and (symbolp def) (macrop def))
+    (let ((newval `(macro . ,(lambda (&rest r) (macroexpand `(,def . ,r))))))
       (put symbol 'advice--saved-rewrite (cons def (cdr newval)))
       newval))
    ;; `f' might be a pure (hence read-only) cons!
@@ -351,19 +350,7 @@
   (when (get symbol 'advice--saved-rewrite)
     (put symbol 'advice--saved-rewrite nil))
   (setq newdef (advice--normalize symbol newdef))
-  (let* ((olddef (advice--strip-macro (symbol-function symbol)))
-         (oldadv
-          (cond
-          ((null (get symbol 'advice--pending))
-           (or olddef
-               (progn
-                 (message "Delayed advice activation failed for %s: no data"
-                          symbol)
-                 nil)))
-          ((or (not olddef) (autoloadp olddef))
-            (get symbol 'advice--pending))
-           (t (message "Dropping left-over advice--pending for %s" symbol)
-              olddef))))
+  (let ((oldadv (advice--symbol-function symbol)))
     (if (and newdef (not (autoloadp newdef)))
         (let* ((snewdef (advice--strip-macro newdef))
                (snewadv (advice--subst-main oldadv snewdef)))
@@ -383,7 +370,6 @@
   ;; TODO:
   ;; - record the advice location, to display in describe-function.
   ;; - change all defadvice in lisp/**/*.el.
-  ;; - rewrite advice.el on top of this.
   ;; - obsolete advice.el.
   (let* ((f (symbol-function symbol))
         (nf (advice--normalize symbol f)))
@@ -420,8 +406,7 @@
                       ((eq (car-safe f) 'macro) (cdr f))
                       (t (symbol-function symbol)))
                      function)
-    (unless (advice--p
-             (if (eq (car-safe f) 'macro) (cdr f) (symbol-function symbol)))
+    (unless (advice--p (advice--symbol-function symbol))
       ;; Not advised any more.
       (remove-function (get symbol 'defalias-fset-function)
                        #'advice--defalias-fset)

=== modified file 'lisp/emacs-lisp/pcase.el'
--- a/lisp/emacs-lisp/pcase.el  2013-07-24 05:13:24 +0000
+++ b/lisp/emacs-lisp/pcase.el  2013-08-04 20:18:11 +0000
@@ -353,23 +353,34 @@
     (symbolp . numberp)
     (symbolp . consp)
     (symbolp . arrayp)
+    (symbolp . vectorp)
     (symbolp . stringp)
     (symbolp . byte-code-function-p)
     (integerp . consp)
     (integerp . arrayp)
+    (integerp . vectorp)
     (integerp . stringp)
     (integerp . byte-code-function-p)
     (numberp . consp)
     (numberp . arrayp)
+    (numberp . vectorp)
     (numberp . stringp)
     (numberp . byte-code-function-p)
     (consp . arrayp)
+    (consp . vectorp)
     (consp . stringp)
     (consp . byte-code-function-p)
-    (arrayp . stringp)
     (arrayp . byte-code-function-p)
+    (vectorp . byte-code-function-p)
+    (stringp . vectorp)
     (stringp . byte-code-function-p)))
 
+(defun pcase--mutually-exclusive-p (pred1 pred2)
+  (or (member (cons pred1 pred2)
+              pcase-mutually-exclusive-predicates)
+      (member (cons pred2 pred1)
+              pcase-mutually-exclusive-predicates)))
+
 (defun pcase--split-match (sym splitter match)
   (cond
     ((eq (car match) 'match)
@@ -433,10 +444,7 @@
    ;; A QPattern but not for a cons, can only go to the `else' side.
    ((eq (car-safe pat) '\`) '(:pcase--fail . nil))
    ((and (eq (car-safe pat) 'pred)
-         (or (member (cons 'consp (cadr pat))
-                     pcase-mutually-exclusive-predicates)
-             (member (cons (cadr pat) 'consp)
-                     pcase-mutually-exclusive-predicates)))
+         (pcase--mutually-exclusive-p #'consp (cadr pat)))
     '(:pcase--fail . nil))))
 
 (defun pcase--split-equal (elem pat)
@@ -496,11 +504,14 @@
                (not (pcase--fgrep (mapcar #'car vars) (cadr upat)))))
       '(:pcase--succeed . :pcase--fail))
      ((and (eq 'pred (car upat))
-           (eq 'pred (car-safe pat))
-           (or (member (cons (cadr upat) (cadr pat))
-                       pcase-mutually-exclusive-predicates)
-               (member (cons (cadr pat) (cadr upat))
-                       pcase-mutually-exclusive-predicates)))
+           (let ((otherpred
+                  (cond ((eq 'pred (car-safe pat)) (cadr pat))
+                        ((not (eq '\` (car-safe pat))) nil)
+                        ((consp (cadr pat)) #'consp)
+                        ((vectorp (cadr pat)) #'vectorp)
+                        ((byte-code-function-p (cadr pat))
+                         #'byte-code-function-p))))
+             (pcase--mutually-exclusive-p (cadr upat) otherpred)))
       '(:pcase--fail . nil))
      ((and (eq 'pred (car upat))
            (eq '\` (car-safe pat))

=== modified file 'lisp/eshell/esh-cmd.el'
--- a/lisp/eshell/esh-cmd.el    2013-01-01 09:11:05 +0000
+++ b/lisp/eshell/esh-cmd.el    2013-08-04 20:18:11 +0000
@@ -993,14 +993,6 @@
        ,@commands
        (eshell-debug-command ,(concat "done " (eval tag)) form))))
 
-(defsubst eshell-macrop (object)
-  "Return t if OBJECT is a macro or nil otherwise."
-  (and (symbolp object) (fboundp object)
-       (setq object (indirect-function object))
-       (listp object)
-       (eq 'macro (car object))
-       (functionp (cdr object))))
-
 (defun eshell-do-eval (form &optional synchronous-p)
   "Evaluate form, simplifying it as we go.
 Unless SYNCHRONOUS-P is non-nil, throws `eshell-defer' if it needs to
@@ -1016,7 +1008,7 @@
       (setq form (cadr (cadr form))))
     ;; expand any macros directly into the form.  This is done so that
     ;; we can modify any `let' forms to evaluate only once.
-    (if (eshell-macrop (car form))
+    (if (macrop (car form))
        (let ((exp (eshell-copy-tree (macroexpand form))))
          (eshell-manipulate (format "expanding macro `%s'"
                                     (symbol-name (car form)))

=== modified file 'lisp/subr.el'
--- a/lisp/subr.el      2013-07-26 07:38:18 +0000
+++ b/lisp/subr.el      2013-08-04 20:18:11 +0000
@@ -2750,6 +2750,13 @@
       (setq object (indirect-function object t)))
   (and (subrp object) (eq (cdr (subr-arity object)) 'unevalled)))
 
+(defun macrop (object)
+  "Non-nil if and only if OBJECT is a macro."
+  (let ((def (indirect-function object t)))
+    (when (consp def)
+      (or (eq 'macro (car def))
+          (and (eq 'autoload (car def)) (memq (nth 4 def) '(macro t)))))))
+
 (defun field-at-pos (pos)
   "Return the field at position POS, taking stickiness etc into account."
   (let ((raw-field (get-char-property (field-beginning pos) 'field)))
@@ -4050,10 +4057,14 @@
 
 ;;;; Text clones
 
-(defun text-clone-maintain (ol1 after beg end &optional _len)
+(defvar text-clone--maintaining nil)
+
+(defun text-clone--maintain (ol1 after beg end &optional _len)
   "Propagate the changes made under the overlay OL1 to the other clones.
 This is used on the `modification-hooks' property of text clones."
-  (when (and after (not undo-in-progress) (overlay-start ol1))
+  (when (and after (not undo-in-progress)
+             (not text-clone--maintaining)
+             (overlay-start ol1))
     (let ((margin (if (overlay-get ol1 'text-clone-spreadp) 1 0)))
       (setq beg (max beg (+ (overlay-start ol1) margin)))
       (setq end (min end (- (overlay-end ol1) margin)))
@@ -4084,7 +4095,7 @@
                (tail (- (overlay-end ol1) end))
                (str (buffer-substring beg end))
                (nothing-left t)
-               (inhibit-modification-hooks t))
+               (text-clone--maintaining t))
            (dolist (ol2 (overlay-get ol1 'text-clones))
              (let ((oe (overlay-end ol2)))
                (unless (or (eq ol1 ol2) (null oe))
@@ -4095,7 +4106,7 @@
                    (unless (> mod-beg (point))
                      (save-excursion (insert str))
                      (delete-region mod-beg (point)))
-                   ;;(overlay-put ol2 'modification-hooks 
'(text-clone-maintain))
+                   ;;(overlay-put ol2 'modification-hooks 
'(text-clone--maintain))
                    ))))
            (if nothing-left (delete-overlay ol1))))))))
 
@@ -4126,17 +4137,18 @@
                             (>= pt-end (point-max))
                             (>= start (point-max)))
                         0 1))
+         ;; FIXME: Reuse overlays at point to extend dups!
         (ol1 (make-overlay (- start start-margin) (+ end end-margin) nil t))
         (ol2 (make-overlay (- (point) start-margin) (+ pt-end end-margin) nil 
t))
         (dups (list ol1 ol2)))
-    (overlay-put ol1 'modification-hooks '(text-clone-maintain))
+    (overlay-put ol1 'modification-hooks '(text-clone--maintain))
     (when spreadp (overlay-put ol1 'text-clone-spreadp t))
     (when syntax (overlay-put ol1 'text-clone-syntax syntax))
     ;;(overlay-put ol1 'face 'underline)
     (overlay-put ol1 'evaporate t)
     (overlay-put ol1 'text-clones dups)
     ;;
-    (overlay-put ol2 'modification-hooks '(text-clone-maintain))
+    (overlay-put ol2 'modification-hooks '(text-clone--maintain))
     (when spreadp (overlay-put ol2 'text-clone-spreadp t))
     (when syntax (overlay-put ol2 'text-clone-syntax syntax))
     ;;(overlay-put ol2 'face 'underline)

=== modified file 'test/ChangeLog'
--- a/test/ChangeLog    2013-08-04 04:37:10 +0000
+++ b/test/ChangeLog    2013-08-04 20:18:11 +0000
@@ -1,3 +1,9 @@
+2013-08-04  Stefan Monnier  <address@hidden>
+
+       * automated/advice-tests.el (advice-tests-nadvice): Test removal
+       before definition.
+       (advice-tests-macroaliases): New test.
+
 2013-08-04  Glenn Morris  <address@hidden>
 
        * automated/ert-tests.el: Disable failing test that no-one seems

=== modified file 'test/automated/advice-tests.el'
--- a/test/automated/advice-tests.el    2013-07-09 07:11:50 +0000
+++ b/test/automated/advice-tests.el    2013-08-04 20:18:11 +0000
@@ -25,7 +25,12 @@
 
 (ert-deftest advice-tests-nadvice ()
   "Test nadvice code."
+  (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5)))
+  (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 2)))
+  (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5)))
   (defun sm-test1 (x) (+ x 4))
+  (should (equal (sm-test1 6) 20))
+  (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 2)))
   (should (equal (sm-test1 6) 10))
   (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5)))
   (should (equal (sm-test1 6) 50))
@@ -42,6 +47,18 @@
   (defmacro sm-test3 (x) `(call-test3 ,x))
   (should (equal (macroexpand '(sm-test3 56)) '(toto (call-test3 56)))))
 
+(ert-deftest advice-tests-macroaliases ()
+  "Test nadvice code on aliases to macros."
+  (defmacro sm-test1 (a) `(list ',a))
+  (defalias 'sm-test1-alias 'sm-test1)
+  (should (equal (macroexpand '(sm-test1-alias 5)) '(list '5)))
+  (advice-add 'sm-test1-alias :around
+              (lambda (f &rest args) `(cons 1 ,(apply f args))))
+  (should (equal (macroexpand '(sm-test1-alias 5)) '(cons 1 (list '5))))
+  (defmacro sm-test1 (a) `(list 0 ',a))
+  (should (equal (macroexpand '(sm-test1-alias 5)) '(cons 1 (list 0 '5)))))
+
+
 (ert-deftest advice-tests-advice ()
   "Test advice code."
   (defun sm-test2 (x) (+ x 4))