lib/systemtap.exp: rename hw_breakpoint_p to hwbkpt_probes_p

[systemtap.git] / testsuite / lib / systemtap.exp

load_lib site.exp
load_lib "compile_flags.exp"

proc installtest_p {} {
    global TOOL_OPTIONS
    if {[info exists TOOL_OPTIONS] && [string match "*install*" $TOOL_OPTIONS]} {
        return 1
    } else { return 0 }
}


proc grep_kallsyms { pattern } {
    if {! [catch {exec grep -q "$pattern" "/proc/kallsyms"} dummy]} {
	return 1
    }
    return 0
}


# Test for kernel built-in utrace (CONFIG_UTRACE).
# Only original rhel5/6-era utrace need apply.
proc utrace_orig_p {} {
    # We want utrace_attach (rhel5) or utrace_attach_task (rhel6), but don't
    # get confused by the private module version of any active stap module.
    return [grep_kallsyms "T utrace_attach"]
}


# Test for tracepoint-based utrace, or rather the in-kernel
# facilities which enable our emulation of utrace.
proc utrace_emu_p {} {
    # Check for the set of 5 tracepoints we need and task_work_add()
    # (see runtime/autoconf-utrace-via-tracepoints.c for details).
    return [expr [grep_kallsyms task_work_add]                  \
              && [grep_kallsyms tracepoint_sched_process_fork]  \
              && [grep_kallsyms tracepoint_sched_process_exec]  \
              && [grep_kallsyms tracepoint_sched_process_exit]  \
              && [grep_kallsyms tracepoint_sys_enter]           \
              && [grep_kallsyms tracepoint_sys_exit]            \
           ]
}


# Test for utrace - any flavor will do...
proc utrace_p {} {
    return [expr [utrace_orig_p] || [utrace_emu_p] ]
}


proc classic_uprobes_p {} {
    # If this is a utrace kernel, then we can use our version of uprobes.
    # No need to build it now, stap will handle that itself.
    #
    # Although ia64 has classical utrace, uprobes hasn't been
    # ported there (PR7081).
    return [expr [utrace_orig_p] && ! [istarget ia64-*-*] ]
}

proc inode_uprobes_p {} {
    # inode-uprobes (or unlikely compiled-in classical uprobes?)
    #
    # Note we're looking for " uprobe_register" to avoid finding
    # 'kallsyms_uprobe_register' from a loaded systemtap module.
    return [expr ([grep_kallsyms register_uprobe]        \
                  || [grep_kallsyms " uprobe_register"]) \
              && ! [classic_uprobes_p]                   \
           ]
}


proc uprobes_p {} {
    return [expr [classic_uprobes_p] || [inode_uprobes_p] ]
}


proc classic_uretprobes_p {} {
    # Classic uprobes always has uretprobes
    return [classic_uprobes_p]
}

proc inode_uretprobes_p {} {
    # inode-uprobes, now with return probes!  Looking for any mention of
    # uretprobe, notably arch_uretprobe_hijack_return_addr
    return [expr [inode_uprobes_p] && [grep_kallsyms uretprobe] ]
}

proc uretprobes_p {} {
    return [expr [classic_uretprobes_p] || [inode_uretprobes_p] ]
}

proc plt_probes_p {} {
    # .plt probes need uprobes and a supported arch (x86 and arm)
    return [expr [uprobes_p] \
	    && [regexp "^(x86_64|i.86|arm.*)$" $::tcl_platform(machine)] ]
}

proc perf_probes_p {} {
    # perf probes need and exported perf_event_create_kernel_counter
    return [grep_kallsyms perf_event_create_kernel_counter]
}

proc hwbkpt_probes_p {} {
   global have_hw_breakpoint_p
   return $have_hw_breakpoint_p
}

proc dyninst_p {} {
    global systemtap_dyninst_p
    return $systemtap_dyninst_p
}

proc nss_p {} {
    global systemtap_nss_p
    return $systemtap_nss_p
}

proc java_p {} {
    global systemtap_java_p
    return $systemtap_java_p
}

proc get_runtime_list {} {
    # Always return the default runtime.
    set runtime_list [list ""]

    if {[dyninst_p]} {
	lappend runtime_list "dyninst"
    }
    return $runtime_list
}


