Tcl Source Code

Artifact aa9e9d62151efb79733969e1811ec0cf92ea1287:

Attachment "regexp.tcl" to ticket [454273ffff] added by hemanglavana 2001-08-23 00:03:35.

---

#!/bin/sh
# regexp.tcl \
exec tclsh "$0" ${1+"$@"}

proc invoke_regexp {count} {
    if {$count > 5} {
        # This stmt is fine.
        regexp -- {constant-exp} "Will never match this"
    } else {
        # The dynamic _exp_ below causes memory leak.
        regexp -- [clock clicks] "Will never match this"
    } ;# End of if else stmt
} ;# End of proc invoke_regexp

proc log_mem_info {msg} {
      foreach line "[split [string trim [memory info]] \n]" {
          append log_msg [format %10s [lindex $line end]]
      }
      append log_msg "  " $msg

      # Print to stdout, only first 78chars to prevent line wrap
      puts stdout [string range $log_msg 0 78]
} ;# End of log_mem_info

proc main {argv} {
    puts stdout "Tcl version: [info patch]"
    puts stdout "=================="
    if {![string length [info command memory]]} {
        puts stderr "`memory' command not found --"
        puts stderr "This script can be invoked only if tcl is compiled with"
        puts stderr "TCL_MEM_DEBUG flag ... exiting!"
        exit 1
    } ;# End of if stmt

    puts stdout "   Total       Total   Current   Current   Maximum   Maximum"
    puts stdout "   Mallocs     Frees   Packets    Bytes    Packets    Bytes "
    puts stdout "   -------     -----   -------   -------   -------   -------"
    log_mem_info "Initial"

    # Default value of count is 10
    set count 10
    while {$count} {
        invoke_regexp $count
        log_mem_info "count $count"
        incr count -1
    } ;# End of while count loop 
} ;# End of proc main

main $argv