Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Further tweaks to wapptest.tcl. Add the ability to run the extra (n)debug tests that releasetest.tcl runs. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | wapptest |
| Files: | files | file ages | folders |
| SHA3-256: |
ec9c4f6d8da25dcc834812c2bb24bda1 |
| User & Date: | dan 2019-04-11 19:03:15 |
Context
|
2019-04-11
| ||
| 19:04 | Merge trunk changes into this branch. Closed-Leaf check-in: d805fc0c user: dan tags: wapptest | |
| 19:03 | Further tweaks to wapptest.tcl. Add the ability to run the extra (n)debug tests that releasetest.tcl runs. check-in: ec9c4f6d user: dan tags: wapptest | |
| 06:50 | Fix the checksymbols target in Makefile.in. check-in: 1956eb34 user: dan tags: wapptest | |
Changes
Changes to test/releasetest_data.tcl.
383 383 lappend opts -DSQLITE_OS_WIN=1 384 384 } else { 385 385 lappend opts -DSQLITE_OS_UNIX=1 386 386 } 387 387 388 388 # Set the sub-directory to use. 389 389 # 390 - set dir [string tolower [string map {- _ " " _} $name]] 390 + set dir [string tolower [string map {- _ " " _ "(" _ ")" _} $name]] 391 391 392 392 # Join option lists into strings, using space as delimiter. 393 393 # 394 394 set makeOpts [join $makeOpts " "] 395 395 set cflags [join $cflags " "] 396 396 set opts [join $opts " "] 397 397
Changes to test/wapptest.tcl.
1 -#!/bin/sh 1 +#!/bin/sh 2 2 # \ 3 3 exec wapptclsh "$0" ${1+"$@"} 4 4 5 5 # package required wapp 6 6 source [file join [file dirname [info script]] wapp.tcl] 7 7 8 8 # Read the data from the releasetest_data.tcl script. ................................................................................ 18 18 # G(tcl) - Use Tcl from this directory for builds. 19 19 # G(jobs) - How many sub-processes to run simultaneously. 20 20 # 21 21 set G(platform) $::tcl_platform(os)-$::tcl_platform(machine) 22 22 set G(test) Normal 23 23 set G(keep) 0 24 24 set G(msvc) 0 25 -set G(tcl) "" 25 +set G(tcl) [::tcl::pkgconfig get libdir,install] 26 26 set G(jobs) 3 27 +set G(debug) 0 27 28 28 29 proc wapptest_init {} { 29 30 global G 30 31 31 - set lSave [list platform test keep msvc tcl jobs] 32 + set lSave [list platform test keep msvc tcl jobs debug] 32 33 foreach k $lSave { set A($k) $G($k) } 33 34 array unset G 34 35 foreach k $lSave { set G($k) $A($k) } 35 36 36 37 # The root of the SQLite source tree. 37 38 set G(srcdir) [file dirname [file dirname [info script]]] 38 39 ................................................................................ 40 41 set G(releaseTest) [file join [file dirname [info script]] releasetest.tcl] 41 42 42 43 set G(sqlite_version) "unknown" 43 44 44 45 # Either "config", "running" or "stopped": 45 46 set G(state) "config" 46 47 47 - set G(host) "(unknown host)" 48 - catch { set G(host) [exec hostname] } 48 + set G(hostname) "(unknown host)" 49 + catch { set G(hostname) [exec hostname] } 50 + set G(host) $G(hostname) 49 51 append G(host) " $::tcl_platform(os) $::tcl_platform(osVersion)" 50 52 append G(host) " $::tcl_platform(machine) $::tcl_platform(byteOrder)" 51 53 } 52 54 53 55 # Check to see if there are uncommitted changes in the SQLite source 54 56 # directory. Return true if there are, or false otherwise. 55 57 # ................................................................................ 60 62 cd $G(srcdir) 61 63 if {[catch {exec fossil changes} res]==0 && [string trim $res]!=""} { 62 64 set ret 1 63 65 } 64 66 cd $pwd 65 67 return $ret 66 68 } 69 + 70 +proc generate_fossil_info {} { 71 + global G 72 + set pwd [pwd] 73 + cd $G(srcdir) 74 + if {[catch {exec fossil info} r1]} return 75 + if {[catch {exec fossil changes} r2]} return 76 + cd $pwd 77 + 78 + foreach line [split $r1 "\n"] { 79 + if {[regexp {^checkout: *(.*)$} $line -> co]} { 80 + wapp-trim { <br> %html($co) } 81 + } 82 + } 83 + 84 + if {[string trim $r2]!=""} { 85 + wapp-trim { 86 + <br><span class=warning> 87 + WARNING: Uncommitted changes in checkout 88 + </span> 89 + } 90 + } 91 +} 67 92 68 93 # If the application is in "config" state, set the contents of the 69 94 # ::G(test_array) global to reflect the tests that will be run. If the 70 95 # app is in some other state ("running" or "stopped"), this command 71 96 # is a no-op. 72 97 # 73 98 proc set_test_array {} { ................................................................................ 98 123 set target testfixture.exe 99 124 } 100 125 } 101 126 } 102 127 } 103 128 104 129 lappend G(test_array) [dict create config $config target $target] 130 + 131 + set exclude [list checksymbols valgrindtest fuzzoomtest] 132 + if {$G(debug) && !($target in $exclude)} { 133 + set debug_idx [lsearch -glob $::Configs($config) -DSQLITE_DEBUG*] 134 + set xtarget $target 135 + regsub -all {fulltest[a-z]*} $xtarget test xtarget 136 + if {$debug_idx<0} { 137 + lappend G(test_array) [ 138 + dict create config $config-(Debug) target $target 139 + ] 140 + } else { 141 + lappend G(test_array) [ 142 + dict create config $config-(NDebug) target $xtarget 143 + ] 144 + } 145 + } 105 146 } 106 147 } 107 148 } 108 149 109 150 proc count_tests_and_errors {name logfile} { 110 151 global G 111 152 ................................................................................ 238 279 set G(test.$name.start) [clock seconds] 239 280 set fd [open "|[info nameofexecutable] $G(releaseTest) --slave" r+] 240 281 set G(test.$name.channel) $fd 241 282 fconfigure $fd -blocking 0 242 283 fileevent $fd readable [list slave_fileevent $name] 243 284 244 285 puts $fd [list 0 $G(msvc) 0 $G(keep)] 245 - set L [make_test_suite $G(msvc) "" $name $target $::Configs($name)] 286 + 287 + set wtcl "" 288 + if {$G(tcl)!=""} { set wtcl "--with-tcl=$G(tcl)" } 289 + 290 + # If this configuration is named <name>-(Debug) or <name>-(NDebug), 291 + # then add or remove the SQLITE_DEBUG option from the base 292 + # configuration before running the test. 293 + if {[regexp -- {(.*)-(\(.*\))} $name -> head tail]} { 294 + set opts $::Configs($head) 295 + if {$tail=="(Debug)"} { 296 + append opts " -DSQLITE_DEBUG=1 -DSQLITE_EXTRA_IFNULLROW=1" 297 + } else { 298 + regsub { *-DSQLITE_MEMDEBUG[^ ]* *} $opts { } opts 299 + regsub { *-DSQLITE_DEBUG[^ ]* *} $opts { } opts 300 + } 301 + } else { 302 + set opts $::Configs($name) 303 + } 304 + 305 + set L [make_test_suite $G(msvc) $wtcl $name $target $opts] 246 306 puts $fd $L 247 307 flush $fd 248 308 set G(test.$name.log) [file join [lindex $L 1] test.log] 249 309 incr nLaunch -1 250 310 } 251 311 } 252 312 } ................................................................................ 265 325 wapp-trim { </select> } 266 326 } 267 327 268 328 proc generate_main_page {{extra {}}} { 269 329 global G 270 330 set_test_array 271 331 272 - # <meta http-equiv="refresh" content="5; URL=/"> 332 + set hostname $G(hostname) 273 333 wapp-trim { 274 334 <html> 275 335 <head> 336 + <title> %html($hostname): wapptest.tcl </title> 276 337 <link rel="stylesheet" type="text/css" href="style.css"/> 277 338 </head> 278 339 <body> 279 340 } 280 341 281 - # If the checkout contains uncommitted changs, put a warning at the top 282 - # of the page. 283 - if {[check_uncommitted]} { 284 - wapp-trim { 285 - <div class=warning> 286 - WARNING: Uncommitted changes in checkout. 287 - </div> 288 - } 289 - } 290 - 291 342 set host $G(host) 292 343 wapp-trim { 293 - <div class=div>%string($host)</div> 294 - <div class=div id=controls> 295 - <form action="control" method="post" name="control"> 344 + <div class="border">%string($host) 345 + } 346 + generate_fossil_info 347 + wapp-trim { 348 + </div> 349 + <div class="border" id=controls> 350 + <form action="control" method="post" name="control"> 296 351 } 297 352 298 353 # Build the "platform" select widget. 299 354 set lOpt [array names ::Platforms] 300 355 generate_select_widget Platform control_platform $lOpt $G(platform) 301 356 302 357 # Build the "test" select widget. ................................................................................ 332 387 <label> Tcl: </label> 333 388 <input id="control_tcl" name="control_tcl"></input> 334 389 <label> Keep files: </label> 335 390 <input id="control_keep" name="control_keep" type=checkbox value=1> 336 391 </input> 337 392 <label> Use MSVC: </label> 338 393 <input id="control_msvc" name="control_msvc" type=checkbox value=1> 394 + <label> Debug tests: </label> 395 + <input id="control_debug" name="control_debug" type=checkbox value=1> 339 396 </input> 340 397 } 341 398 wapp-trim { 342 399 </form> 343 400 } 344 401 wapp-trim { 345 402 </div> 346 - <div class=div2 id=tests> 403 + <div id=tests> 347 404 } 348 405 wapp-page-tests 349 406 350 407 set script "script/$G(state).js" 351 408 wapp-trim { 352 409 </div> 353 410 <script src=%string($script)></script> ................................................................................ 358 415 359 416 proc wapp-default {} { 360 417 generate_main_page 361 418 } 362 419 363 420 proc wapp-page-tests {} { 364 421 global G 365 - wapp-trim { <table> } 422 + wapp-trim { <table class="border" width=100%> } 366 423 foreach t $G(test_array) { 367 424 set config [dict get $t config] 368 425 set target [dict get $t target] 369 426 370 427 set class "testwait" 371 428 set seconds "" 372 429 ................................................................................ 387 444 set hr [format %.2d [expr $seconds / 3600]] 388 445 set sec [format %.2d [expr $seconds % 60]] 389 446 set seconds "$hr:$min:$sec" 390 447 } 391 448 392 449 wapp-trim { 393 450 <tr class=%string($class)> 394 - <td class=testfield> %html($config) 395 - <td class=testfield> %html($target) 396 - <td class=testfield> %html($seconds) 397 - <td class=testfield> 451 + <td class="nowrap"> %html($config) 452 + <td class="padleft nowrap"> %html($target) 453 + <td class="padleft nowrap"> %html($seconds) 454 + <td class="padleft nowrap"> 398 455 } 399 456 if {[info exists G(test.$config.log)]} { 400 457 set log $G(test.$config.log) 401 458 set uri "log/$log" 402 459 wapp-trim { 403 460 <a href=%url($uri)> %html($log) </a> 404 461 } 405 462 } 406 463 if {[info exists G(test.$config.errmsg)] && $G(test.$config.errmsg)!=""} { 407 464 set errmsg $G(test.$config.errmsg) 408 465 wapp-trim { 409 466 <tr class=testfail> 410 - <td class=testfield> 411 - <td class=testfield colspan=3> %html($errmsg) 467 + <td> <td class="padleft" colspan=3> %html($errmsg) 412 468 } 413 469 } 414 470 } 415 471 416 472 wapp-trim { </table> } 417 473 418 474 if {[info exists G(result)]} { ................................................................................ 426 482 # URI: /control 427 483 # 428 484 # Whenever the form at the top of the application page is submitted, it 429 485 # is submitted here. 430 486 # 431 487 proc wapp-page-control {} { 432 488 global G 433 - catch { puts [wapp-param control_msvc] } 434 489 if {$::G(state)=="config"} { 435 - set lControls [list platform test tcl jobs keep msvc] 490 + set lControls [list platform test tcl jobs keep msvc debug] 436 491 set G(msvc) 0 437 492 set G(keep) 0 493 + set G(debug) 0 438 494 } else { 439 495 set lControls [list jobs] 440 496 } 441 497 foreach v $lControls { 442 498 if {[wapp-param-exists control_$v]} { 443 499 set G($v) [wapp-param control_$v] 444 500 } ................................................................................ 478 534 479 535 # URI: /style.css 480 536 # 481 537 # Return the stylesheet for the application main page. 482 538 # 483 539 proc wapp-page-style.css {} { 484 540 wapp-subst { 485 - .div { 486 - border: 3px groove #444444; 487 - margin: 1em; 488 - padding: 1em; 489 - } 490 541 542 + /* The boxes with black borders use this class */ 491 543 .border { 492 544 border: 3px groove #444444; 493 545 padding: 1em; 494 546 margin-top: 1em; 495 547 margin-bottom: 1em; 496 548 } 497 549 498 - .div2 { 499 - margin: 1em; 500 - } 550 + /* Float to the right (used for the Run/Stop/Reset button) */ 551 + .right { float: right; } 501 552 502 - table { 503 - padding: 1em; 504 - width:100%; 505 - border: 3px groove #444444; 506 - } 507 - 553 + /* Style for the large red warning at the top of the page */ 508 554 .warning { 509 - text-align:center; 510 555 color: red; 511 - font-size: 2em; 512 556 font-weight: bold; 513 557 } 514 558 515 - .testfield { 516 - padding-right: 10ex; 517 - white-space: nowrap; 518 - } 559 + /* Styles used by cells in the test table */ 560 + .padleft { padding-left: 5ex; } 561 + .nowrap { white-space: nowrap; } 519 562 520 - .testwait {} 521 - .testrunning { color: blue } 522 - .testdone { color: green } 523 - .testfail { color: red } 524 - 525 - .right { float: right; } 526 - 563 + /* Styles for individual tests, depending on the outcome */ 564 + .testwait { } 565 + .testrunning { color: blue } 566 + .testdone { color: green } 567 + .testfail { color: red } 527 568 } 528 569 } 529 570 530 571 # URI: /script/${state}.js 531 572 # 532 573 # The last part of this URI is always "config.js", "running.js" or 533 574 # "stopped.js", depending on the state of the application. It returns ................................................................................ 536 577 # 537 578 proc wapp-page-script {} { 538 579 regexp {[^/]*$} [wapp-param REQUEST_URI] script 539 580 540 581 set tcl $::G(tcl) 541 582 set keep $::G(keep) 542 583 set msvc $::G(msvc) 584 + set debug $::G(debug) 543 585 544 586 wapp-subst { 545 587 var lElem = \["control_platform", "control_test", "control_msvc", 546 - "control_jobs" 588 + "control_jobs", "control_debug" 547 589 \]; 548 590 lElem.forEach(function(e) { 549 591 var elem = document.getElementById(e); 550 592 elem.addEventListener("change", function() { control.submit() } ); 551 593 }) 552 594 553 595 elem = document.getElementById("control_tcl"); ................................................................................ 554 596 elem.value = "%string($tcl)" 555 597 556 598 elem = document.getElementById("control_keep"); 557 599 elem.checked = %string($keep); 558 600 559 601 elem = document.getElementById("control_msvc"); 560 602 elem.checked = %string($msvc); 603 + 604 + elem = document.getElementById("control_debug"); 605 + elem.checked = %string($debug); 561 606 } 562 607 563 608 if {$script != "config.js"} { 564 609 wapp-subst { 565 610 var lElem = \["control_platform", "control_test", 566 611 "control_tcl", "control_keep", "control_msvc" 567 612 \];