proc print_systemtap_version {} {
    set version [exec /bin/uname -r]
    set location "/boot/vmlinux-$version"
    if {! [file exists $location]} {
	# try the debuginfo location
	set location "/usr/lib/debug/lib/modules/$version/vmlinux"
	if {! [file exists $location]} { set location "" }
    }

    print "kernel location: $location"
    print "kernel version: $version"

    set location [exec /usr/bin/which stap]
    regexp {version [^)]*} [exec stap -V 2>@ stdout] version

    print "systemtap location: $location"
    print "systemtap version: $version"

    set location [exec /usr/bin/which gcc]
    set version [exec gcc --version | head -1]

    print "gcc location: $location"
    print "gcc version: $version"
}


proc setup_systemtap_environment {} {
    global srcdir env server_pid logfile systemtap_dyninst_p
    global systemtap_nss_p systemtap_java_p
    global have_hw_breakpoint_p
    global kill_needs_doubledash

    # need an absolute SRCDIR for the top-level src/ tree
    # XXX: or, we could change nearby uses of ${SRCDIR}/testsuite to ${SRCDIR}
    set env(SRCDIR) [fullpath $srcdir/..]

    # pretend to be a dumb terminal so that coloring is always turned off
    # otherwise, we will have problems with expect
    set env(TERM) dumb

    # Use a local systemtap directory and cache.  Add user name so
    # make check and sudo make check don't clobber each other.
    set env(SYSTEMTAP_DIR) [pwd]/.systemtap-[exec whoami]
    exec mkdir -p $env(SYSTEMTAP_DIR)

    # Start with fresh server certificates
    exec rm -fr $env(SYSTEMTAP_DIR)/ssl

    # Remove the rc file
    exec rm -f $env(SYSTEMTAP_DIR)/rc

    # All hail the prophet lockdep
    set chan [open $env(SYSTEMTAP_DIR)/rc w]
    puts $chan "--rlimit-cpu=300"
    close $chan

    # Erase the old server log file.
    set logfile "[pwd]/server.log"
    if {[file exists $logfile]} then {
	exec rm -f $logfile;
    }
    # Create a new one and make sure it's world writable.
    exec touch $logfile
    exec chmod 666 $logfile

    # Zap any previous uprobes, if any
    catch { exec /sbin/rmmod uprobes }

    # No compile-server started yet.
    set server_pid 0

    # If the environment variable ARCH exists, this can throw off our
    # custom module building (when set to the wrong value). To be
    # safe, remove it.
    if [info exists env(ARCH)] {
	verbose -log "clearing env ARCH (was $env(ARCH))"
	unset env(ARCH)
    }

    # PATH, SYSTEMTAP_TAPSET, SYSTEMTAP_RUNTIME, LD_LIBRARY_PATH are already set.
    foreach var {PATH STAP SRCDIR SYSTEMTAP_TAPSET SYSTEMTAP_RUNTIME SYSTEMTAP_DIR LD_LIBRARY_PATH} {
        if [info exists env($var)] {
            verbose -log "env $var = $env($var)"
        }
    }

    # Remember if this very version of systemtap compiled with dyninst support
    if {! [catch {exec sh -c "stap -V 2>&1 | grep -q DYNINST"} dummy]} {
	set systemtap_dyninst_p 1
    } else {
        set systemtap_dyninst_p 0
    }

    # Remember if this selfsame version of systemtap compiled with nss support
    if {! [catch {exec sh -c "stap -V 2>&1 | grep -q NSS"} dummy]} {
        set systemtap_nss_p 1
    } else {
        set systemtap_nss_p 0
    }

    # Remember if this selfsame version of systemtap compiled with java support
    if {! [catch {exec sh -c "stap -V 2>&1 | grep -q JAVA"} dummy]} {
        set systemtap_java_p 1
    } else {
        set systemtap_java_p 0
    }

    # Remember if this selfsame version of systemtap supports HW breakpoints
    if {! [catch {exec stap -l {kernel.data(0x123).rw}}]} {
        set have_hw_breakpoint_p 1
    } else {
        set have_hw_breakpoint_p 0
    }

    # There are some kill executables that had issues with -SIG -PID, thinking
    # that the -PID was an option (procps-ng v3.3.2 and v3.3.3) and thus require
    # a -- before -PID. So check for those, otherwise, just assume that no -- is
    # needed.
    if {![catch {exec kill --version 2>@1} killver]} {
      if {[string match "*procps-ng 3.3.\[23\]" $killver]} {
         set kill_needs_doubledash 1
      } else {
         # any other procps versions support the standard convention
         # and anything not procps (e.g. util-linux) supports both
         set kill_needs_doubledash 0
      }
    } else {
      # kill doesn't support --version (e.g. busybox), just assume standard
      # convention
      set kill_needs_doubledash 0
    }

    return 1
}

