OpenACS

micheles
committed
oacs-5-3:micheles:20070710164352
on 10 Jul 07
Moved javascript code to applet.js. Trashed OBJECT and kept APPLET tag
openacs-4/.../acs-automated-testing/tcl/aa-test-procs.tcl (+3 -4)
2402 2402     Displays either a pass or fail result with specified explanation
2403 2403     depending on the given response.
2404 2404
2405 2405     @param response A boolean value where true (or 1, etc) corresponds
2406 2406     to a pass result, otherwise the result is a fail.
2407 2407     @param explanation An explanation accompanying the response.
2408 2408 } {
2409 2409     if {$response} {
2410 2410         aa_log_result "pass" "[aa_indent] $explanation"
2411 2411     } else {
2412 2412         aa_log_result "fail" "[aa_indent] $explanation"
2413 2413     }
2414 2414 }
2415 2415
2416 2416 ad_proc -private aa_used_application_memory {} {
2417 2417
2418 2418     Return the currently used application memory.  This function
2419 2419     depends on the usage of TCMalloc from Google Performance Tools.
2420 2420
2421 2421 } {
2422       try {
2423           ns_info meminfo
2424       } on ok {mem_info} {
  2422     if {[::acs::icanuse "ns_info meminfo"]} {
  2423         set mem_info [ns_info meminfo]
2425 2424         dict with mem_info {
2426 2425             # check for a line looking in the TCMalloc result like:
2427 2426             #
2428 2427             #   MALLOC:     2531634144 ( 2414.4 MiB) Bytes in use by application
2429 2428             #
2430 2429             if {[info exists stats] && [regexp {\nMALLOC:\s+(\d+)\s} $stats . bytes]} {
2431 2430                 set old_value [nsv_set -reset aa_test application_memory $bytes]
2432 2431                 if {$old_value ne ""} {
2433 2432                     return [list current $bytes diff [expr {$bytes - $old_value}]]
2434 2433                 }
2435 2434             }
2436 2435         }
2437       } on error {errmsg} {}
2438 2436     }
  2437 }
2439 2438
2440 2439 ad_proc -public aa_check_leftovers {-silent:boolean {msg final}} {
2441 2440     #
2442 2441     # Perform cleanup tests to check for object/command leaks in
2443 2442     # either the called functions or in the test itself.
2444 2443     #
2445 2444 } {
2446 2445     if {[namespace which ::xo::at_cleanup] ne ""} {
2447 2446         ::xo::at_cleanup
2448 2447     }
2449 2448
2450 2449     set domNodes   [list {*}[info commands domNode0*] {*}[info commands domDoc0x*]]
2451 2450     set xotclObjs  [::xotcl::Object info instances -closure]
2452 2451     set nxObjs     [::nx::Object info instances  -closure]
2453 2452     set tmpObjs    [info commands ::nsf::__#*]
2454 2453     set nsSets     [expr {[acs::icanuse "ns_set stats"] ? [list [ns_set stats]] : [llength [ns_set list]]}]
2455 2454
2456 2455     dict set stats tdom    [llength $domNodes]
2457 2456     dict set stats nssets  [llength $nsSets]
2458 2457     dict set stats xotcl   [llength $xotclObjs]