Author: lgiessmann Date: Wed Sep 1 08:09:38 2010 New Revision: 312 Log: added a test file for the threading problem with hunchentoot Added: branches/new-datamodel/playground/threading_debugging.lisp Modified: branches/new-datamodel/playground/isidorus_test.sh Modified: branches/new-datamodel/playground/isidorus_test.sh ============================================================================== --- branches/new-datamodel/playground/isidorus_test.sh (original) +++ branches/new-datamodel/playground/isidorus_test.sh Wed Sep 1 08:09:38 2010 @@ -10,9 +10,9 @@ Nil="false"; doReq1=$T; -doReq2=$Nil; -doReq3=$Nil; -doReq4=$Nil; +doReq2=$T; +doReq3=$T; +doReq4=$T; dir1="req1"; dir2="req2"; @@ -57,25 +57,25 @@ if [ $doReq1 == $T ]; then path1=$log1$counter; result1=$res1$counter; - wget -o $path1".log" -O $result1".res" $req1; + wget -o $path1".log" -O $result1".res" $req1; fi if [ $doReq2 == $T ]; then path2=$log2$counter; result2=$res2$counter; - wget -o $path2".log" -O $result2".res" $req2; + wget -o $path2".log" -O $result2".res" $req2; fi if [ $doReq3 == $T ]; then path3=$log3$counter; result3=$res3$counter; - wget -o $path3".log" -O $result3".res" $req3; + wget -o $path3".log" -O $result3".res" $req3; fi if [ $doReq4 == $T ]; then path4=$log4$counter; result4=$res4$counter; - wget -o $path4".log" -O $result4".res" $req4; + wget -o $path4".log" -O $result4".res" $req4; fi } Added: branches/new-datamodel/playground/threading_debugging.lisp ============================================================================== --- (empty file) +++ branches/new-datamodel/playground/threading_debugging.lisp Wed Sep 1 08:09:38 2010 @@ -0,0 +1,67 @@ +(asdf:operate 'asdf:load-op :isidorus) +(xml-importer:setup-repository "textgrid.xtm" "data_base" + :tm-id "http://ztt.fh-worms.de/textgrid.xtm" + :xtm-id "textgrid.xtm") + + +(defun return-all-tmcl-types-test-handler (&optional param) + "similar to hunchentoot's corresponding handler - but without hunchentoot's + variables, e.g. hunchentoot:content-type, ..." + (declare (ignorable param)) + (handler-case (let ((topic-types + (isidorus-threading:with-reader-lock + (json-tmcl::return-all-tmcl-types :revision 0)))) + (json:encode-json-to-string + (map 'list #'(lambda(y) + (map 'list #'d:uri y)) + (map 'list #'d:psis topic-types)))) + (condition (err) (error (format nil "~a" err))))) + + +(defun return-all-topic-psis-test-handler (&optional param) + "similar to hunchentoot's corresponding handler - but without hunchentoot's + variables, e.g. hunchentoot:content-type, ..." + (declare (ignorable param)) + (handler-case (isidorus-threading:with-reader-lock + (json-exporter::get-all-topic-psis :revision 0)) + (condition (err) (error (format nil "~a" err))))) + + +(defun my-thread-function-1 () + (dotimes (i 100) + (return-all-tmcl-types-test-handler))) + + +(defun programm-1 (thread-fun) + (defvar *thread-1* (bordeaux-threads:make-thread thread-fun)) + (defvar *thread-2* (bordeaux-threads:make-thread thread-fun))) + + +(defun programm-2 (thread-fun) + (let ((thread-1 nil) + (thread-2 nil) + (max-iterations 50)) + (do ((c1 0 (+ c1 0)) + (c2 0 (+ c2 0))) + ((and (>= c1 max-iterations) (>= c2 max-iterations))) + (when (or (not thread-1) (not (bordeaux-threads:thread-alive-p thread-1))) + (setf thread-1 (bordeaux-threads:make-thread thread-fun)) + (incf c1) + (format t "c1: ~a c2: ~a~%" c1 c2)) + (when (or (not thread-2) (not (bordeaux-threads:thread-alive-p thread-2))) + (setf thread-2 (bordeaux-threads:make-thread thread-fun)) + (incf c2) + (format t "c1: ~a c2: ~a~%" c1 c2))))) + + + + + + + + +(defun main() + (programm-2 #'return-all-tmcl-types-test-handler)) + + +(main) \ No newline at end of file