[23238] trunk/base/src
source_changes at macosforge.org
source_changes at macosforge.org
Tue Mar 27 14:49:50 PDT 2007
Revision: 23238
http://trac.macosforge.org/projects/macports/changeset/23238
Author: pguyot at kallisys.net
Date: 2007-03-27 14:49:49 -0700 (Tue, 27 Mar 2007)
Log Message:
-----------
New logic for the environment that makes it much cleaner.
Note, however, that this doesn't solve the problem of ports that don't like
CFLAGS to be set (e.g. centericq) because of a bug in recursive autoconf (!).
Modified Paths:
--------------
trunk/base/src/package1.0/portarchive.tcl
trunk/base/src/package1.0/portunarchive.tcl
trunk/base/src/port1.0/portbuild.tcl
trunk/base/src/port1.0/portconfigure.tcl
trunk/base/src/port1.0/portdestroot.tcl
trunk/base/src/port1.0/portextract.tcl
trunk/base/src/port1.0/portfetch.tcl
trunk/base/src/port1.0/portpatch.tcl
trunk/base/src/port1.0/porttest.tcl
trunk/base/src/port1.0/portutil.tcl
Modified: trunk/base/src/package1.0/portarchive.tcl
===================================================================
--- trunk/base/src/package1.0/portarchive.tcl 2007-03-27 21:36:22 UTC (rev 23237)
+++ trunk/base/src/package1.0/portarchive.tcl 2007-03-27 21:49:49 UTC (rev 23238)
@@ -324,7 +324,7 @@
}
ui_info "$UI_PREFIX [format [msgcat::mc "Creating %s"] ${archive.file}]"
- system "[command archive]"
+ command_exec archive
ui_info "$UI_PREFIX [format [msgcat::mc "Archive %s packaged"] ${archive.file}]"
}
}
Modified: trunk/base/src/package1.0/portunarchive.tcl
===================================================================
--- trunk/base/src/package1.0/portunarchive.tcl 2007-03-27 21:36:22 UTC (rev 23237)
+++ trunk/base/src/package1.0/portunarchive.tcl 2007-03-27 21:49:49 UTC (rev 23238)
@@ -268,7 +268,7 @@
# Unpack the archive
ui_info "$UI_PREFIX [format [msgcat::mc "Extracting %s"] ${unarchive.file}]"
- system "[command unarchive]"
+ command_exec unarchive
return 0
}
@@ -313,7 +313,7 @@
# Unpack the archive
ui_info "$UI_PREFIX [format [msgcat::mc "Extracting %s"] ${unarchive.file}]"
- system "[command unarchive]"
+ command_exec unarchive
return 0
}
Modified: trunk/base/src/port1.0/portbuild.tcl
===================================================================
--- trunk/base/src/port1.0/portbuild.tcl 2007-03-27 21:36:22 UTC (rev 23237)
+++ trunk/base/src/port1.0/portbuild.tcl 2007-03-27 21:49:49 UTC (rev 23238)
@@ -102,6 +102,6 @@
}
proc build_main {args} {
- system "[command build]"
+ command_exec build
return 0
}
Modified: trunk/base/src/port1.0/portconfigure.tcl
===================================================================
--- trunk/base/src/port1.0/portconfigure.tcl 2007-03-27 21:36:22 UTC (rev 23237)
+++ trunk/base/src/port1.0/portconfigure.tcl 2007-03-27 21:49:49 UTC (rev 23238)
@@ -83,21 +83,21 @@
if {[tbool use_automake]} {
# XXX depend on automake
- if {[catch {system "[command automake]"} result]} {
+ if {[catch {command_exec automake} result]} {
return -code error "[format [msgcat::mc "%s failure: %s"] automake $result]"
}
}
if {[tbool use_autoconf]} {
# XXX depend on autoconf
- if {[catch {system "[command autoconf]"} result]} {
+ if {[catch {command_exec autoconf} result]} {
return -code error "[format [msgcat::mc "%s failure: %s"] autoconf $result]"
}
}
if {[tbool use_xmkmf]} {
# XXX depend on xmkmf
- if {[catch {system "[command xmkmf]"} result]} {
+ if {[catch {command_exec xmkmf} result]} {
return -code error "[format [msgcat::mc "%s failure: %s"] xmkmf $result]"
} else {
# XXX should probably use make command abstraction but we know that
@@ -106,19 +106,16 @@
}
} elseif {[tbool use_configure]} {
# Merge (ld|c|cpp|cxx)flags into the environment variable.
- # Flatten the environment string.
- set env_str ""
- foreach str [set configure.env] {
- set env_str "$env_str $str"
- }
- parse_environment $env_str parsed_env
+ parse_environment configure
+
# Append configure flags.
- append_list_to_environment_value parsed_env "CFLAGS" ${configure.cflags}
- append_list_to_environment_value parsed_env "CPPFLAGS" ${configure.cppflags}
- append_list_to_environment_value parsed_env "CXXFLAGS" ${configure.cxxflags}
- append_list_to_environment_value parsed_env "LDFLAGS" ${configure.ldflags}
- set configure.env [environment_array_to_string parsed_env]
- if {[catch {system "[command configure]"} result]} {
+ append_list_to_environment_value configure "CFLAGS" ${configure.cflags}
+ append_list_to_environment_value configure "CPPFLAGS" ${configure.cppflags}
+ append_list_to_environment_value configure "CXXFLAGS" ${configure.cxxflags}
+ append_list_to_environment_value configure "LDFLAGS" ${configure.ldflags}
+
+ # Execute the command (with the new environment).
+ if {[catch {command_exec configure} result]} {
return -code error "[format [msgcat::mc "%s failure: %s"] configure $result]"
}
}
Modified: trunk/base/src/port1.0/portdestroot.tcl
===================================================================
--- trunk/base/src/port1.0/portdestroot.tcl 2007-03-27 21:36:22 UTC (rev 23237)
+++ trunk/base/src/port1.0/portdestroot.tcl 2007-03-27 21:49:49 UTC (rev 23238)
@@ -99,7 +99,7 @@
}
proc destroot_main {args} {
- system "[command destroot]"
+ command_exec destroot
return 0
}
Modified: trunk/base/src/port1.0/portextract.tcl
===================================================================
--- trunk/base/src/port1.0/portextract.tcl 2007-03-27 21:36:22 UTC (rev 23237)
+++ trunk/base/src/port1.0/portextract.tcl 2007-03-27 21:49:49 UTC (rev 23238)
@@ -84,7 +84,7 @@
foreach distfile [option extract.only] {
ui_info "$UI_PREFIX [format [msgcat::mc "Extracting %s"] $distfile]"
option extract.args "[option distpath]/$distfile"
- if {[catch {system "[command extract]"} result]} {
+ if {[catch {command_exec extract} result]} {
return -code error "$result"
}
}
Modified: trunk/base/src/port1.0/portfetch.tcl
===================================================================
--- trunk/base/src/port1.0/portfetch.tcl 2007-03-27 21:36:22 UTC (rev 23237)
+++ trunk/base/src/port1.0/portfetch.tcl 2007-03-27 21:49:49 UTC (rev 23238)
@@ -320,7 +320,7 @@
set cvs.env ""
set cvs.args login
set cvs.post_args ""
- if {[catch {system -notty "[command cvs] 2>&1"} result]} {
+ if {[catch {command_exec cvs -notty "" "2>&1"} result]} {
return -code error [msgcat::mc "CVS login failed"]
}
set cvs.cmd ${savecmd}
@@ -331,7 +331,7 @@
set env(CVS_RSH) ssh
}
- if {[catch {system "[command cvs] 2>&1"} result]} {
+ if {[catch {command_exec cvs "" "2>&1"} result]} {
return -code error [msgcat::mc "CVS check out failed"]
}
@@ -366,7 +366,7 @@
set svn.args "${svn.args} -r ${svn.tag}"
}
- if {[catch {system "[command svn] 2>&1"} result]} {
+ if {[catch {command_exec svn "" "2>&1"} result]} {
return -code error [msgcat::mc "Subversion check out failed"]
}
Modified: trunk/base/src/port1.0/portpatch.tcl
===================================================================
--- trunk/base/src/port1.0/portpatch.tcl 2007-03-27 21:36:22 UTC (rev 23237)
+++ trunk/base/src/port1.0/portpatch.tcl 2007-03-27 21:49:49 UTC (rev 23238)
@@ -79,9 +79,9 @@
}
switch -glob -- [file tail $patch] {
*.Z -
- *.gz {system "$gzcat \"$patch\" | ([command patch])"}
- *.bz2 {system "bzcat \"$patch\" | ([command patch])"}
- default {system "[command patch] < \"$patch\""}
+ *.gz {command_exec patch "$gzcat \"$patch\" | (" ")"}
+ *.bz2 {command_exec patch "bzcat \"$patch\" | (" ")"}
+ default {command_exec patch "" "< '$patch'"}
}
}
return 0
Modified: trunk/base/src/port1.0/porttest.tcl
===================================================================
--- trunk/base/src/port1.0/porttest.tcl 2007-03-27 21:36:22 UTC (rev 23237)
+++ trunk/base/src/port1.0/porttest.tcl 2007-03-27 21:49:49 UTC (rev 23238)
@@ -30,7 +30,7 @@
proc test_main {args} {
global portname test.run
if {[tbool test.run]} {
- system "[command test]"
+ command_exec test
} else {
return -code error [format [msgcat::mc "%s has no tests turned on. see 'test.run' in portfile(7)"] $portname]
}
Modified: trunk/base/src/port1.0/portutil.tcl
===================================================================
--- trunk/base/src/port1.0/portutil.tcl 2007-03-27 21:36:22 UTC (rev 23237)
+++ trunk/base/src/port1.0/portutil.tcl 2007-03-27 21:49:49 UTC (rev 23238)
@@ -202,10 +202,9 @@
}
}
-# command
-# Given a command name, command assembled a string
+# Given a command name, assemble a command string
# composed of the command options.
-proc command {command} {
+proc command_string {command} {
global ${command}.dir ${command}.pre_args ${command}.args ${command}.post_args ${command}.env ${command}.type ${command}.cmd
set cmdstring ""
@@ -213,12 +212,6 @@
set cmdstring "cd \"[set ${command}.dir]\" &&"
}
- if {[info exists ${command}.env]} {
- foreach string [set ${command}.env] {
- set cmdstring "$cmdstring $string"
- }
- }
-
if {[info exists ${command}.cmd]} {
foreach string [set ${command}.cmd] {
set cmdstring "$cmdstring $string"
@@ -237,6 +230,69 @@
return $cmdstring
}
+# Given a command name, execute it with the options.
+# command_exec command [-notty] [command_prefix [command_suffix]]
+# command name of the command
+# command_prefix additional command prefix (typically pipe command)
+# command_suffix additional command suffix (typically redirection)
+proc command_exec {command args} {
+ global ${command}.env ${command}.env_array env
+ set notty 0
+ set command_prefix ""
+ set command_suffix ""
+
+ if {[llength $args] > 0} {
+ if {[lindex $args 0] == "-notty"} {
+ set notty 1
+ set args [lrange $args 1 end]
+ }
+
+ if {[llength $args] > 0} {
+ set command_prefix [lindex $args 0]
+ if {[llength $args] > 1} {
+ set command_suffix [lindex $args 1]
+ }
+ }
+ }
+
+ # Set the environment.
+ # If the array doesn't exist, we create it with the value
+ # coming from ${command}.env
+ # Otherwise, it means the caller actually played with the environment
+ # array already (e.g. configure flags).
+ if {![array exists ${command}.env_array]} {
+ parse_environment ${command}
+ }
+
+ # Debug that.
+ ui_debug "Environment: [environment_array_to_string ${command}.env_array]"
+
+ # Get the command string.
+ set cmdstring [command_string ${command}]
+
+ # Call this command.
+ # TODO: move that to the system native call?
+ # Save the environment.
+ set saved_env [array get env]
+ # Set the overriden variables from the portfile.
+ array set env [array get ${command}.env_array]
+ # Call the command.
+ set fullcmdstring "$command_prefix $cmdstring $command_suffix"
+ if {$notty} {
+ set code [catch {system -notty $fullcmdstring} result]
+ } else {
+ set code [catch {system $fullcmdstring} result]
+ }
+ # Unset the command array until next time.
+ array unset ${command}.env_array
+ # Restore the environment.
+ array unset env
+ array set env [array get saved_env]
+
+ # Return as if system had been called directly.
+ return -code $code $result
+}
+
# default
# Sets a variable to the supplied default if it does not exist,
# and adds a variable trace. The variable traces allows for delayed
@@ -403,79 +459,68 @@
########### Environment utility functions ###########
-# Parse an environment string, returning a list of key/value pairs.
-proc parse_environment {environment_str parsed_environment} {
- upvar 1 ${parsed_environment} env_array
- set the_environment ${environment_str}
- while {[regexp "^(?: *)(\[^= \]+)=(\\\\?(\"|'|))(\[^\"'\].*?)\\2(?: +|$)(.*)$" ${the_environment} matchVar key delimiter_full delimiter value remaining]} {
- set the_environment ${remaining}
- set env_array(${key}) ${delimiter}${value}${delimiter}
+# Parse the environment string of a command, storing the values into the
+# associated environment array.
+proc parse_environment {command} {
+ global ${command}.env ${command}.env_array
+
+ if {[info exists ${command}.env]} {
+ # Flatten the environment string.
+ set the_environment ""
+ foreach str [set ${command}.env] {
+ set the_environment "$the_environment $str"
+ }
+
+ while {[regexp "^(?: *)(\[^= \]+)=(\"|'|)(\[^\"'\].*?)\\2(?: +|$)(.*)$" ${the_environment} matchVar key delimiter value remaining]} {
+ set the_environment ${remaining}
+ set ${command}.env_array(${key}) ${value}
+ }
+ } else {
+ array set ${command}.env_array {}
}
}
# Append to the value in the parsed environment.
# Leave the environment untouched if the value is empty.
-proc append_to_environment_value {parsed_environment key value} {
- upvar 1 ${parsed_environment} env_array
+proc append_to_environment_value {command key value} {
+ global ${command}.env_array
if {[string length $value] == 0} {
return
}
- if {[info exists env_array($key)]} {
- set original_value $env_array($key)
- set original_delim ""
- if {[regexp {^("|')(.*)\1$} ${original_value} matchVar original_delim matchedValue]} {
- set original_value $matchedValue
- }
- set append_delim ""
- set append_value $value
- if {[regexp {^("|')(.*)\1$} $append_value matchVar append_delim matchedValue]} {
- set append_value $matchedValue
- }
-
- # Always honor original delimiter when appending, unless there isn't any.
- if {[string length $original_delim] == 0} {
- if {[string length $append_delim] == 0} {
- set new_delim "'"
- } else {
- set new_delim $append_delim
- }
- } else {
- set new_delim $original_delim
- }
-
- set space " "
- set env_array($key) ${new_delim}${original_value}${space}${append_value}${new_delim}
+ # Parse out any delimiter.
+ set append_value $value
+ if {[regexp {^("|')(.*)\1$} $append_value matchVar append_delim matchedValue]} {
+ set append_value $matchedValue
+ }
+
+ if {[info exists ${command}.env_array($key)]} {
+ set original_value [set ${command}.env_array($key)]
+ set ${command}.env_array($key) "${original_value} ${append_value}"
} else {
- set env_array($key) $value
+ set ${command}.env_array($key) $append_value
}
}
# Append several items to a value in the parsed environment.
-proc append_list_to_environment_value {parsed_environment key vallist} {
- upvar 1 ${parsed_environment} env_array
-
+proc append_list_to_environment_value {command key vallist} {
foreach {value} $vallist {
- append_to_environment_value env_array $key $value
+ append_to_environment_value ${command} $key $value
}
}
-# Rebuild the environment as a string.
-proc environment_array_to_string {parsed_environment} {
- upvar 1 ${parsed_environment} env_array
+# Build the environment as a string.
+# Remark: this method is only used for debugging purposes.
+proc environment_array_to_string {environment_array} {
+ upvar 1 ${environment_array} env_array
+
set theString ""
foreach {key value} [array get env_array] {
- set added_delim "'"
- if {[regexp {^("|').*\1$} ${value} matchVar original_delim]} {
- set added_delim ""
- }
- set value "${added_delim}${value}${added_delim}"
-
if {$theString == ""} {
- set theString "$key=$value"
+ set theString "$key='$value'"
} else {
- set theString "${theString} $key=$value"
+ set theString "${theString} $key='$value'"
}
}
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.macosforge.org/pipermail/macports-changes/attachments/20070327/da917d10/attachment.html
More information about the macports-changes
mailing list