modern Tcl and correct quoting
Poor Yorick
org.macosforge.lists.macports-dev at pooryorick.com
Thu Jun 13 08:39:53 PDT 2013
On Wed, Jun 12, 2013 at 10:18:54PM +0000, Poor Yorick wrote:
>
> I'm working on breaking the patch up as suggested.
>
Attached is a patch that fixes a couple of problems with the first patch and
uses boolean comparison where it seemed like the thing to do.
--
Yorick
-------------- next part --------------
--- macports.tcl 2013-06-13 10:20:08.000000000 -0400
+++ macports.tcl.new 2013-06-13 02:56:34.000000000 -0400
@@ -100,7 +100,7 @@
# ui_options accessor
proc macports::ui_isset {val} {
if {[info exists macports::ui_options($val)]} {
- if {$macports::ui_options($val) eq "yes"} {
+ if {$macports::ui_options($val)} {
return 1
}
}
@@ -111,7 +111,7 @@
# global_options accessor
proc macports::global_option_isset {val} {
if {[info exists macports::global_options($val)]} {
- if {$macports::global_options($val) eq "yes"} {
+ if {$macports::global_options($val)} {
return 1
}
}
@@ -174,6 +174,7 @@
lappend ::logstack [list $::debuglog $::debuglogname]
}
}
+
proc macports::pop_log {} {
global ::logenabled ::logstack ::debuglog ::debuglogname
if {![info exists ::logenabled]} {
@@ -283,14 +284,14 @@
switch $priority {
debug {
if {[ui_isset ports_debug]} {
- return {stderr}
+ return stderr
} else {
return {}
}
}
info {
if {[ui_isset ports_verbose]} {
- return {stdout}
+ return stdout
} else {
return {}
}
@@ -299,18 +300,18 @@
if {[ui_isset ports_quiet]} {
return {}
} else {
- return {stdout}
+ return stdout
}
}
msg {
- return {stdout}
+ return stdout
}
warn -
error {
- return {stderr}
+ return stderr
}
default {
- return {stdout}
+ return stdout
}
}
}
@@ -1070,33 +1071,33 @@
if {[catch {array set sysConfProxies [get_systemconfiguration_proxies]} result]} {
return -code error "Unable to get proxy configuration from system: $result"
}
- if {![info exists env(http_proxy)] || $proxy_override_env eq "yes"} {
+ if {![info exists env(http_proxy)] || $proxy_override_env} {
if {[info exists proxy_http]} {
set env(http_proxy) $proxy_http
} elseif {[info exists sysConfProxies(proxy_http)]} {
set env(http_proxy) $sysConfProxies(proxy_http)
}
}
- if {![info exists env(HTTPS_PROXY)] || $proxy_override_env eq "yes"} {
+ if {![info exists env(HTTPS_PROXY)] || $proxy_override_env} {
if {[info exists proxy_https]} {
set env(HTTPS_PROXY) $proxy_https
} elseif {[info exists sysConfProxies(proxy_https)]} {
set env(HTTPS_PROXY) $sysConfProxies(proxy_https)
}
}
- if {![info exists env(FTP_PROXY)] || $proxy_override_env eq "yes"} {
+ if {![info exists env(FTP_PROXY)] || $proxy_override_env} {
if {[info exists proxy_ftp]} {
set env(FTP_PROXY) $proxy_ftp
} elseif {[info exists sysConfProxies(proxy_ftp)]} {
set env(FTP_PROXY) $sysConfProxies(proxy_ftp)
}
}
- if {![info exists env(RSYNC_PROXY)] || $proxy_override_env eq "yes"} {
+ if {![info exists env(RSYNC_PROXY)] || $proxy_override_env} {
if {[info exists proxy_rsync]} {
set env(RSYNC_PROXY) $proxy_rsync
}
}
- if {![info exists env(NO_PROXY)] || $proxy_override_env eq "yes"} {
+ if {![info exists env(NO_PROXY)] || $proxy_override_env} {
if {[info exists proxy_skip]} {
set env(NO_PROXY) $proxy_skip
} elseif {[info exists sysConfProxies(proxy_skip)]} {
@@ -1223,13 +1224,11 @@
}
# Create package require abstraction procedure
- set script {
- proc PortSystem {version} {
- package require port ${version}
- }
- }
- set script [string map [list \${version} [list $version]] $script]
- $workername eval $script
+ $workername eval {
+ proc PortSystem {version} {
+ package require port $version
+ }
+ }
# Clearly separate slave interpreters and the master interpreter.
$workername alias mport_exec mportexec
@@ -1305,7 +1304,6 @@
}
if {[info exists $opt]} {
$workername eval [list set system_options($opt) [set $opt]]
- $workername eval [list set system_options($opt) [set $opt]]
$workername eval [list set $opt [set $opt]]
}
}
@@ -1320,7 +1318,7 @@
set ${opt} [getoption ${opt}]
}
}
- set script [string map [list \${opt} $opt] $script]
+ set script [string map [list \${opt} [list $opt]] $script]
$workername eval $script
# next access will actually define the variable.
$workername eval [list trace add variable ::$opt read ::trace_$opt]
@@ -1524,7 +1522,7 @@
# append requested path
set proposedpath [file join $proposedpath _resources $path]
- if {$fallback eq "yes" && ![file exists $proposedpath]} {
+ if {$fallback && ![file exists $proposedpath]} {
return [getdefaultportresourcepath $path]
}
@@ -1864,7 +1862,7 @@
![catch {$workername eval check_supported_archs} result] && $result == 0 &&
![catch {$workername eval [list eval_targets $target]} result] && $result == 0} {
# If auto-clean mode, clean-up after dependency install
- if {$macports::portautoclean eq "yes"]} {
+ if {$macports::portautoclean} {
# Make sure we are back in the port path before clean
# otherwise if the current directory had been changed to
# inside the port, the next port may fail when trying to
@@ -1991,7 +1989,7 @@
}
set clean 0
- if {$macports::portautoclean eq "yes"] && ([string equal $target "install"] || [string equal $target "activate"])} {
+ if {$macports::portautoclean && ($target eq "install" || $target eq "activate")} {
# If we're doing an install, check if we should clean after
set clean 1
}
@@ -2411,7 +2409,7 @@
}
}
- if {(![info exists options(ports_force)] || $options(ports_force) ne "yes") && $updated <= 0} {
+ if {(![info exists options(ports_force)] || !$options(ports_force)) && $updated <= 0} {
ui_info "No updates for $source"
continue
}
@@ -2419,7 +2417,7 @@
file mkdir $destdir
set verboseflag {}
- if {$macports::portverbose eq "yes"} {
+ if {$macports::portverbose} {
set verboseflag -v
}
@@ -2502,7 +2500,7 @@
set protocol [macports::getprotocol $source]
if {$protocol eq "mports"} {
set res [macports::index::search $macports::portdbpath $source [list name $pattern]]
- lappend matches {*}$res
+ eval lappend matches $res
} else {
if {[catch {set fd [open [macports::getindex $source] r]} result]} {
ui_warn "Can't open index file for source: $source"
@@ -2676,7 +2674,7 @@
} else {
set res [macports::index::search $macports::portdbpath $source [list name $name]]
if {[llength $res] > 0} {
- lappend matches {*}$res
+ eval lappend matches $res
break
}
}
@@ -2744,7 +2742,7 @@
}
} else {
set res [macports::index::search $macports::portdbpath $source [list name .*]]
- lappend matches {*}$res
+ eval lappend matches $res
}
}
if {!$found} {
@@ -2866,8 +2864,7 @@
proc _mportkey {mport key} {
set workername [ditem_key $mport workername]
- set code {return $key}
- return [$workername eval [string map [list \$key [list $key]] {return $key}]]
+ return [$workername eval {return [set $key]}]
}
# mportdepends builds the list of mports which the given port depends on.
@@ -3017,7 +3014,7 @@
set supported_archs [_mportkey $depport supported_archs]
array unset variation_array
- array set variation_array [[ditem_key $depport workername] eval array get variations]
+ array set variation_array [[ditem_key $depport workername] eval {array get variations}]
mportclose $depport
set arch_mismatch 1
set has_universal 0
@@ -3185,8 +3182,8 @@
mpkg -
rpm -
dpkg -
- srpm { return 1 }
- default { return 0 }
+ srpm {return 1}
+ default {return 0}
}
}
@@ -3196,12 +3193,12 @@
fetch -
checksum {return depends_fetch}
extract -
- patch {return [list depends_fetch depends_extract]}
+ patch {return {depends_fetch depends_extract}}
configure -
- build {return [list depends_fetch depends_extract depends_build depends_lib]}
+ build {return {depends_fetch depends_extract depends_build depends_lib}}
test -
srpm -
- destroot {return [list depends_fetch depends_extract depends_build depends_lib depends_run]}
+ destroot {return {depends_fetch depends_extract depends_build depends_lib depends_run}}
dmg -
pkg -
mdmg -
@@ -3210,9 +3207,9 @@
dpkg {
if {[global_option_isset ports_binary_only] ||
(![global_option_isset ports_source_only] && [$workername eval _archive_available])} {
- return [list depends_lib depends_run]
+ return {depends_lib depends_run}
} else {
- return [list depends_fetch depends_extract depends_build depends_lib depends_run]
+ return {depends_fetch depends_extract depends_build depends_lib depends_run}
}
}
install -
@@ -3221,9 +3218,9 @@
if {[global_option_isset ports_binary_only]
|| [$workername eval {registry_exists $subport $version $revision $portvariants}]
|| (![global_option_isset ports_source_only] && [$workername eval _archive_available])} {
- return [list depends_lib depends_run]
+ return {depends_lib depends_run}
} else {
- return [list depends_fetch depends_extract depends_build depends_lib depends_run]
+ return {depends_fetch depends_extract depends_build depends_lib depends_run}
}
}
}
@@ -3263,14 +3260,14 @@
# sync the MacPorts sources
ui_msg "$macports::ui_prefix Updating MacPorts base sources using rsync"
- if {[catch {system "$rsync_path $rsync_options rsync://$rsync_server/$rsync_dir $mp_source_path"} result ]} {
+ if {[catch {system "$rsync_path $rsync_options rsync://$rsync_server/$rsync_dir $mp_source_path"} result]} {
return -code error "Error synchronizing MacPorts sources: $result"
}
if {$is_tarball} {
# verify signature for tarball
global macports::archivefetch_pubkeys
- if {[catch {system "$rsync_path $rsync_options rsync://$rsync_server/$rsync_dir.rmd160 $mp_source_path" } result]} {
+ if {[catch {system "$rsync_path $rsync_options rsync://$rsync_server/$rsync_dir.rmd160 $mp_source_path"} result]} {
return -code error "Error synchronizing MacPorts source signature: $result"
}
set openssl [findBinary openssl $macports::autoconf::openssl_path]
@@ -3309,7 +3306,7 @@
# echo current MacPorts version
ui_msg "MacPorts base version $macports::autoconf::macports_version installed,"
- if {[info exists options(ports_force)] && $options(ports_force) eq "yes"} {
+ if {[info exists options(ports_force)] && $options(ports_force)} {
set use_the_force_luke yes
ui_debug "Forcing a rebuild and reinstallation of MacPorts"
} else {
@@ -3334,7 +3331,7 @@
set comp [vercmp $macports_version_new $macports::autoconf::macports_version]
# syncing ports tree.
- if {![info exists options(ports_selfupdate_nosync)] || $options(ports_selfupdate_nosync) ne "yes"} {
+ if {![info exists options(ports_selfupdate_nosync)] || !$options(ports_selfupdate_nosync)} {
if {$comp > 0} {
# updated portfiles potentially need new base to parse - tell sync to try to
# use prefabricated PortIndex files and signal if it couldn't
@@ -3346,7 +3343,7 @@
}
if {$use_the_force_luke eq "yes" || $comp > 0} {
- if {[info exists options(ports_dryrun)] && $options(ports_dryrun) eq "yes"} {
+ if {[info exists options(ports_dryrun)] && $options(ports_dryrun)} {
ui_msg "$macports::ui_prefix MacPorts base is outdated, selfupdate would install $macports_version_new (dry run)"
} else {
ui_msg "$macports::ui_prefix MacPorts base is outdated, installing new version $macports_version_new"
@@ -3728,7 +3725,7 @@
&& ![info exists options(ports_upgrade_force)]} {
if {$portname ne $newname} {
ui_debug "ignoring versions, installing replacement port"
- } elseif { $epoch_installed < $epoch_in_tree && $version_installed ne $version_in_tree } {
+ } elseif { $epoch_installed < $epoch_in_tree && $version_installed ne $version_in_tree} {
set build_override 1
ui_debug "epoch override ... upgrading!"
} elseif {[info exists options(ports_upgrade_enforce-variants)]
More information about the macports-dev
mailing list