assert macro v2.1.1: (tweak-contexts)

[hartrock]

Influenced by a C++ background I've tried to get some assert()-like functionality. Here are the v2.1 results:

Code Select Expand


(context 'assert)
;;
(define (assert-expr expr caller-sym no-in-func)
  (++ call_count)
  (if (not (eval expr))
      (throw-error
       (append
        "assert failed for expr: " (string expr)
        (if caller-sym ; implies no-in-func
            (let (caller-fun (eval caller-sym))
              (if (not (or (lambda? caller-fun) (macro? caller-fun)))
                  (append
                   " (caller " (string caller-sym) " is not a lambda/macro)")
                  (append
                   "n-> " (string no-in-func) ". assert called from "
                   (string caller-sym))))
            ""))))
  true)
;;
(define-macro (assert:assert expr caller-sym no-in-func)
  (assert-expr expr caller-sym no-in-func))
(set 'pre assert:assert)
;;
(set 'assert_ctx_sym (sym 'assert MAIN))
(define (assertSyms-cmp ignored e)
  (or
   (= e assert_ctx_sym) ; 'assert would lead to 'assert:assert
   (= e 'assert:assert)
   (= e 'assert:pre)))
;;
;; inplace mod of a ref-all'ed list referenced by rsym
(define (sym-mod-ref-all rsym func-sym-mod-ref exp-key func-compare)
  (assert (list? (eval rsym)))
  (local (modFlag)
    (dolist
     (r (if func-compare ;; nil arg is different from no arg here ..
            (ref-all exp-key (eval rsym) func-compare)
            (ref-all exp-key (eval rsym)))) ; .. no nil arg!
     (if (func-sym-mod-ref rsym r exp-key)
         (setq modFlag true)))
    modFlag))
;;
(define (assertCall-sym-mod-ref caller-sym assert-ref exp-key-ignored)
  (local (modFlag)
    (if (= (last assert-ref) 0) ; func call pos?
        (letn ((aref (0 -1 assert-ref)) ; one level up of assert sym
               (alist (nth aref (eval caller-sym)))) ; nth avoids func call
          (if (<= (length alist) 2) ; (assert) or (assert expr)
              (begin
                (if (= (length alist) 1)          ; check for naked assert
                    (push nil alist -1))          ; -> add missing nil expr.
                (push caller-sym alist -1)        ; add more ..
                (push (++ no-in-func) alist -1)   ; .. info.
                (setq modFlag true)
                ;; replace (args) calls in assert by local-args ..
                (let (argsRefs (ref-all 'args alist) argsFlag nil)
                  (if (not (null? argsRefs))
                      (begin
                        (dolist
                         (e argsRefs)
                         (if (length (alist (-1 e)) 1) ; just (args)
                             (begin
                               (setq argsFlag true)
                               (setq (alist (0 -1 e)) 'assert:local-args))))
                        ;; .. inited before calling assert.
                        (if argsFlag
                            (setq alist
                                  (list 'begin
                                        '(setq assert:local-args (args))
                                        alist))))))
                (setq (nth aref (eval caller-sym)) alist)))))
    modFlag))
;;
;; add missing args of assert calls
(define (tweak-arguments rsym)
  (if (or (lambda? (eval rsym)) (macro? (eval rsym)))
      (local (no-in-func)
        (if (sym-mod-ref-all rsym assertCall-sym-mod-ref nil assertSyms-cmp)
            (println (string no-in-func) " (assert) call"
                     (if (> no-in-func 1) "s" "") " modified in: " rsym)))))
;;
;; asserts in contexts
;;
(define (tweak-context ctx)
  (dolist (s (symbols ctx))
          (tweak-arguments s)))
(define (tweak-contexts contexts)
  (dolist (ctx contexts)
          (tweak-context ctx)))

(context MAIN)


Why this is so long is best explained by - a simplified - use-case:

Code Select Expand


;;; [insert assert code from above]
;;
;; { copy'n'paste
;;
;; simplified use-case for assert demo purposes
;;
(context 'db_proto)
;;
(define (init dataCtx metaCtx transCtx)
  (setq data dataCtx)
  (setq meta metaCtx)
  (setq trans transCtx)
  (context))
;;
(define (get-data-1 id) ; assert list arg
  (assert:pre (and
               (string? id)
               (not (nil? (data id)))))
  (data id))
;;
(define (get-data-2 id) ; assert non-list arg, assert call enumeration
  (assert:pre (string? id))
  (assert (not (nil? (data id))))
  (data id))
;;
(context MAIN)
;;
(context 'db)
;;
(define (create)
  (let (tmp (args))
    (assert (null? tmp)))
  (++ dbCount)
  (context MAIN)
  (let ((db_sym (sym (append "DB_" (string dbCount))))
        (data_sym (sym (append "Data_" (string dbCount)))))
    (let (db_ctx (new db_proto db_sym)) ; transfer syms from db_proto: to DB_*
      (db_ctx:init ; call :init
       (new Tree data_sym)))))
(define (create_alt)
  (assert (null? (args)))
  (++ dbCount)
  (context MAIN)
  (let ((db_sym (sym (append "DB_" (string dbCount))))
        (data_sym (sym (append "Data_" (string dbCount)))))
    (let (db_ctx (new db_proto db_sym)) ; transfer syms from db_proto: to DB_*
      (db_ctx:init ; call :init
       (new Tree data_sym)))))
;;
(context MAIN)
;;
;; } copy'n'paste

;; { copy'n'paste
;;
;; 1. test without assert call modifications
;; init
(set 'dbc (db:create))
(dbc:data "foo" "bar") ; put something into data
;;
;; } copy'n'paste
;;

;; try manually from here
;; a.
(db:create "forbidden arg")
;; -> this gives db:create info *without* tweaking asserts
(db:create_alt "forbidden arg")
;; -> this does not work without tweaking (should throw)
;; b.
(dbc:get-data-1) ; missing id
(dbc:get-data-2) ; missing id
;; c.
(dbc:get-data-1 "wrong id")
(dbc:get-data-2 "wrong id")
;; d.
(dbc:get-data-1 "foo") ; correct id
(dbc:get-data-2 "foo") ; correct id
;;

;; { copy'n'paste
;;
;; 2. test with assert call modifications
;; modify assert calls
(assert:tweak-contexts '(db db_proto))
;; short form for
;;   (assert:tweak-context db) (assert:tweak-context db_proto)
;;
;; (assert:tweak-context db_proto)
;;   short from for:
;;     (assert:tweak-arguments 'db_proto:get-data-1)
;;     (assert:tweak-arguments 'db_proto:get-data-2)
;;
;; just one func:
;;   (assert:tweak-arguments 'db:create)
;;
;;
;; init of new db (old one contains unmodified calls)
(set 'dbc (db:create))
(dbc:data "foo" "bar") ; put something into data
;;
;; } copy'n'paste
;;
;; try manually from here
;; a.
(db:create "forbidden arg")
;; -> db:create info redundant after modifying asserts
(db:create_alt "forbidden arg")
;; -> this does work now after tweaking (throws)
;; b.
(dbc:get-data-1) ; missing id
(dbc:get-data-2) ; missing id
;; c.
(dbc:get-data-1 "wrong id")
(dbc:get-data-2 "wrong id")
;; d.
(dbc:get-data-1 "foo") ; correct id
(dbc:get-data-2 "foo") ; correct id
;;


Case a. (db:create "forbidden arg") is 'interesting', which creates redundant caller info after tweaking asserts by (assert:tweak-contexts '(db db_proto)).

In the other cases added caller info would be missing without tweaking asserts: it won't be shown as part of output of throw callstacks (this has been a reason to start with these tweaks).



To avoid calling (args) in a wrong function context, a temp var will be inserted in this case; see (db:create) after tweaking its assert.



Any suggestions for improvements are welcome (I like to learn).



Possible extensions are tweaks for:

[*] switching assert checks on/off (selectively: assert:pre macros could be on, others off)

[*] code coverage statistics

[/list]

Versions:

 

[*]v2.1.1: [fix] use-case code
 

[*]v2.1: [enh] context-wide tweak of asserts

 

[*]v2:
 

   

[*][fix] simplified interface: (and)'ed expressions easily replace - unneeded - quoted list args (without lack of functionality)

   

[*][enh] (args) call in assert expr gives caller args now (by introducing var for storing its local value)

  [/list]
 

[*]v1: first shot

[/list]