Ticket #11759: case_fixes.diff

src/port/port.tcl

@@ -209 +209 @@
 proc registry_installed {portname {portversion ""}} {
     set ilist [registry::installed $portname $portversion]
     if { [llength $ilist] > 1 } {
+        # set portname again since the one we were passed may not have had the correct case
+        set portname [lindex [lindex $ilist 0] 0]
         puts "The following versions of $portname are currently installed:"
         foreach i [portlist_sortint $ilist] { 
             set iname [lindex $i 0]
@@ -1468 +1470 @@
             ui_debug "$errorInfo"
             break_softcontinue "port location failed: $result" 1 status
         } else {
+            # set portname again since the one we were passed may not have had the correct case
+            set portname [lindex $ilist 0]
             set version [lindex $ilist 1]
             set revision [lindex $ilist 2]
             set variants [lindex $ilist 3]
@@ -1652 +1656 @@
             global errorInfo
             ui_debug "$errorInfo"
             break_softcontinue "$result" 1 status
+        } else {
+            # set portname again since the one we were passed may not have had the correct case
+            set portname [lindex [lindex $ilist 0] 0]
         }
         
         set deplist [registry::list_dependents $portname]
@@ -1882 +1889 @@
         return 1
     }
     foreachport $portlist {
+        if { ![catch {set ilist [registry::installed $portname]} result] } {
+            # set portname again since the one we were passed may not have had the correct case
+            set portname [lindex [lindex $ilist 0] 0]
+        }
         set files [registry::port_registered $portname]
         if { $files != 0 } {
             if { [llength $files] > 0 } {
@@ -1920 +1931 @@
 
         array unset portinfo
         array set portinfo [lindex $result 1]
+        # set portname again since the one we were passed may not have had the correct case
+        set portname $portinfo(name)
 
         set depstypes {depends_build depends_lib depends_run}
         set depstypes_descr {"build" "library" "runtime"}
@@ -1968 +1981 @@
     
         array unset portinfo
         array set portinfo [lindex $result 1]
+        # set portname again since the one we were passed may not have had the correct case
+        set portname $portinfo(name)
         set porturl $portinfo(porturl)
         set portdir $portinfo(portdir)
 

src/registry1.0/portuninstall.tcl

@@ -44 +44 @@
 
         set ilist [registry::installed $portname $v]
         if { [llength $ilist] > 1 } {
+            set portname [lindex [lindex $ilist 0] 0]
                 ui_msg "$UI_PREFIX [msgcat::mc "The following versions of $portname are currently installed:"]"
                 foreach i $ilist { 
                         set iname [lindex $i 0]
@@ -59 +60 @@
                 }
                 return -code error "Registry error: Please specify the full version as recorded in the port registry."
         } else {
+            # set portname again since the one we were passed may not have had the correct case
+            set portname [lindex [lindex $ilist 0] 0]
                 set version [lindex [lindex $ilist 0] 1]
                 set revision [lindex [lindex $ilist 0] 2]
                 set variants [lindex [lindex $ilist 0] 3]

src/registry1.0/receipt_flat.tcl

@@ -426 +426 @@
                 }
                 # [PG] Huh?
         } else {
+            # We want to be case-insensitive but case-preserving, so the name gets
+            # returned with the correct case even if it's wrong when given. To get the
+            # correct case on a case-insensitive FS, we have to list the directory and
+            # compare against each entry.
+            set name_path [file join ${query_path} *]
+            set name_entries [glob -nocomplain -types d ${name_path}]
+            foreach entry $name_entries {
+                set basename [file tail $entry]
+                if {[string equal -nocase $basename $name]} {
+                    set name $basename
+                    break
+                }
+            }
                 set query_path [file join ${query_path} ${name}]
                 if { $version != "" } {
                         set query_path [file join ${query_path} ${version}]

src/registry1.0/portimage.tcl

@@ -79 +79 @@
                 set force 0
         }
 
-        if {$v != ""} {
-                ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s @%s"] $name $v]"
-        } else {
-                ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s"] $name]"
-        }
-
         set ilist [_check_registry $name $v]
+        # set name again since the one we were passed may not have had the correct case
+        set name [lindex $ilist 0]
         set version [lindex $ilist 1]
         set revision [lindex $ilist 2]
         set     variants [lindex $ilist 3]
+        
+    if {$v != ""} {
+        ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s @%s"] $name $v]"
+    } else {
+        ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s"] $name]"
+    }
 
         set ilist [registry::installed $name]
         if { [llength $ilist] > 1 } {
@@ -146 +148 @@
                 set force 0
         }
 
-        if {$v != ""} {
-                ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s @%s"] $name $v]"
-        } else {
-                ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s"] $name]"
-        }
-
         set ilist [registry::active $name]
         if { [llength $ilist] > 1 } {
                 return -code error "Registry error: Please specify the name of the port."
         } else {
                 set ilist [lindex $ilist 0]
         }
+        # set name again since the one we were passed may not have had the correct case
+        set name [lindex $ilist 0]
         set version [lindex $ilist 1]
         set revision [lindex $ilist 2]
         set     variants [lindex $ilist 3]
         set fqversion ${version}_${revision}${variants}
         
+    if {$v != ""} {
+        ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s @%s"] $name $v]"
+    } else {
+        ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s"] $name]"
+    }
+        
         if { $v != "" && ![string equal ${fqversion} $v] } {
                 return -code error "Active version of $name is not $v but ${fqversion}."
         }
@@ -217 +221 @@
         set ilist [registry::installed $name $v]
         if { [string equal $v ""] } {
                 if { [llength $ilist] > 1 } {
+                    # set name again since the one we were passed may not have had the correct case
+                    set name [lindex [lindex $ilist 0] 0]
                         ui_msg "$UI_PREFIX [msgcat::mc "The following versions of $name are currently installed:"]"
                         foreach i $ilist { 
                                 set iname [lindex $i 0]

src/macports1.0/macports.tcl

@@ -1893 +1893 @@
     }
     # fill array with information
     array set portinfo [lindex $result 1]
+    # set portname again since the one we were passed may not have had the correct case
+    set portname $portinfo(name)
 
     # set version_in_tree and revision_in_tree
     if {![info exists portinfo(version)]} {
@@ -1951 +1953 @@
         # XXX  this sets $version_installed to $version_in_tree even if not installed!!
         set version_installed $version_in_tree
         set revision_installed $revision_in_tree
+        set iname $portname
         # That was a very dirty hack showing how ugly our depencendy and upgrade code is.
         # To get it working when user provides -f, we also need to set the variant to
         # avoid a future failure.
@@ -1968 +1971 @@
                     [rpm-vercomp $version $version_installed] > 0
                     || ([rpm-vercomp $version $version_installed] == 0
                         && [rpm-vercomp $revision $revision_installed] > 0)} {
+                set iname [lindex $i 0]
                 set version_installed $version
                 set revision_installed $revision
                 set variant_installed $variant
-                set epoch_installed [registry::property_retrieve [registry::open_entry $portname [lindex $i 1] [lindex $i 2] $variant] epoch]
+                set epoch_installed [registry::property_retrieve [registry::open_entry $iname [lindex $i 1] [lindex $i 2] $variant] epoch]
                 set num $i
             }
 
             set isactive [lindex $i 4]
             if {$isactive == 1} {
                 set anyactive yes
+                set active_name [lindex $i 0]
                 set version_active $version
                 set revision_active $revision
                 set variant_active $variant
@@ -1987 +1992 @@
                             || [rpm-vercomp $revision_installed $revision_active] != 0
                             || [string compare $variant_installed $variant_active] != 0)} {
             # deactivate version
-            if {[catch {portimage::deactivate $portname ${version_active}_${revision_active}${variant_active} $optionslist} result]} {
+            if {[catch {portimage::deactivate $active_name ${version_active}_${revision_active}${variant_active} $optionslist} result]} {
                 global errorInfo
                 ui_debug "$errorInfo"
-                ui_error "Deactivating $portname @${version_active}_${revision_active} failed: $result"
+                ui_error "Deactivating $active_name @${version_active}_${revision_active} failed: $result"
                 return 1
             }
         }
         if { [lindex $num 4] == 0 && 0 == [string compare "image" ${macports::registry.installtype}] } {
             # activate the latest installed version
-            if {[catch {portimage::activate $portname ${version_installed}_${revision_installed}$variant $optionslist} result]} {
+            if {[catch {portimage::activate $iname ${version_installed}_${revision_installed}$variant $optionslist} result]} {
                 global errorInfo
                 ui_debug "$errorInfo"
-                ui_error "Activating $portname @${version_installed}_${revision_installed} failed: $result"
+                ui_error "Activating $iname @${version_installed}_${revision_installed} failed: $result"
                 return 1
             }
         }
@@ -2008 +2013 @@
     # output version numbers
     ui_debug "epoch: in tree: $epoch_in_tree installed: $epoch_installed"
     ui_debug "$portname ${version_in_tree}_$revision_in_tree exists in the ports tree"
-    ui_debug "$portname ${version_installed}_$revision_installed is installed"
+    ui_debug "$iname ${version_installed}_$revision_installed is installed"
 
     # set the nodeps option  
     if {![info exists options(ports_nodeps)]} {
@@ -2075 +2080 @@
             || ([rpm-vercomp $version_installed $version_in_tree] == 0
                 && [rpm-vercomp $revision_installed $revision_in_tree] >= 0 ))
         && ![info exists options(ports_force)] } {
-        ui_debug "No need to upgrade! $portname ${version_installed}_$revision_installed >= $portname ${version_in_tree}_$revision_in_tree"
+        ui_debug "No need to upgrade! $iname ${version_installed}_$revision_installed >= $portname ${version_in_tree}_$revision_in_tree"
         if { $epoch_installed >= $epoch_in_tree } {
             # Check if we have to do dependents
             if {[info exists options(ports_do_dependents)]} {
@@ -2083 +2088 @@
                 set options(ports_nodeps) 1
 
                 registry::open_dep_map
-                set deplist [registry::list_dependents $portname]
+                set deplist [registry::list_dependents $iname]
 
                 if { [llength deplist] > 0 } {
                     foreach dep $deplist {
@@ -2152 +2157 @@
     # uninstall old ports
     if {[info exists options(port_uninstall_old)] || $epoch_override == 1 || [info exists options(ports_force)] || 0 != [string compare "image" ${macports::registry.installtype}] } {
         # uninstall old
-        ui_debug "Uninstalling $portname ${version_installed}_$revision_installed$oldvariant"
-        if {[catch {portuninstall::uninstall $portname ${version_installed}_$revision_installed$oldvariant $optionslist} result]} {
+        ui_debug "Uninstalling $iname ${version_installed}_$revision_installed$oldvariant"
+        if {[catch {portuninstall::uninstall $iname ${version_installed}_$revision_installed$oldvariant $optionslist} result]} {
             global errorInfo
             ui_debug "$errorInfo"
-            ui_error "Uninstall $portname ${version_installed}_$revision_installed$oldvariant failed: $result"
+            ui_error "Uninstall $iname ${version_installed}_$revision_installed$oldvariant failed: $result"
             return 1
         }
     } else {
         # XXX deactivate version_installed
-        if {[catch {portimage::deactivate $portname ${version_installed}_$revision_installed$oldvariant $optionslist} result]} {
+        if {[catch {portimage::deactivate $iname ${version_installed}_$revision_installed$oldvariant $optionslist} result]} {
             global errorInfo
             ui_debug "$errorInfo"
-            ui_error "Deactivating $portname ${version_installed}_$revision_installed failed: $result"
+            ui_error "Deactivating $iname ${version_installed}_$revision_installed failed: $result"
             return 1
         }
     }