home *** CD-ROM | disk | FTP | other *** search
/ Serving the Web / ServingTheWeb1995.disc1of1.iso / linux / slacksrce / tcl / tcl+tk+t / tclx7.3bl / tclx7 / tclX7.3b / tests / profile.test < prev    next >
Encoding:
Text File  |  1994-07-16  |  9.4 KB  |  318 lines
  1. #
  2. # profile.test
  3. #
  4. # Tests for the profile command and profrep procedure.
  5. #---------------------------------------------------------------------------
  6. # Copyright 1992-1994 Karl Lehenbauer and Mark Diekhans.
  7. #
  8. # Permission to use, copy, modify, and distribute this software and its
  9. # documentation for any purpose and without fee is hereby granted, provided
  10. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11. # Mark Diekhans make no representations about the suitability of this
  12. # software for any purpose.  It is provided "as is" without express or
  13. # implied warranty.
  14. #------------------------------------------------------------------------------
  15. # $Id: profile.test,v 4.0 1994/07/16 05:25:43 markd Rel $
  16. #------------------------------------------------------------------------------
  17. #
  18.  
  19. if {[info procs test] != "test"} then {source testlib.tcl}
  20.  
  21. # Make sure we that real time is not zero.  If so, suggest compiling with a
  22. # different parameter.
  23.  
  24. proc ProcA1 {} {sleep 1}
  25. profile on
  26. ProcA1
  27. profile off profData
  28. foreach idx [array names profData] {
  29.    if [string match "ProcA1 *" $idx] break
  30. }
  31.  
  32. if {[lindex $profData($idx) 1] == 0} {
  33.     puts "*** The profile command is returning real time values of"
  34.     puts "*** zero.  This suggests that your `times' system call does"
  35.     puts "*** not return elapsed real time.  The configure script"
  36.     puts "*** did not properly detect this.  Try defining the flag"
  37.     puts "*** TIMES_RETS_REAL_TIME in src/tclXconfig.h and reporting"
  38.     puts "*** this to the maintainers"
  39. }
  40.  
  41. #
  42. # Function to build a list from the profile output data with each entry
  43. # contain the call stack and call count.  The list is returned sorted by
  44. # call stack.
  45. #
  46.  
  47. proc SumCntData {profDataVar} {
  48.     upvar $profDataVar profData
  49.     set sumData {}
  50.     foreach stack [array names profData] {
  51.         lappend sumData [list $stack [lindex $profData($stack) 0]]
  52.     }
  53.     return [lsort $sumData]
  54. }
  55.  
  56. proc ProcA1 {} {ProcB1}
  57. proc ProcB1 {} {ProcC1;ProcC1}
  58. proc ProcC1 {} {}
  59.  
  60. Test profile-1.1 {profile count tests} {
  61.    profile on
  62.    ProcA1
  63.    profile off profData
  64.    SumCntData profData
  65. } 0 [list {<global> 1} \
  66.           {{ProcA1 <global>} 1} \
  67.           {{ProcB1 ProcA1 <global>} 1} \
  68.           {{ProcC1 ProcB1 ProcA1 <global>} 2}]
  69.  
  70. proc ProcA2 {} {ProcB2}
  71. proc ProcB2 {} {ProcC2}
  72. proc ProcC2 {} {uplevel ProcD2; ProcD2}
  73. proc ProcD2 {} {}
  74.  
  75. Test profile-1.2 {profile count tests} {
  76.    profile on
  77.    ProcA2
  78.    profile off profData
  79.    SumCntData profData
  80. } 0 [list {<global> 1} \
  81.           {{ProcA2 <global>} 1} \
  82.           {{ProcB2 ProcA2 <global>} 1} \
  83.           {{ProcC2 ProcB2 ProcA2 <global>} 1} \
  84.           {{ProcD2 ProcB2 ProcA2 <global>} 1} \
  85.           {{ProcD2 ProcC2 ProcB2 ProcA2 <global>} 1}]
  86.  
  87. proc ProcA3 {} {ProcB3}
  88. proc ProcB3 {} {catch {ProcC3};ProcE3}
  89. proc ProcC3 {} {ProcD3}
  90. proc ProcD3 {} {error baz}
  91. proc ProcE3 {} {}
  92.  
  93. Test profile-1.3 {profile count tests} {
  94.    profile on
  95.    ProcA3
  96.    profile off profData
  97.    SumCntData profData
  98. } 0 [list {<global> 1} \
  99.           {{ProcA3 <global>} 1} \
  100.           {{ProcB3 ProcA3 <global>} 1} \
  101.           {{ProcC3 ProcB3 ProcA3 <global>} 1} \
  102.           {{ProcD3 ProcC3 ProcB3 ProcA3 <global>} 1} \
  103.           {{ProcE3 ProcB3 ProcA3 <global>} 1}]
  104.  
  105. #
  106. # Function to build a list from the profile output data with each entry
  107. # contain the call stack and call count.  The list is returned sorted by
  108. # CPU time.  CPU time is not included in the return, since it can't be
  109. # verified exactly, only approximately.
  110. #
  111.  
  112. proc SumCpuData {profDataVar} {
  113.     upvar $profDataVar profData
  114.     set sumData {}
  115.     foreach stack [array names profData] {
  116.         lappend sumData [list [format %032d [lindex $profData($stack) 2]] \
  117.                               $stack [lindex $profData($stack) 0]]
  118.     }
  119.     set retData {}
  120.     foreach entry $sumData {
  121.         lappend retData [lrange $entry 1 end]
  122.     }
  123.     return [lsort $retData]
  124. }
  125.  
  126. proc EatTime {amount} {
  127.     set end   [expr [lindex [times] 0]+$amount]
  128.     while {[lindex [times] 0] < $end} {
  129.         format %d 100  ;# kind of slow command.
  130.     }    
  131. }
  132.  
  133. proc ProcA4 {} {ProcB4;ProcC4;ProcD4}
  134. proc ProcB4 {} {EatTime 1}
  135. proc ProcC4 {} {EatTime 100}
  136. proc ProcD4 {} {EatTime 1000}
  137.  
  138. Test profile-2.1 {profile CPU time tests} {
  139.    profile on
  140.    ProcA4
  141.    profile off profData
  142.    SumCpuData profData
  143. } 0 [list {<global> 1} \
  144.           {{EatTime ProcB4 ProcA4 <global>} 1} \
  145.           {{EatTime ProcC4 ProcA4 <global>} 1} \
  146.           {{EatTime ProcD4 ProcA4 <global>} 1} \
  147.           {{ProcA4 <global>} 1} {{ProcB4 ProcA4 <global>} 1} \
  148.           {{ProcC4 ProcA4 <global>} 1} {{ProcD4 ProcA4 <global>} 1}]
  149.  
  150. proc ProcA1 {} {ProcB1;set a 1;incr a}
  151. proc ProcB1 {} {ProcC1;ProcC1}
  152. proc ProcC1 {} {set a 1;incr a}
  153.  
  154. Test profile-3.1 {profile -command tests} {
  155.    profile -commands on
  156.    ProcA1
  157.    profile off profData
  158.    SumCntData profData
  159. } 0 [list {<global> 1} \
  160.           {{ProcA1 <global>} 1} \
  161.           {{ProcB1 ProcA1 <global>} 1} \
  162.           {{ProcC1 ProcB1 ProcA1 <global>} 2} \
  163.           {{incr ProcA1 <global>} 1} \
  164.           {{incr ProcC1 ProcB1 ProcA1 <global>} 2} \
  165.           {{profile <global>} 1} {{set ProcA1 <global>} 1} \
  166.           {{set ProcC1 ProcB1 ProcA1 <global>} 2}]
  167.  
  168. Test profile-4.1 {profile error tests} {
  169.     profile off
  170. } 1 {wrong # args: profile ?-commands? on|off arrayVar}
  171.  
  172. Test profile-4.2 {profile error tests} {
  173.     profile baz
  174. } 1 {expected one of "on" or "off", got "baz"}
  175.  
  176. Test profile-4.3 {profile error tests} {
  177.     profile -comman on
  178. } 1 {expected option of "-commands", got "-comman"}
  179.  
  180. Test profile-4.4 {profile error tests} {
  181.     profile -commands off
  182. } 1 {wrong # args: profile ?-commands? on|off arrayVar}
  183.  
  184. Test profile-4.5 {profile error tests} {
  185.     profile -commands
  186. } 1 {wrong # args: profile ?-commands? on|off arrayVar}
  187.  
  188. Test profile-4.6 {profile error tests} {
  189.     profile -commands on foo
  190. } 1 {wrong # args: profile ?-commands? on|off arrayVar}
  191.  
  192. Test profile-4.7 {profile error tests} {
  193.     profile off foo
  194. } 1 {profiling is not currently enabled}
  195.  
  196. Test profile-4.8 {profile error tests} {
  197.     profile on
  198.     profile on
  199. } 1 {profiling is already enabled}
  200. profile off foo
  201.  
  202. #
  203. # Set up some dummy profile data for the report tests.  The data is not
  204. # realistic, but designed so that no two numbers that are sorted on are the
  205. # same.
  206. #
  207. catch {unset profData}
  208. set baz {EatTime ProcB4 ProcA4}
  209. set profData($baz) {4 800 10}
  210. set baz {ProcC4 ProcA4}
  211. set profData($baz) {3 1000 101}
  212. set baz {EatTime ProcC4 ProcA4}
  213. set profData($baz) {2 1001 100}
  214. set baz {ProcD4 ProcA4}
  215. set profData($baz) {1 100 1071}
  216. set baz ProcA4
  217. set profData($baz) {5 1250 1180}
  218. set baz {EatTime ProcD4 ProcA4}
  219. set profData($baz) {6 1070 1070}
  220. set baz {ProcB4 ProcA4}
  221. set profData($baz) {7 80 11}
  222.  
  223. #
  224. # Read the profile report into memory and purge the file
  225. #
  226. proc GetProfRep {fileName} {
  227.     set fh [open $fileName]
  228.     set data [read $fh]
  229.     close $fh
  230.     unlink $fileName
  231.     return $data
  232. }
  233.  
  234. eval $SAVED_UNKNOWN
  235.  
  236. Test profile-5.1 {profrep tests} {
  237.     profrep profData calls prof.tmp "Profile Test 5.1"
  238.     GetProfRep prof.tmp
  239. } 0 {---------------------------------------------------------
  240. Profile Test 5.1
  241. ---------------------------------------------------------
  242. Procedure Call Stack          Calls  Real Time   CPU Time
  243. ---------------------------------------------------------
  244. ProcB4                            7         80         11
  245.     ProcA4
  246. EatTime                           6       1070       1070
  247.     ProcD4
  248.     ProcA4
  249. ProcA4                            5       1250       1180
  250. EatTime                           4        800         10
  251.     ProcB4
  252.     ProcA4
  253. ProcC4                            3       1000        101
  254.     ProcA4
  255. EatTime                           2       1001        100
  256.     ProcC4
  257.     ProcA4
  258. ProcD4                            1        100       1071
  259.     ProcA4
  260. }
  261.  
  262. Test profile-5.2 {profrep tests} {
  263.     profrep profData real prof.tmp "Profile Test 5.2"
  264.     GetProfRep prof.tmp
  265. } 0 {---------------------------------------------------------
  266. Profile Test 5.2
  267. ---------------------------------------------------------
  268. Procedure Call Stack          Calls  Real Time   CPU Time
  269. ---------------------------------------------------------
  270. ProcA4                            5       1250       1180
  271. EatTime                           6       1070       1070
  272.     ProcD4
  273.     ProcA4
  274. EatTime                           2       1001        100
  275.     ProcC4
  276.     ProcA4
  277. ProcC4                            3       1000        101
  278.     ProcA4
  279. EatTime                           4        800         10
  280.     ProcB4
  281.     ProcA4
  282. ProcD4                            1        100       1071
  283.     ProcA4
  284. ProcB4                            7         80         11
  285.     ProcA4
  286. }
  287.  
  288. Test profile-5.3 {profrep tests} {
  289.     profrep profData cpu prof.tmp "Profile Test 5.3"
  290.     GetProfRep prof.tmp
  291. } 0 {---------------------------------------------------------
  292. Profile Test 5.3
  293. ---------------------------------------------------------
  294. Procedure Call Stack          Calls  Real Time   CPU Time
  295. ---------------------------------------------------------
  296. ProcA4                            5       1250       1180
  297. ProcD4                            1        100       1071
  298.     ProcA4
  299. EatTime                           6       1070       1070
  300.     ProcD4
  301.     ProcA4
  302. ProcC4                            3       1000        101
  303.     ProcA4
  304. EatTime                           2       1001        100
  305.     ProcC4
  306.     ProcA4
  307. ProcB4                            7         80         11
  308.     ProcA4
  309. EatTime                           4        800         10
  310.     ProcB4
  311.     ProcA4
  312. }
  313.  
  314. unset foo
  315. rename unknown {}
  316.  
  317.  
  318.