From: <cli...@li...> - 2009-02-20 12:08:24
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/tests ChangeLog,1.616,1.617 mt.tst,1.3,1.4 (Vladimir Tzankov) ---------------------------------------------------------------------- Message: 1 Date: Thu, 19 Feb 2009 22:21:02 +0000 From: Vladimir Tzankov <vt...@us...> Subject: clisp/tests ChangeLog,1.616,1.617 mt.tst,1.3,1.4 To: cli...@li... Message-ID: <E1L...@dd...> Update of /cvsroot/clisp/clisp/tests In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv27842/tests Modified Files: ChangeLog mt.tst Log Message: add tests for mutexes, per thread bindings of special variables, thread interruption Index: mt.tst =================================================================== RCS file: /cvsroot/clisp/clisp/tests/mt.tst,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- mt.tst 25 Nov 2008 19:46:01 -0000 1.3 +++ mt.tst 19 Feb 2009 22:21:00 -0000 1.4 @@ -9,3 +9,72 @@ (describe (make-mutex :name "my lock")) (describe (make-exemption :name "my exemption")))) (NIL NIL NIL) + +;; non-recursive mutex +(mutex-owner (setf m1 (make-mutex :name "m1"))) NIL +(eq (mutex-lock m1) m1) T +(mutex-lock m1) ERROR +(eq (mutex-owner m1) (current-thread)) T +(eq (mutex-unlock m1) m1) T +(mutex-unlock m1) ERROR +(mutex-owner m1) NIL +;; recursive mutex +(mutex-owner (setf m2 (make-mutex :name "m2" :recursive-p t))) NIL +(eq (mutex-lock m2) m2) T +(eq (mutex-lock m2) m2) T +(eq (mutex-owner m2) (current-thread)) T +(eq (mutex-unlock (mutex-unlock m2)) m2) T +(mutex-unlock m2) ERROR +(mutex-owner m2) NIL +(defvar *thread-special* 1) *thread-special* + +;; thread-interrupt & mutexes +(thread-active-p + (setf th (make-thread + #'(lambda () + (incf *thread-special*) + (let ((*thread-special* 5)) + (mutex-lock m1) + (mutex-lock m2) (mutex-lock m2) + (loop (sleep 1))))))) +T + +;; wait for the global symbol value to change +(loop until (eql *thread-special* 2) do (sleep 0.1)) NIL +;; just sleep little bit +(sleep 0.5) NIL +(symbol-value-thread '*thread-special* th) 5 +(setf (symbol-value-thread '*thread-special* th) 10) 10 +(symbol-value-thread '*thread-special* th) 10 +*thread-special* 2 +;; get global symbol value +(symbol-value-thread '*thread-special* nil) 2 +(eq (mutex-owner m1) th) t +;; check thread-interrupt +(thread-active-p (thread-interrupt th #'mutex-unlock m1)) T +(mutex-owner m1) NIL +(eq (mutex-owner m2) th) T + +(thread-active-p + (setf th2 (make-thread + #'(lambda () + (mutex-lock m2) + (loop (sleep 1)))))) +T + +(progn + (thread-interrupt th #'mutex-unlock m2) + (thread-interrupt th #'mutex-unlock m2) + (sleep 1) + (eq (mutex-owner m2) th2)) +T + +;; kill th2 - warning for locked mutex m2 will be issued and +;; the mutex will be released +(progn (thread-kill th2) (sleep 1)) NIL +(mutex-owner m2) NIL +;; multiple times kill on already dead thread +(eq (thread-kill (thread-kill (thread-kill th))) th) T +(progn (sleep 1) (thread-active-p th)) NIL + +(symbol-cleanup '*thread-special*) T \ No newline at end of file Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v retrieving revision 1.616 retrieving revision 1.617 diff -u -d -r1.616 -r1.617 --- ChangeLog 18 Jan 2009 14:34:08 -0000 1.616 +++ ChangeLog 19 Feb 2009 22:21:00 -0000 1.617 @@ -1,3 +1,8 @@ +2009-02-20 Vladimir Tzankov <vtz...@gm...> + + * mt.tst: add tests for mutexes, per thread bindings of special + variables, thread interruption + 2009-01-18 Sam Steingold <sd...@gn...> * number2.tst: test (log VERY-BIG-NUM) ------------------------------ ------------------------------------------------------------------------------ Open Source Business Conference (OSBC), March 24-25, 2009, San Francisco, CA -OSBC tackles the biggest issue in open source: Open Sourcing the Enterprise -Strategies to boost innovation and cut costs with open source participation -Receive a $600 discount off the registration fee with the source code: SFAD http://p.sf.net/sfu/XcvMzF8H ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 34, Issue 13 ***************************************** |