[isidorus-cvs] r312 - branches/new-datamodel/playground - isidorus-cvs@common-lisp.net - mailman3.common-lisp.net

1 Sep 2010

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

    