Updated to platform 1.0.10. Added handling of the DEB_HOST_MULTIARCH location change for libc

3 files changed, 68 insertions, 27 deletions

diff --git a/ChangeLog b/ChangeLog
index d78c64e..b12db49 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2011-06-22  Andreas Kupries  <andreask@activestate.com>
+
+	* library/platform/pkgIndex.tcl: Updated to platform 1.0.10. Added
+	* library/platform/platform.tcl: handling of the DEB_HOST_MULTIARCH
+	location change for libc.
+
 2011-05-07  Miguel Sofer  <msofer@users.sf.net>
 
 	* generic/tclInt.h: fix USE_TCLALLOC so that it can be enabled
diff --git a/library/platform/pkgIndex.tcl b/library/platform/pkgIndex.tcl
index 35da3b7..220a67b 100644
--- a/library/platform/pkgIndex.tcl
+++ b/library/platform/pkgIndex.tcl
@@ -1,3 +1,3 @@
-package ifneeded platform        1.0.9 [list source [file join $dir platform.tcl]]
+package ifneeded platform        1.0.10 [list source [file join $dir platform.tcl]]
 package ifneeded platform::shell 1.1.4 [list source [file join $dir shell.tcl]]
 
diff --git a/library/platform/platform.tcl b/library/platform/platform.tcl
index 572a8b4..dd2e66b 100644
--- a/library/platform/platform.tcl
+++ b/library/platform/platform.tcl
@@ -194,42 +194,45 @@ proc ::platform::identify {} {
 	    # Do not look into /lib64 even if present, if the cpu
 	    # doesn't fit.
 
+	    # TODO: Determine the prefixes (i386, x86_64, ...) for
+	    # other cpus.  The path after the generic one is utterly
+	    # specific to intel right now.  Ok, on Ubuntu, possibly
+	    # other Debian systems we may apparently be able to query
+	    # the necessary CPU code. If we can't we simply use the
+	    # hardwired fallback.
+
 	    switch -exact -- $tcl_platform(wordSize) {
 		4 {
-		    set base /lib
+		    lappend bases /lib
+		    if {[catch {
+			exec dpkg-architecture -qDEB_HOST_MULTIARCH
+		    } res]} {
+			lappend bases /lib/i386-linux-gnu
+		    } else {
+			# dpkg-arch returns the full tripled, not just cpu.
+			lappend bases /lib/$res
+		    }
 		}
 		8 {
-		    set base /lib64
+		    lappend bases /lib64
+		    if {[catch {
+			exec dpkg-architecture -qDEB_HOST_MULTIARCH
+		    } res]} {
+			lappend bases /lib/x86_64-linux-gnu
+		    } else {
+			# dpkg-arch returns the full tripled, not just cpu.
+			lappend bases /lib/$res
+		    }
 		}
 		default {
 		    return -code error "Bad wordSize $tcl_platform(wordSize), expected 4 or 8"
 		}
 	    }
 
-	    set libclist [lsort [glob -nocomplain -directory $base libc*]]
-	    if {[llength $libclist]} {
-		set libc [lindex $libclist 0]
-
-		# Try executing the library first. This should suceed
-		# for a glibc library, and return the version
-		# information.
-
-		if {![catch {
-		    set vdata [lindex [split [exec $libc] \n] 0]
-		}]} {
-		    regexp {([0-9]+(\.[0-9]+)*)} $vdata -> v
-		    foreach {major minor} [split $v .] break
-		    set v glibc${major}.${minor}
-		} else {
-		    # We had trouble executing the library. We are now
-		    # inspecting its name to determine the version
-		    # number. This code by Larry McVoy.
-
-		    if {[regexp -- {libc-([0-9]+)\.([0-9]+)} $libc -> major minor]} {
-			set v glibc${major}.${minor}
-		    }
-		}
+	    foreach base $bases {
+		if {[LibcVersion $base -> v]} break
 	    }
+
 	    append plat -$v
 	    return "${plat}-${cpu}"
 	}
@@ -238,6 +241,38 @@ proc ::platform::identify {} {
     return $id
 }
 
+proc ::platform::LibcVersion {base _->_ vv} {
+    upvar 1 $vv v
+    set libclist [lsort [glob -nocomplain -directory $base libc*]]
+
+    if {![llength $libclist]} { return 0 }
+
+    set libc [lindex $libclist 0]
+
+    # Try executing the library first. This should suceed
+    # for a glibc library, and return the version
+    # information.
+
+    if {![catch {
+	set vdata [lindex [split [exec $libc] \n] 0]
+    }]} {
+	regexp {([0-9]+(\.[0-9]+)*)} $vdata -> v
+	foreach {major minor} [split $v .] break
+	set v glibc${major}.${minor}
+	return 1
+    } else {
+	# We had trouble executing the library. We are now
+	# inspecting its name to determine the version
+	# number. This code by Larry McVoy.
+
+	if {[regexp -- {libc-([0-9]+)\.([0-9]+)} $libc -> major minor]} {
+	    set v glibc${major}.${minor}
+	    return 1
+	}
+    }
+    return 0
+}
+
 # -- platform::patterns
 #
 # Given an exact platform identifier, i.e. _not_ the generic
@@ -333,7 +368,7 @@ proc ::platform::patterns {id} {
 # ### ### ### ######### ######### #########
 ## Ready
 
-package provide platform 1.0.9
+package provide platform 1.0.10
 
 # ### ### ### ######### ######### #########
 ## Demo application