Overview
Comment: | Fixed cleaning of steps window after fresh run. Fixd stuck gui on test-panel |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | refactor-api |
Files: | files | file ages | folders |
SHA1: |
9a62bcf487c4fffb841800f5597cbaf2 |
User & Date: | matt on 2013-07-29 00:12:12 |
Other Links: | branch diff | manifest | tags |
Context
2013-07-29
| ||
00:20 | Missed removal of one print statement check-in: 188db4d0d0 user: matt tags: refactor-api | |
00:12 | Fixed cleaning of steps window after fresh run. Fixd stuck gui on test-panel check-in: 9a62bcf487 user: matt tags: refactor-api | |
2013-07-28
| ||
22:04 | Almost 80% on api conversion for test control panel check-in: 82e43c52e7 user: matt tags: refactor-api | |
Changes
Modified api.scm from [c0c3ff9c7b] to [bb24492b2f].
︙ | |||
13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 | + + | (declare (uses rmt)) (declare (uses db)) ;; These are called by the server on recipt of /api calls (define (api:execute-requests db cmd params) (debug:print-info 1 "api:execute-requests cmd=" cmd " params=" params) (db:process-cached-writes db) (case (string->symbol cmd) ;; KEYS ((get-key-val-pairs) (apply db:get-key-val-pairs db params)) ;; TESTS ;; json doesn't do vectors, convert to list ((get-test-info-by-id) (vector->list (apply db:get-test-info-by-id db params))) ((test-get-rundir-from-test-id) (apply db:test-get-rundir-from-test-id db params)) ((testmeta-get-record) (vector->list (apply db:testmeta-get-record db params))) ((test-set-state-status-by-id) (apply db:test-set-state-status-by-id db params)) ;; RUNS ((get-run-info) (let ((res (apply db:get-run-info db params))) (list (vector-ref res 0) (vector->list (vector-ref res 1))))) (else (list "ERROR" 0)))) |
︙ |
Modified dashboard-tests.scm from [90fbf09413] to [07161126c3].
︙ | |||
204 205 206 207 208 209 210 | 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 | - + - + - + | (newstatus #f) (newstate #f)) (iup:frame #:title "Set fields" (iup:vbox (iup:hbox (iup:label "Comment:") (iup:textbox #:action (lambda (val a b) |
︙ | |||
363 364 365 366 367 368 369 370 371 372 373 374 375 376 | 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 | + | (runname (if testdat (db:get-value-by-header (db:get-row rundat) (db:get-header rundat) "runname") #f)) ;; These next two are intentional bad values to ensure errors if they should not ;; get filled in properly. (logfile "/this/dir/better/not/exist") (rundir logfile) (testdat-path (conc rundir "/testdat.db")) ;; this gets recalculated until found (teststeps (if testdat (dashboard-tests:get-compressed-steps test-id work-area: rundir) '())) (testfullname (if testdat (db:test-get-fullname testdat) "Gathering data ...")) (testname (if testdat (db:test-get-testname testdat) "n/a")) (testmeta (if testdat (let ((tm (rmt:testmeta-get-record testname))) (if tm tm (make-db:testmeta))) (make-db:testmeta))) |
︙ | |||
398 399 400 401 402 403 404 405 | 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 | + - + + + + + + - + + - + + + + + - - + + + + + + + + + + + + | (if (directory-exists? rundir) (let ((shell (if (get-environment-variable "SHELL") (conc "-e " (get-environment-variable "SHELL")) ""))) (system (conc "cd " rundir ";xterm -T \"" (string-translate testfullname "()" " ") "\" " shell "&"))) (message-window (conc "Directory " rundir " not found"))))) (widgets (make-hash-table)) (refreshdat (lambda () |
︙ | |||
538 539 540 541 542 543 544 | 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 | + - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | (iup:attribute-set! steps-matrix "0:5" "Duration") (iup:attribute-set! steps-matrix "0:6" "Log File") (iup:attribute-set! steps-matrix "ALIGNMENT1" "ALEFT") ;; (iup:attribute-set! steps-matrix "FIXTOTEXT" "C1") (iup:attribute-set! steps-matrix "RESIZEMATRIX" "YES") (let ((proc (lambda (testdat) (let ((max-row 0)) |
︙ | |||
600 601 602 603 604 605 606 | 644 645 646 647 648 649 650 651 652 653 | - - - - - - - - | tabs)))) (iup:show self) (iup:callback-set! *tim* "ACTION_CB" (lambda (x) ;; Now start keeping the gui updated from the db (refreshdat) ;; update from the db here ;(thread-suspend! other-thread) |
Modified dashboard.scm from [91e2b07405] to [509d618322].
︙ | |||
1336 1337 1338 1339 1340 1341 1342 | 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 | - - + + | (set! *last-db-update-time* modtime) (set! *last-update* run-update-time))))) ;;====================================================================== ;; The heavy lifting starts here ;;====================================================================== |
︙ |
Modified db.scm from [62d66dee17] to [7172822a6c].
︙ | |||
1115 1116 1117 1118 1119 1120 1121 | 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 | - + + + | ((and newstate newstatus newcomment) (sqlite3:execute db "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;" newstate newstatus newcomment test-id)) ((and newstate newstatus) (sqlite3:execute db "UPDATE tests SET state=?,status=? WHERE id=?;" newstate newstatus test-id)) (else (if newstate (sqlite3:execute db "UPDATE tests SET state=? WHERE id=?;" newstate test-id)) (if newstatus (sqlite3:execute db "UPDATE tests SET status=? WHERE id=?;" newstatus test-id)) |
︙ |
Modified http-transport.scm from [56910ff5a9] to [cfbe6dec89].
︙ | |||
98 99 100 101 102 103 104 | 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 | - - + + + + | (if (not db)(set! db (open-db))) (let* (($ (request-vars source: 'both)) (dat ($ 'dat)) (res #f)) (cond ((equal? (uri-path (request-uri (current-request))) '(/ "api")) |
︙ |
Modified rmt.scm from [706a072116] to [851932b993].
︙ | |||
87 88 89 90 91 92 93 94 95 96 97 98 99 100 | 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 | + + + + | (debug:print 3 "TEST PATH: " test-path) (open-test-db test-path))) (define (rmt:testmeta-get-record testname) (list->vector (rmt:send-receive 'testmeta-get-record (list testname)))) ;; WARNING: This currently bypasses the transaction wrapped writes system (define (rmt:test-set-state-status-by-id test-id newstate newstatus newcomment) (rmt:send-receive 'test-set-state-status-by-id (list test-id newstate newstatus newcomment))) ;;====================================================================== ;; R U N S ;;====================================================================== (define (rmt:get-run-info run-id) (let ((res (rmt:send-receive 'get-run-info (list run-id)))) (vector (car res) |
︙ |