# Set up the environment so that tests will be performed using the systemtap
# client and server.
proc setup_server { args } {
    global srcdir env installed_stap logfile use_server server_spec avahi_ok_p

    # Start the server
    if {! [start_server $args]} then {
	return 0
    }

    # Make sure that stap can find the server.
    exec sleep 1
    set use_server --use-server
    set res [catch { exec stap --list-servers=online,trusted,compatible >& stap-list-servers.out } looksee]
    verbose -log "stap --list-servers returned: res==$res"
    verbose -log $looksee[exec cat stap-list-servers.out]
    set listRes [catch { exec grep "^ host" stap-list-servers.out } looksee]
    verbose -log "grep for servers returned: res==$res\n$looksee"

    # Try to discover the port the server is listening on from the server log.
    # We're matching a line of the form:
    # "Thu Jul 25 11:58:11 2013: Using network address <addr>:37804"
    set res [catch { exec /bin/cat $logfile | awk "/Using network address/ {print \$9}" } server_address]
    send_log "server_address=='$server_address'\n"
    if {$res != 0} then {
	verbose -log "Unable to discover the address used by the systemtap server"
	shutdown_server
	return 0
    }
    set res [regsub ".*:(\[0-9\]\[0-9\]*)\$" $server_address {\1} server_port]
    send_log "server_port=='$server_port'\n"
    if {$res != 1} then {
	verbose -log "Unable to discover the port used by the systemtap server"
	shutdown_server
	return 0
    }
    set server_spec [info hostname]:$server_port
    send_log "server_spec=='$server_spec'\n"

    set avahi_ok_p 1
    if {$listRes != 0} then {
	verbose -log "Unable to automatically find the systemtap server -- check firewall settings for mDNS"
	set avahi_ok_p 0
	verbose -log "Client/Server tests will be run by contacting the server directly as $server_spec"

	# Make sure stap can contact the server directly
	set use_server --use-server=$server_spec
	set res [catch {exec stap $use_server -p2 -e {probe begin {exit()}}} looksee]
	if {$res != 0} then {
	    verbose -log "Unable to contact the server at $server_spec directly"
	    shutdown_server
	    return 0
	}
    }

    return 1
}

proc start_server { options } {
    global srcdir env server_pid installed_stap logfile

    if {! [nss_p]} { return 0 }

    # Server management scripts and data are installed if this is an
    # install test, otherwise there is some setup to do.
    # Make sure the server management scripts and tools are on the $PATH.
    if {! [installtest_p]} then {
	set env(PATH) "$srcdir/..:[pwd]/..:$env(PATH)"
        set installed_stap "[pwd]/../stap"
	set env(SYSTEMTAP_SERVER_SCRIPTS) "$srcdir/.."
    } else {
	set env(PATH) "$env(PKGLIBDIR):$env(PATH)"
        set installed_stap "$env(SYSTEMTAP_PATH)/stap"
	set env(SYSTEMTAP_SERVER_SCRIPTS) $env(PKGLIBDIR)
    }

    # Try to start the server.
    set status 0
    if {[catch {eval {exec env STAP_PR11197_OVERRIDE=1 \
		    env SYSTEMTAP_STAP=[exec which stap] stap-start-server \
		    --log=$logfile} $options} server_pid]} {
	if {[lindex $::errorCode 0] eq "CHILDSTATUS"} {
	    set status [lindex $::errorCode 2]
	}
    }
    verbose -log "output: $server_pid"
    if { "$server_pid" == "" || $status != 0 } then {
	verbose -log "Cannot start a systemtap server"
	set server_pid 0
	return 0
    } else {
	verbose -log "Started a systemtap server as PID==$server_pid"
    }

    return 1
}

proc shutdown_server {} {
    global server_pid
    if { $server_pid != 0 } then {
	verbose -log "Stopping the systemtap server with PID==$server_pid"
	catch {exec stap-stop-server $server_pid}
	set server_pid 0
    }

    foreach module [glob -nocomplain [pwd]/stap_*.ko] {
	exec /bin/rm -f $module
    }
    foreach sig [glob -nocomplain [pwd]/stap_*.ko.sgn] {
	exec /bin/rm -f $sig
    }
}


proc normalize_arch { arch } {
    if {$arch == "ppc64"} then {return "powerpc"}
    if {$arch == "s390x"} then {return "s390"}
    if {$arch == "i686"} then {return "i386"}
    if {$arch == "armv5tel"} then {return "arm"}
    if {$arch == "armv7l"} then {return "arm"}
    if {$arch == "armv7lh"} then {return "arm"}
    if {$arch == "aarch64"} then {return "arm64"}
    return $arch
}

