newlisp/qa-specific-tests/qa-cellleak

48 lines
1.3 KiB
Plaintext

; check for cell leaks
; to discover the source of the cell leak
; limit the script changing the line:
; (if (and (primitive? (eval sm)) (< sm 'zzzz))
; in procedure (qa) defined around line 160
(write-line 2 "Testing for cell leaks, wait ...")
(println [text]
If this test reports cell leaks, but also shows errors during
the execution of the qa-dot script then run again. If qa-dot runs
fine on its own but shows error during repeated execution in this
script, it is because of syncronization errors when freeing
file resources. This seems to ccur only on Windows. In this case
try running again or test on a less busy, faster system.
[/text])
(set 'do-not-exit true) ; avoids exit
(set 'testing-cell-leaks true) ; avoids output to the console
(println "loading and running qa-dot 1")
(silent (load "qa-dot"))
(set 'before (sys-info 0)) ; do not delete
(set 'after (sys-info 0)) ; adjusting cellcount
(println "loading and running qa-dot 2")
(silent (load "qa-dot"))
(println (sys-info))
(set 'before (sys-info 0))
(println "loading and running qa-dot 3")
(silent (load "qa-dot"))
(println (sys-info))
(set 'after (sys-info 0))
(if (= (abs (- before after)) 0)
(write-line 2 ">>>>> cell leaks test passed SUCCESSFUL")
(write-line 2 ">>>>> ERROR: cell leak discovered"))
(exit)