Megatest

Check-in [35f13f70be]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Fixed get-test-paths, moved local call back to local
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | network-only-transport
Files: files | file ages | folders
SHA1: 35f13f70be31fa55d6b57dd1c84543146dbe767d
User & Date: matt on 2013-03-05 23:05:09
Other Links: branch diff | manifest | tags
Context
2013-03-06
15:26
Fixed db:test-get-paths Closed-Leaf check-in: b310377633 user: mrwellan tags: network-only-transport
2013-03-05
23:05
Fixed get-test-paths, moved local call back to local check-in: 35f13f70be user: matt tags: network-only-transport
13:49
Converted some cdb:remote-runs back to normal calls. check-in: 30c3c88967 user: mrwellan tags: network-only-transport
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified db.scm from [7d138adeda] to [e40a1ad843].

︙
914
915
916
917
918
919
920
921

922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944

914
915
916
917
918
919
920

921
922
923
924
925
926
927
928
929
930
931
932
933
934
935


936
937
938
939
940
941
942








-
+














-
-








(define *last-test-cache-delete* (current-seconds))

(define (db:clean-all-caches)
  (set! *test-info* (make-hash-table))
  (set! *test-id-cache* (make-hash-table)))

;; Get test data using test_id
(define (db:get-test-info-not-cached-by-id db test-id)
(define (db:get-test-info-by-id db test-id)
  (if (not test-id)
      (begin
	(debug:print-info 4 "db:get-test-info-by-id called with test-id=" test-id)
	#f)
      (let ((res #f))
	(sqlite3:for-each-row
	 (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment)
	   ;;                 0    1       2      3      4        5       6      7        8     9     10      11          12          13       14
	   (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment)))
	 db 
	 "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id=?;"
	 test-id)
	res)))

(define db:get-test-info-by-id db:get-test-info-not-cached-by-id)

(define (db:get-test-info db run-id testname item-path)
  (db:get-test-info-by-id db (db:get-test-id db run-id testname item-path)))

(define (db:test-set-comment db test-id comment)
  (sqlite3:execute 
   db 
   "UPDATE tests SET comment=? WHERE id=?;"
︙
968
969
970
971
972
973
974









975
976
977
978
979
980
981

966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988








+
+
+
+
+
+
+
+
+








  (if (string? logf)(cdb:client-call serverdat 'test-set-log #f *default-numtries* logf test-id)))

;;======================================================================
;; Misc. test related queries
;;======================================================================

(define (db:test-get-paths-matching db keynames target fnamepatt #!key (res '()))
  (let ((paths-from-db (db:test-get-paths-matching-keynames-target db keynames target res)))
    (if fnamepatt
	(apply append 
	       (map (lambda (p)
		      (glob (conc p "/" fnamepatt)))
		    res))
	res)))

(define (db:test-get-paths-matching-keynames-target db keynames target res)
  (let* ((testpatt   (if (args:get-arg "-testpatt")(args:get-arg "-testpatt") "%"))
	 (statepatt  (if (args:get-arg ":state")   (args:get-arg ":state")    "%"))
	 (statuspatt (if (args:get-arg ":status")  (args:get-arg ":status")   "%"))
	 (runname    (if (args:get-arg ":runname") (args:get-arg ":runname")  "%"))
	 (keystr (string-intersperse 
		  (map (lambda (key val)
			 (conc "r." key " like '" val "'"))
︙
989
990
991
992
993
994
995
996
997
998
999
1000

1001
1002
1003
1004
1005
1006
1007
1008

996
997
998
999
1000
1001
1002





1003

1004
1005
1006
1007
1008
1009
1010








-
-
-
-
-
+
-








		       "' ORDER BY t.event_time ASC;")))
    (debug:print 3 "qrystr: " qrystr)
    (sqlite3:for-each-row 
     (lambda (p)
       (set! res (cons p res)))
     db 
     qrystr)
    (if fnamepatt
	(apply append 
	       (map (lambda (p)
		      (glob (conc p "/" fnamepatt)))
		    res))
    res))
	res)))

;; look through tests from matching runs for a file
(define (db:test-get-first-path-matching db keynames target fname)
  ;; [refpaths] is the section where references to other megatest databases are stored
  (let ((mt-paths (configf:get-section "refpaths"))
	(res       (db:test-get-paths-matching db keynames target fname)))
    (let loop ((pathdat (if (null? paths) #f (car mt-paths)))
︙

Modified megatest.scm from [98cdb47d4e] to [15795a96e6].

︙
591
592
593
594
595
596
597

598

599
600
601
602
603
604
605
606
607
608

609

610
611
612
613
614
615
616

591
592
593
594
595
596
597
598

599
600
601
602
603
604
605
606
607
608
609
610

611
612
613
614
615
616
617
618








+
-
+










+
-
+








		(exit 1)))
	  (if (not (setup-for-run))
	      (begin
		(debug:print 0 "Failed to setup, giving up on -test-paths or -test-files, exiting")
		(exit 1)))
	  (let* ((keys     (cdb:remote-run db:get-keys db))
		 (keynames (map key:get-fieldname keys))
		 ;; db:test-get-paths must not be run remote
		 (paths    (cdb:remote-run db:test-get-paths-matching db keynames target (args:get-arg "-test-files"))))
		 (paths    (db:test-get-paths-matching db keynames target (args:get-arg "-test-files"))))
	    (set! *didsomething* #t)
	    (for-each (lambda (path)
			(print path))
		      paths)))
	;; else do a general-run-call
	(general-run-call 
	 "-test-files"
	 "Get paths to test"
	 (lambda (target runname keys keynames keyvallst)
	   (let* ((db       #f)
		  ;; DO NOT run remote
		  (paths    (cdb:remote-run db:test-get-paths-matching db keynames target (args:get-arg "-test-files"))))
		  (paths    (db:test-get-paths-matching db keynames target (args:get-arg "-test-files"))))
	     (for-each (lambda (path)
			 (print path))
		       paths))))))

;;======================================================================
;; Archive tests
;;======================================================================
︙
641
642
643
644
645
646
647

648

649
650
651
652
653
654
655
656
657
658

659

660
661
662
663
664
665
666

643
644
645
646
647
648
649
650

651
652
653
654
655
656
657
658
659
660
661
662

663
664
665
666
667
668
669
670








+
-
+










+
-
+








		(exit 1)))
	  (if (not (setup-for-run))
	      (begin
		(debug:print 0 "Failed to setup, giving up on -archive, exiting")
		(exit 1)))
	  (let* ((keys     (cdb:remote-run db:get-keys db))
		 (keynames (map key:get-fieldname keys))
		 ;; DO NOT run remote
		 (paths    (cdb:remote-run db:test-get-paths-matching db keynames target)))
		 (paths    (db:test-get-paths-matching db keynames target)))
	    (set! *didsomething* #t)
	    (for-each (lambda (path)
			(print path))
		      paths)))
	;; else do a general-run-call
	(general-run-call 
	 "-test-paths"
	 "Get paths to tests"
	 (lambda (target runname keys keynames keyvallst)
	   (let* ((db       #f)
		  ;; DO NOT run remote
		  (paths    (cdb:remote-run db:test-get-paths-matching db keynames target)))
		  (paths    (db:test-get-paths-matching db keynames target)))
	     (for-each (lambda (path)
			 (print path))
		       paths))))))

;;======================================================================
;; Extract a spreadsheet from the runs database
;;======================================================================
︙

Modified server.scm from [898af852f2] to [15ec213160].

︙
177
178
179
180
181
182
183
184
185


186
187
188
189
190
191
192

177
178
179
180
181
182
183


184
185
186
187
188
189
190
191
192








-
-
+
+








			#f)))
    ;; if have hostinfo then extract the transport type 
    ;; else fall back to fs
    (debug:print-info 11 "CLIENT SETUP, hostinfo=" hostinfo)
    (set! *transport-type* (if hostinfo 
    			       (string->symbol (tasks:hostinfo-get-transport hostinfo))
			       'fs))
    ;; DEBUG STUFF
    (if (eq? *transport-type* 'fs)(begin (print "ERROR!!!!!!! refusing to run with transport " *transport-type*)(exit 99)))
    ;; ;; DEBUG STUFF
    ;; (if (eq? *transport-type* 'fs)(begin (print "ERROR!!!!!!! refusing to run with transport " *transport-type*)(exit 99)))
    
    (debug:print-info 11 "Using transport type of " *transport-type* (if hostinfo (conc " to connect to " hostinfo) ""))
    (case *transport-type* 
      ((fs)(if (not *megatest-db*)(set! *megatest-db* (open-db))))
      ((http)
       (http-transport:client-connect (tasks:hostinfo-get-interface hostinfo)
				      (tasks:hostinfo-get-port hostinfo)))
︙

Modified tests/fullrun/config/mt_include_1.config from [7cee20486e] to [94520c6b9c]. 

1
2
3

4
5
6
7
8
9
10

1
2

3
4
5
6
7
8
9
10



-
+








[setup]
# exectutable /path/to/megatest
max_concurrent_jobs 50
max_concurrent_jobs 30
linktree #{getenv MT_RUN_AREA_HOME}/tmp/mt_links

[jobtools]
useshell yes
# ## launcher launches jobs, the job is managed on the target host
## by megatest, comment out launcher to run local
# workhosts localhost hermes
︙

This page was generated in about 0.109s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00