proc fullpath { path } {
    if {[string index $path 0] != "/"} then {
        # relative paths are anchored to the current directory
        return [pwd]/$path
    } else {
        return $path
    }
}

proc get_system_info {} {
    global Host Snapshot Distro GCC_Version GCC_FullVersion ELF_Version env SElinux

    set Host [exec /bin/uname -a]
    if [file exists ../SNAPSHOT] {
	set Snapshot [exec /bin/cat ../SNAPSHOT]
    } elseif [file exists $env(SRCDIR)/../SNAPSHOT] {
	set Snapshot [exec /bin/cat $env(SRCDIR)/../SNAPSHOT]
    } else {
        regexp {version [^)]*} [exec stap -V 2>@ stdout] version
        set Snapshot $version
    }
    set Distro "Linux"
    if [file exists /usr/bin/lsb_release] {
        # this produces one line of this format:
        # Distribution:\tSTRING
        set Distro [lrange [exec /usr/bin/lsb_release -d] 1 end]
    } else {
        foreach f {/etc/fedora-release /etc/enterprise-release /etc/redhat-release /etc/suse-release /etc/debian_version} {
            if [file exists $f] then {set Distro [exec /bin/cat $f]; break }
        }
    }
    # Easily parsable version first major minor patch level
    set n [exec echo "__GNUC__ __GNUC_MINOR__ __GNUC_PATCHLEVEL__" | cpp -P]
    set n [string map {" " "."} $n]
    set n [string map {"\n" ""} $n]
    set GCC_Version "$n"
    # Plus full version between square brackets for GCC_FullVersion
    set full [exec gcc --version | head -1]
    set GCC_FullVersion "$n \[$full\]"
    # Parse elfutils version stap was compiled with
    regexp {version [^/]*/([^,]*)} [exec stap -V 2>@ stdout] all ELF_Version
    # selinux status
    if [file exists /usr/sbin/getenforce] {
        set SElinux [exec /usr/sbin/getenforce]
    } else {
        set SElinux "unknown"
    }
}

if {! [setup_systemtap_environment]} then {
    cleanup
    exit 1
}

print_systemtap_version
get_system_info

# PR11798: die if kernel-devel is not sufficient to build any modules
if {[catch {exec stap -p4 -e {probe begin {exit()}}} result]} {
    puts "\n\n\n**** failed systemtap kernel-devel smoke test:\n"
    puts $result
#    puts "****\n"
#    puts $options
    puts "\n**** aborting testing.\n"
    cleanup
    exit 1
}

# PR11798: die also if kernel-debuginfo is not available
# NB: if one introduced a [kernel_debuginfo_p] proc like the
# ones for uprobes/utrace above, and sprinkled it throughout,
# then this wouldn't have to be a failing condition.
# Note the --skip-badvars -w, we just care there is some debuginfo,
# it is allowed have bad var location descriptors (which will cause
# some tests to fail of course). Just test -p2, kernel-devel smoke
# test above does a full module build, we don't need another one.
if {[catch {exec stap --skip-badvars -w -p2 -e {probe syscall.open {println (argstr)}}} result]} {
    puts "\n\n\n**** failed systemtap kernel-debuginfo smoke test:\n"
    puts $result
#    puts "****\n"
#    puts $options
    puts "\n**** aborting testing.\n"
    cleanup
    exit 1
}

# Make more likely that all development packages for the supported ABIs (-m64 -m32/-m31)
# are installed by building a quick hello.c and hello.cxx program with both.
set source "hello.c"
set hello_file [open $source "w"]
puts $hello_file "#include <stdio.h>"
puts $hello_file "int main () { printf(\"Hello World!\"); return 0; }"
close $hello_file
for {set i 0} {$i < [arch_compile_flags]} {incr i} {
  set flags "additional_flags=-g compiler=gcc [arch_compile_flag $i]"
  set exe "hello-[arch_compile_flag_name $i]"
  set result [target_compile $source $exe executable $flags]
  if { $result != "" } {
    puts "\n\n\n**** failed gcc [arch_compile_flag_name $i] smoke test:\n"
    puts $result
    puts "Please install libgcc and glibc development packages for [arch_compile_flag_name $i]\n"
  }
}
set source "hello.cxx"
set hello_file [open $source "w"]
puts $hello_file "#include <iostream>"
puts $hello_file "using namespace std;"
puts $hello_file "int main () { cout << \"Hello World!\" << endl; return 0; }"
close $hello_file
for {set i 0} {$i < [arch_compile_flags]} {incr i} {
  set flags "additional_flags=-g compiler=g++ [arch_compile_flag $i]"
  set exe "hello-[arch_compile_flag_name $i]"
  set result [target_compile $source $exe executable $flags]
  if { $result != "" } {
    puts "\n\n\n**** failed g++ [arch_compile_flag_name $i] smoke test:\n"
    puts $result
    puts "Please install libstdc++-devel package for [arch_compile_flag_name $i]\n"
  }
}
catch { eval [list exec rm -f] [glob "hello.c*" "hello-*"] }

