Ticket #11759: case_fixes.diff

File case_fixes.diff, 13.4 KB (added by jmroot (Joshua Root), 16 years ago)

a more comprehensive case-preservation patch

  • src/port/port.tcl

     
    209209proc registry_installed {portname {portversion ""}} {
    210210    set ilist [registry::installed $portname $portversion]
    211211    if { [llength $ilist] > 1 } {
     212        # set portname again since the one we were passed may not have had the correct case
     213        set portname [lindex [lindex $ilist 0] 0]
    212214        puts "The following versions of $portname are currently installed:"
    213215        foreach i [portlist_sortint $ilist] {
    214216            set iname [lindex $i 0]
    … …  
    14681470            ui_debug "$errorInfo"
    14691471            break_softcontinue "port location failed: $result" 1 status
    14701472        } else {
     1473            # set portname again since the one we were passed may not have had the correct case
     1474            set portname [lindex $ilist 0]
    14711475            set version [lindex $ilist 1]
    14721476            set revision [lindex $ilist 2]
    14731477            set variants [lindex $ilist 3]
    … …  
    16521656            global errorInfo
    16531657            ui_debug "$errorInfo"
    16541658            break_softcontinue "$result" 1 status
     1659        } else {
     1660            # set portname again since the one we were passed may not have had the correct case
     1661            set portname [lindex [lindex $ilist 0] 0]
    16551662        }
    16561663       
    16571664        set deplist [registry::list_dependents $portname]
    … …  
    18821889        return 1
    18831890    }
    18841891    foreachport $portlist {
     1892        if { ![catch {set ilist [registry::installed $portname]} result] } {
     1893            # set portname again since the one we were passed may not have had the correct case
     1894            set portname [lindex [lindex $ilist 0] 0]
     1895        }
    18851896        set files [registry::port_registered $portname]
    18861897        if { $files != 0 } {
    18871898            if { [llength $files] > 0 } {
    … …  
    19201931
    19211932        array unset portinfo
    19221933        array set portinfo [lindex $result 1]
     1934        # set portname again since the one we were passed may not have had the correct case
     1935        set portname $portinfo(name)
    19231936
    19241937        set depstypes {depends_build depends_lib depends_run}
    19251938        set depstypes_descr {"build" "library" "runtime"}
    … …  
    19681981   
    19691982        array unset portinfo
    19701983        array set portinfo [lindex $result 1]
     1984        # set portname again since the one we were passed may not have had the correct case
     1985        set portname $portinfo(name)
    19711986        set porturl $portinfo(porturl)
    19721987        set portdir $portinfo(portdir)
    19731988

  • src/registry1.0/portuninstall.tcl

     
    4444
    4545        set ilist [registry::installed $portname $v]
    4646        if { [llength $ilist] > 1 } {
     47            set portname [lindex [lindex $ilist 0] 0]
    4748                ui_msg "$UI_PREFIX [msgcat::mc "The following versions of $portname are currently installed:"]"
    4849                foreach i $ilist {
    4950                        set iname [lindex $i 0]
    … …  
    5960                }
    6061                return -code error "Registry error: Please specify the full version as recorded in the port registry."
    6162        } else {
     63            # set portname again since the one we were passed may not have had the correct case
     64            set portname [lindex [lindex $ilist 0] 0]
    6265                set version [lindex [lindex $ilist 0] 1]
    6366                set revision [lindex [lindex $ilist 0] 2]
    6467                set variants [lindex [lindex $ilist 0] 3]

  • src/registry1.0/receipt_flat.tcl

     
    426426                }
    427427                # [PG] Huh?
    428428        } else {
     429            # We want to be case-insensitive but case-preserving, so the name gets
     430            # returned with the correct case even if it's wrong when given. To get the
     431            # correct case on a case-insensitive FS, we have to list the directory and
     432            # compare against each entry.
     433            set name_path [file join ${query_path} *]
     434            set name_entries [glob -nocomplain -types d ${name_path}]
     435            foreach entry $name_entries {
     436                set basename [file tail $entry]
     437                if {[string equal -nocase $basename $name]} {
     438                    set name $basename
     439                    break
     440                }
     441            }
    429442                set query_path [file join ${query_path} ${name}]
    430443                if { $version != "" } {
    431444                        set query_path [file join ${query_path} ${version}]

  • src/registry1.0/portimage.tcl

     
    7979                set force 0
    8080        }
    8181
    82         if {$v != ""} {
    83                 ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s @%s"] $name $v]"
    84         } else {
    85                 ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s"] $name]"
    86         }
    87 
    8882        set ilist [_check_registry $name $v]
     83        # set name again since the one we were passed may not have had the correct case
     84        set name [lindex $ilist 0]
    8985        set version [lindex $ilist 1]
    9086        set revision [lindex $ilist 2]
    9187        set     variants [lindex $ilist 3]
     88       
     89    if {$v != ""} {
     90        ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s @%s"] $name $v]"
     91    } else {
     92        ui_msg "$UI_PREFIX [format [msgcat::mc "Activating %s"] $name]"
     93    }
    9294
    9395        set ilist [registry::installed $name]
    9496        if { [llength $ilist] > 1 } {
    … …  
    146148                set force 0
    147149        }
    148150
    149         if {$v != ""} {
    150                 ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s @%s"] $name $v]"
    151         } else {
    152                 ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s"] $name]"
    153         }
    154 
    155151        set ilist [registry::active $name]
    156152        if { [llength $ilist] > 1 } {
    157153                return -code error "Registry error: Please specify the name of the port."
    158154        } else {
    159155                set ilist [lindex $ilist 0]
    160156        }
     157        # set name again since the one we were passed may not have had the correct case
     158        set name [lindex $ilist 0]
    161159        set version [lindex $ilist 1]
    162160        set revision [lindex $ilist 2]
    163161        set     variants [lindex $ilist 3]
    164162        set fqversion ${version}_${revision}${variants}
    165163       
     164    if {$v != ""} {
     165        ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s @%s"] $name $v]"
     166    } else {
     167        ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s"] $name]"
     168    }
     169       
    166170        if { $v != "" && ![string equal ${fqversion} $v] } {
    167171                return -code error "Active version of $name is not $v but ${fqversion}."
    168172        }
    … …  
    217221        set ilist [registry::installed $name $v]
    218222        if { [string equal $v ""] } {
    219223                if { [llength $ilist] > 1 } {
     224                    # set name again since the one we were passed may not have had the correct case
     225                    set name [lindex [lindex $ilist 0] 0]
    220226                        ui_msg "$UI_PREFIX [msgcat::mc "The following versions of $name are currently installed:"]"
    221227                        foreach i $ilist {
    222228                                set iname [lindex $i 0]

  • src/macports1.0/macports.tcl

     
    18931893    }
    18941894    # fill array with information
    18951895    array set portinfo [lindex $result 1]
     1896    # set portname again since the one we were passed may not have had the correct case
     1897    set portname $portinfo(name)
    18961898
    18971899    # set version_in_tree and revision_in_tree
    18981900    if {![info exists portinfo(version)]} {
    … …  
    19511953        # XXX  this sets $version_installed to $version_in_tree even if not installed!!
    19521954        set version_installed $version_in_tree
    19531955        set revision_installed $revision_in_tree
     1956        set iname $portname
    19541957        # That was a very dirty hack showing how ugly our depencendy and upgrade code is.
    19551958        # To get it working when user provides -f, we also need to set the variant to
    19561959        # avoid a future failure.
    … …  
    19681971                    [rpm-vercomp $version $version_installed] > 0
    19691972                    || ([rpm-vercomp $version $version_installed] == 0
    19701973                        && [rpm-vercomp $revision $revision_installed] > 0)} {
     1974                set iname [lindex $i 0]
    19711975                set version_installed $version
    19721976                set revision_installed $revision
    19731977                set variant_installed $variant
    1974                 set epoch_installed [registry::property_retrieve [registry::open_entry $portname [lindex $i 1] [lindex $i 2] $variant] epoch]
     1978                set epoch_installed [registry::property_retrieve [registry::open_entry $iname [lindex $i 1] [lindex $i 2] $variant] epoch]
    19751979                set num $i
    19761980            }
    19771981
    19781982            set isactive [lindex $i 4]
    19791983            if {$isactive == 1} {
    19801984                set anyactive yes
     1985                set active_name [lindex $i 0]
    19811986                set version_active $version
    19821987                set revision_active $revision
    19831988                set variant_active $variant
    … …  
    19871992                            || [rpm-vercomp $revision_installed $revision_active] != 0
    19881993                            || [string compare $variant_installed $variant_active] != 0)} {
    19891994            # deactivate version
    1990             if {[catch {portimage::deactivate $portname ${version_active}_${revision_active}${variant_active} $optionslist} result]} {
     1995            if {[catch {portimage::deactivate $active_name ${version_active}_${revision_active}${variant_active} $optionslist} result]} {
    19911996                global errorInfo
    19921997                ui_debug "$errorInfo"
    1993                 ui_error "Deactivating $portname @${version_active}_${revision_active} failed: $result"
     1998                ui_error "Deactivating $active_name @${version_active}_${revision_active} failed: $result"
    19941999                return 1
    19952000            }
    19962001        }
    19972002        if { [lindex $num 4] == 0 && 0 == [string compare "image" ${macports::registry.installtype}] } {
    19982003            # activate the latest installed version
    1999             if {[catch {portimage::activate $portname ${version_installed}_${revision_installed}$variant $optionslist} result]} {
     2004            if {[catch {portimage::activate $iname ${version_installed}_${revision_installed}$variant $optionslist} result]} {
    20002005                global errorInfo
    20012006                ui_debug "$errorInfo"
    2002                 ui_error "Activating $portname @${version_installed}_${revision_installed} failed: $result"
     2007                ui_error "Activating $iname @${version_installed}_${revision_installed} failed: $result"
    20032008                return 1
    20042009            }
    20052010        }
    … …  
    20082013    # output version numbers
    20092014    ui_debug "epoch: in tree: $epoch_in_tree installed: $epoch_installed"
    20102015    ui_debug "$portname ${version_in_tree}_$revision_in_tree exists in the ports tree"
    2011     ui_debug "$portname ${version_installed}_$revision_installed is installed"
     2016    ui_debug "$iname ${version_installed}_$revision_installed is installed"
    20122017
    20132018    # set the nodeps option 
    20142019    if {![info exists options(ports_nodeps)]} {
    … …  
    20752080            || ([rpm-vercomp $version_installed $version_in_tree] == 0
    20762081                && [rpm-vercomp $revision_installed $revision_in_tree] >= 0 ))
    20772082        && ![info exists options(ports_force)] } {
    2078         ui_debug "No need to upgrade! $portname ${version_installed}_$revision_installed >= $portname ${version_in_tree}_$revision_in_tree"
     2083        ui_debug "No need to upgrade! $iname ${version_installed}_$revision_installed >= $portname ${version_in_tree}_$revision_in_tree"
    20792084        if { $epoch_installed >= $epoch_in_tree } {
    20802085            # Check if we have to do dependents
    20812086            if {[info exists options(ports_do_dependents)]} {
    … …  
    20832088                set options(ports_nodeps) 1
    20842089
    20852090                registry::open_dep_map
    2086                 set deplist [registry::list_dependents $portname]
     2091                set deplist [registry::list_dependents $iname]
    20872092
    20882093                if { [llength deplist] > 0 } {
    20892094                    foreach dep $deplist {
    … …  
    21522157    # uninstall old ports
    21532158    if {[info exists options(port_uninstall_old)] || $epoch_override == 1 || [info exists options(ports_force)] || 0 != [string compare "image" ${macports::registry.installtype}] } {
    21542159        # uninstall old
    2155         ui_debug "Uninstalling $portname ${version_installed}_$revision_installed$oldvariant"
    2156         if {[catch {portuninstall::uninstall $portname ${version_installed}_$revision_installed$oldvariant $optionslist} result]} {
     2160        ui_debug "Uninstalling $iname ${version_installed}_$revision_installed$oldvariant"
     2161        if {[catch {portuninstall::uninstall $iname ${version_installed}_$revision_installed$oldvariant $optionslist} result]} {
    21572162            global errorInfo
    21582163            ui_debug "$errorInfo"
    2159             ui_error "Uninstall $portname ${version_installed}_$revision_installed$oldvariant failed: $result"
     2164            ui_error "Uninstall $iname ${version_installed}_$revision_installed$oldvariant failed: $result"
    21602165            return 1
    21612166        }
    21622167    } else {
    21632168        # XXX deactivate version_installed
    2164         if {[catch {portimage::deactivate $portname ${version_installed}_$revision_installed$oldvariant $optionslist} result]} {
     2169        if {[catch {portimage::deactivate $iname ${version_installed}_$revision_installed$oldvariant $optionslist} result]} {
    21652170            global errorInfo
    21662171            ui_debug "$errorInfo"
    2167             ui_error "Deactivating $portname ${version_installed}_$revision_installed failed: $result"
     2172            ui_error "Deactivating $iname ${version_installed}_$revision_installed failed: $result"
    21682173            return 1
    21692174        }
    21702175    }