proc systemtap_init {args} {}
proc systemtap_version {} {}

proc cleanup {} {
    # Stop the stap server, if we started it.
    shutdown_server
}


proc stap_run_batch {filename args} {
    verbose -log "starting $filename $args"

    # Many of our test cases use "#! stap ...".  Since these lack
    # /full/paths, they are not really executable.  (We can't have
    # /full/paths because the choice of systemtap interpreter is set
    # at "make check" time.)

    # So we cheat.  If the file begins with "#! stap", we will spawn
    # stap manually here (relying on $PATH).  Otherwise, we presume
    # the file properly executable.

    set file [open $filename r]
    set firstbits [gets $file]
    close $file
    if [regexp -line {\#! stap (.*)} $firstbits -> stap_args] {
        verbose -log "spawn1 stap $stap_args $filename $args"
        # Make sure we don't accidentially add an extra empty argument.
        if {$args == ""} {
            spawn stap $stap_args $filename
        } else {
            spawn stap $stap_args $filename $args
        }
    } else {
        verbose -log "spawn2 $filename $args"
        # Make sure we don't accidentially add an extra empty argument.
        if {$args == ""} {
            spawn $filename
        } else {
            spawn $filename $args
        }
    }

    expect {
	-timeout -1
        -re {[^\r]*\r} { verbose -log $expect_out(0,string); exp_continue }
        eof { }
    }
    set results [wait]
    verbose -log "wait results: $results"
    if {[llength $results] >= 5} {
	# Unexpected output. stap must have crashed
	return -1
    } else {
	return [lindex $results 3]
    }
}

proc as_root { command } {
    set effective_uid [exec /usr/bin/id -u]

    if {$effective_uid != 0} {
	set command "sudo $command"
    }
    verbose -log "as_root $command"
    set res [catch {eval exec $command} value]
    verbose -log "OUT $value"
    verbose -log "RC $res"
    return  $res
}

proc as_non_root { command } {
    set effective_uid [exec /usr/bin/id -u]

    if {$effective_uid == 0} {
	# If logname fails (which it can if we're not in a login
	# shell) or if we're root, use user 'nobody'.
	#
	# Note that user 'nobody' can't use systemtap to load kernel
	# modules, since he isn't a member of the stapusr/stapdev
	# groups. But, 'nobody' can use systemtap to compile a kernel
	# module.
	set logname "root"
	if {[catch {exec /usr/bin/logname} logname] || $logname == "root"} {
	    set logname "nobody"
	}

	# User 'nobody' doesn't have a home directory, which means we
	# can't create ~nobody/.systemtap. So, temporarily override
	# SYSTEMTAP_DIR.
	if {$logname == "nobody"} {
	    set stap_dir "/tmp/.systemtap-nobody"
	    set command "su -s /bin/sh $logname -c \"SYSTEMTAP_DIR=$stap_dir $command\""
	} else {
	    set command "su -s /bin/sh $logname -c \"$command\""
	}
    }
    verbose -log "as_non_root $command"
    set res [catch {eval exec $command} value]
    if {$effective_uid == 0 && $logname == "nobody"} {
	# If we created a SYSTEMTAP_DIR for user 'nobody' above, we
	# can now remove it.
	catch {exec rm -rf $stap_dir}
    }
    verbose -log "OUT $value"
    verbose -log "RC $res"
    return  $res
}

proc sdt_includes {} {
  global srcdir env

  # The wrapper sys/sdt.h for testing STAP_SDT_V[12] is here.
  set dirs [list $srcdir]

  if {[installtest_p]} {
    # Use the installed <sys/sdt.h>.
    lappend dirs $env(SYSTEMTAP_INCLUDES)
  } else {
    # Find <sys/sdt.h> in the source tree.
    lappend dirs $srcdir/../includes
    # The uninstalled, configured sdt-config.h has to be found here.
    lappend dirs ../includes/sys
  }

  set flags ""
  foreach dir $dirs {
      set flags "$flags additional_flags=-isystem${dir}"
  }

  return $flags
}

proc stripped_p { EXE } {
    if { [catch {eval exec "file $EXE | grep -q \"not stripped\""} dummy] } {
	return 1
    }
    return 0
}

proc prelink_p {} {
  global prelink_bin
  set prelink_bin "/usr/sbin/prelink"
  return [file exists "$prelink_bin"]
}

# Run prelink via a temp file, so it can succeed even when running from an nfs
# $HOME, for instance.  Otherwise, prelink complains that it can't restore context.
proc prelink { FILE ADDR } {
  global prelink_bin
  if {![prelink_p]} {
    verbose -log "Prelink is not found on this system"
    return 0
  }
  if {[catch {exec mktemp -t staptestXXXXXX} tmpfile]} {
    verbose -log "Failed to create prelink temporary file: $tmpfile"
    return 0
  }
  if {[catch {exec cp -a "$FILE" "$tmpfile"} result]} {
    verbose -log "Failed to copy file for prelink: $result"
    catch {exec rm -rf "$tmpfile"}
    return 0
  }
  set prelink_cmd [concat "$prelink_bin" -vfNR -r "$ADDR" "$tmpfile"]
  send_log "Executing: $prelink_cmd\n"
  if {[catch {eval exec $prelink_cmd} result]} {
    verbose -log "Prelink failed: $result"
    catch {exec rm -rf "$tmpfile"}
    return 0
  }
  if {[catch {exec mv "$tmpfile" "$FILE"} result]} {
    verbose -log "Failed to move prelinked file back: $result"
    catch {exec rm -rf "$tmpfile"}
    return 0
  }
  return 1
}

# Send signal SIG to PID. If KILL_TIMEOUT > 0, waits KILL_TIMEOUT seconds before
# also sending a SIGKILL signal to PID. SIG can be with or without leading '-'.
proc kill { SIG PID {KILL_TIMEOUT 0} } {
   global kill_needs_doubledash

   if {$kill_needs_doubledash} {
      set PID "-- $PID"
   }
   if {![string match -* $SIG]} {
      set SIG "-$SIG"
   }

   verbose -log "Executing: kill $SIG $PID"
   catch {eval exec kill $SIG $PID}

   if {$KILL_TIMEOUT > 0} {
      while {$KILL_TIMEOUT > 0} {
         if {![file isdirectory /proc/$PID]} {
            return
         }
         sleep 1
         incr KILL_TIMEOUT -1
      }
      verbose -log "Executing: kill -KILL $PID"
      catch {eval exec kill -KILL $PID}
   }
}

# Compares vers1 to vers2. Returns an integer less than, equal to, or greater
# than zero if vers1 is before, equal, or after vers2. Similar to the GNU
# extension strverscmp(3), but restricted to simple M.N... version numbers.
proc strverscmp { vers1 vers2 } {

   # Check that both versions are valid M.N... format
   if {![regexp {^[0-9]+(\.[0-9]+)*$} $vers1]} {
      error "$vers1 is not a valid version number"
   }
   if {![regexp {^[0-9]+(\.[0-9]+)*$} $vers2]} {
      error "$vers2 is not a valid version number"
   }

   while {1} {

      # Get the next M for each as well as following N...
      regexp {^([0-9]+)(\.(.*))?} $vers1 dummy subvers1 dummy nextvers1
      regexp {^([0-9]+)(\.(.*))?} $vers2 dummy subvers2 dummy nextvers2

      # Compare M
      if {$subvers1 < $subvers2} { return -1 }
      if {$subvers1 > $subvers2} { return  1 }
      # The M parts are equal

      # Check if one (or both) of them don't have a next subversion
      if {![string length $nextvers1] \
       && ![string length $nextvers2]} { return  0 }
      if {![string length $nextvers1] \
       && [string length $nextvers2]}  { return -1 }
      if {[string length $nextvers1] \
       && ![string length $nextvers2]} { return  1 }

      # They both have a subversion following, let's re-iterate

      # Sanity check that we're making progress and not looping forever
      if {[string length $nextvers1] >= [string length $vers1]} \
         { error "$vers1 not converging" }
      if {[string length $nextvers2] >= [string length $vers2]} \
         { error "$vers2 not converging" }

      set vers1 $nextvers1
      set vers2 $nextvers2
   }
}