aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSteve Bennett <steveb@workware.net.au>2013-03-28 07:15:00 +1000
committerSteve Bennett <steveb@workware.net.au>2013-03-28 07:19:55 +1000
commit738b8b93eec3ffcac1b84ddd85179a4351bc82ef (patch)
tree13aa0401a28123ea376d3ccd793d928ff894b100
parentc7e5c48c4434835a19628ebecfa1bf59883f5f58 (diff)
downloadjimtcl-738b8b93eec3ffcac1b84ddd85179a4351bc82ef.zip
jimtcl-738b8b93eec3ffcac1b84ddd85179a4351bc82ef.tar.gz
jimtcl-738b8b93eec3ffcac1b84ddd85179a4351bc82ef.tar.bz2
Update autosetup to v0.6.5
Includes a fix for -gstabs on newer macs Signed-off-by: Steve Bennett <steveb@workware.net.au>
-rw-r--r--autosetup/README.autosetup2
-rwxr-xr-xautosetup/autosetup282
-rw-r--r--autosetup/cc-lib.tcl84
-rw-r--r--autosetup/cc-shared.tcl99
-rw-r--r--autosetup/cc.tcl50
-rwxr-xr-xautosetup/config.guess3
-rwxr-xr-xautosetup/config.sub6
-rw-r--r--autosetup/default.auto25
-rw-r--r--autosetup/jimsh0.c665
-rw-r--r--autosetup/system.tcl5
-rwxr-xr-xconfigure2
11 files changed, 839 insertions, 384 deletions
diff --git a/autosetup/README.autosetup b/autosetup/README.autosetup
index 7ba1e37..c50bd84 100644
--- a/autosetup/README.autosetup
+++ b/autosetup/README.autosetup
@@ -1 +1 @@
-This is autosetup v0.6.4. See http://msteveb.github.com/autosetup/
+This is autosetup v0.6.5. See http://msteveb.github.com/autosetup/
diff --git a/autosetup/autosetup b/autosetup/autosetup
index 84de0cf..85c61ca 100755
--- a/autosetup/autosetup
+++ b/autosetup/autosetup
@@ -5,7 +5,7 @@
# \
dir=`dirname "$0"`; exec "`$dir/find-tclsh`" "$0" "$@"
-set autosetup(version) 0.6.4
+set autosetup(version) 0.6.5
# Can be set to 1 to debug early-init problems
set autosetup(debug) 0
@@ -87,7 +87,7 @@ proc main {argv} {
reference:=text => "display the autosetup command reference. 'text', 'wiki', 'asciidoc' or 'markdown'"
debug => "display debugging output as autosetup runs"
install:=. => "install autosetup to the current or given directory (in the 'autosetup/' subdirectory)"
- force init => "create an initial 'configure' script if none exists"
+ force init:=help => "create initial auto.def, etc. Use --init=help for known types"
# Undocumented options
option-checking=1
nopager
@@ -119,6 +119,11 @@ proc main {argv} {
use local
}
+ # Now any auto-load modules
+ foreach file [glob -nocomplain $autosetup(libdir)/*.auto $autosetup(libdir)/*/*.auto] {
+ automf_load source $file
+ }
+
if {[opt-val help] ne ""} {
incr autosetup(showhelp)
use help
@@ -130,9 +135,9 @@ proc main {argv} {
autosetup_reference [opt-val {manual ref reference}]
}
- if {[opt-bool init]} {
+ if {[opt-val init] ne ""} {
use init
- autosetup_init
+ autosetup_init [opt-val init]
}
if {[opt-val install] ne ""} {
@@ -143,7 +148,7 @@ proc main {argv} {
if {![file exists $autosetup(autodef)]} {
# Check for invalid option first
options {}
- user-error "No auto.def found in $autosetup(srcdir)"
+ user-error "No auto.def found in \"$autosetup(srcdir)\" (use [file tail $::autosetup(exe)] --init to create one)"
}
# Parse extra arguments into autosetup(cmdline)
@@ -167,6 +172,7 @@ proc main {argv} {
# Log how we were invoked
configlog "Invoked as: [getenv WRAPPER $::argv0] [quote-argv $autosetup(argv)]"
+ # Note that auto.def is *not* loaded in the global scope
source $autosetup(autodef)
# Could warn here if options {} was not specified
@@ -174,7 +180,11 @@ proc main {argv} {
show-notices
if {$autosetup(debug)} {
- parray define
+ msg-result "Writing all defines to config.log"
+ configlog "================ defines ======================"
+ foreach n [lsort [array names define]] {
+ configlog "define $n $define($n)"
+ }
}
exit 0
@@ -421,6 +431,10 @@ proc options {optlist} {
proc config_guess {} {
if {[file-isexec $::autosetup(dir)/config.guess]} {
exec-with-stderr sh $::autosetup(dir)/config.guess
+ if {[catch {exec-with-stderr sh $::autosetup(dir)/config.guess} alias]} {
+ user-error $alias
+ }
+ return $alias
} else {
configlog "No config.guess, so using uname"
string tolower [exec uname -p]-unknown-[exec uname -s][exec uname -r]
@@ -429,10 +443,11 @@ proc config_guess {} {
proc config_sub {alias} {
if {[file-isexec $::autosetup(dir)/config.sub]} {
- exec-with-stderr sh $::autosetup(dir)/config.sub $alias
- } else {
- return $alias
+ if {[catch {exec-with-stderr sh $::autosetup(dir)/config.sub $alias} alias]} {
+ user-error $alias
+ }
}
+ return $alias
}
# @define name ?value=1?
@@ -754,8 +769,13 @@ proc user-notice {msg} {
# Incorrect usage in the auto.def file. Identify the location.
proc autosetup-error {msg} {
+ autosetup-full-error [error-location $msg]
+}
+
+# Like autosetup-error, except $msg is the full error message.
+proc autosetup-full-error {msg} {
show-notices
- puts stderr [error-location $msg]
+ puts stderr $msg
exit 1
}
@@ -865,7 +885,14 @@ proc autosetup_add_dep {filename} {
# @use module ...
#
# Load the given library modules.
-# e.g. use cc cc-shared
+# e.g. 'use cc cc-shared'
+#
+# Note that module 'X' is implemented in either 'autosetup/X.tcl'
+# or 'autosetup/X/init.tcl'
+#
+# The latter form is useful for a complex module which requires additional
+# support file. In this form, '$::usedir' is set to the module directory
+# when it is loaded.
#
proc use {args} {
foreach m $args {
@@ -874,20 +901,36 @@ proc use {args} {
}
set ::libmodule($m) 1
if {[info exists ::modsource($m)]} {
- uplevel #0 eval $::modsource($m)
+ automf_load eval $::modsource($m)
} else {
- set source $::autosetup(libdir)/${m}.tcl
- if {[file exists $source]} {
- uplevel #0 [list source $source]
+ set sources [list $::autosetup(libdir)/${m}.tcl $::autosetup(libdir)/${m}/init.tcl]
+ set found 0
+ foreach source $sources {
+ if {[file exists $source]} {
+ incr found
+ break
+ }
+ }
+ if {$found} {
+ # For the convenience of the "use" source, point to the directory
+ # it is being loaded from
+ set ::usedir [file dirname $source]
+ automf_load source $source
autosetup_add_dep $source
} else {
- puts "Looking for $source"
autosetup-error "use: No such module: $m"
}
}
}
}
+# Load module source in the global scope by executing the given command
+proc automf_load {args} {
+ if {[catch [list uplevel #0 $args] msg opts] ni {0 2 3}} {
+ autosetup-full-error [error-dump $msg $opts]
+ }
+}
+
# Initial settings
set autosetup(exe) $::argv0
set autosetup(istcl) 1
@@ -1146,9 +1189,9 @@ proc autosetup_help {what} {
# If not already paged and stdout is a tty, pipe the output through the pager
# This is done by reinvoking autosetup with --nopager added
proc use_pager {} {
- if {![opt-bool nopager] && [getenv PAGER ""] ne "" && ![string match "not a tty" [exec tty]]} {
+ if {![opt-bool nopager] && [getenv PAGER ""] ne "" && [isatty? stdin] && [isatty? stdout]} {
catch {
- exec [info nameofexecutable] $::argv0 --nopager {*}$::argv | [getenv PAGER] >@stdout <@stdin 2>/dev/null
+ exec [info nameofexecutable] $::argv0 --nopager {*}$::argv |& [getenv PAGER] >@stdout <@stdin
}
exit 0
}
@@ -1278,55 +1321,56 @@ set modsource(init) {
# Module to help create auto.def and configure
-proc autosetup_init {} {
- set create_configure 1
- if {[file exists configure]} {
- if {!$::autosetup(force)} {
- # Could this be an autosetup configure?
- if {![string match "*\nWRAPPER=*" [readfile configure]]} {
- puts "I see configure, but not created by autosetup, so I won't overwrite it."
- puts "Use autosetup --init --force to overwrite."
- set create_configure 0
- }
- } else {
- puts "I will overwrite the existing configure because you used --force."
+proc autosetup_init {type} {
+ set help 0
+ if {$type in {? help}} {
+ incr help
+ } elseif {![dict exists $::autosetup(inittypes) $type]} {
+ puts "Unknown type, --init=$type"
+ incr help
+ }
+ if {$help} {
+ puts "Use one of the following types (e.g. --init=make)\n"
+ foreach type [lsort [dict keys $::autosetup(inittypes)]] {
+ lassign [dict get $::autosetup(inittypes) $type] desc
+ # XXX: Use the options-show code to wrap the description
+ puts [format "%-10s %s" $type $desc]
}
- } else {
- puts "I don't see configure, so I will create it."
+ exit 0
}
- if {$create_configure} {
- if {!$::autosetup(installed)} {
- user-notice "Warning: Initialising from the development version of autosetup"
+ lassign [dict get $::autosetup(inittypes) $type] desc script
- writefile configure "#!/bin/sh\nWRAPPER=\"\$0\" exec $::autosetup(dir)/autosetup \"\$@\"\n"
- } else {
- writefile configure \
-{#!/bin/sh
-dir="`dirname "$0"`/autosetup"
-WRAPPER="$0" exec "`$dir/find-tclsh`" "$dir/autosetup" "$@"
-}
- }
- catch {exec chmod 755 configure}
- }
- if {![file exists auto.def]} {
- puts "I don't see auto.def, so I will create a default one."
- writefile auto.def {# Initial auto.def created by 'autosetup --init'
+ puts "Initialising $type: $desc\n"
+
+ # All initialisations happens in the top level srcdir
+ cd $::autosetup(srcdir)
-use cc
+ uplevel #0 $script
-# Add any user options here
-options {
+ exit 0
}
-make-config-header config.h
-make-template Makefile.in
+proc autosetup_add_init_type {type desc script} {
+ dict set ::autosetup(inittypes) $type [list $desc $script]
}
- }
- if {![file exists Makefile.in]} {
- puts "Note: I don't see Makefile.in. You will probably need to create one."
- }
- exit 0
+# This is for in creating build-system init scripts
+#
+# If the file doesn't exist, create it containing $contents
+# If the file does exist, only overwrite if --force is specified.
+#
+proc autosetup_check_create {filename contents} {
+ if {[file exists $filename]} {
+ if {!$::autosetup(force)} {
+ puts "I see $filename already exists."
+ return
+ } else {
+ puts "I will overwrite the existing $filename because you used --force."
+ }
+ } else {
+ puts "I don't see $filename, so I will create it."
+ }
+ writefile $filename $contents
}
}
@@ -1345,7 +1389,7 @@ proc autosetup_install {dir} {
set f [open autosetup/autosetup w]
- set publicmodules {}
+ set publicmodules $::autosetup(libdir)/default.auto
# First the main script, but only up until "CUT HERE"
set in [open $::autosetup(dir)/autosetup]
@@ -1393,11 +1437,36 @@ proc autosetup_install {dir} {
user-error "Failed to install autosetup: $error"
}
puts "Installed [autosetup_version] to autosetup/"
- catch {exec [info nameofexecutable] autosetup/autosetup --init >@stdout 2>@stderr}
+
+ # Now create 'configure' if necessary
+ autosetup_create_configure
exit 0
}
+proc autosetup_create_configure {} {
+ if {[file exists configure]} {
+ if {!$::autosetup(force)} {
+ # Could this be an autosetup configure?
+ if {![string match "*\nWRAPPER=*" [readfile configure]]} {
+ puts "I see configure, but not created by autosetup, so I won't overwrite it."
+ puts "Remove it or use --force to overwrite."
+ return
+ }
+ } else {
+ puts "I will overwrite the existing configure because you used --force."
+ }
+ } else {
+ puts "I don't see configure, so I will create it."
+ }
+ writefile configure \
+{#!/bin/sh
+dir="`dirname "$0"`/autosetup"
+WRAPPER="$0"; export WRAPPER; exec "`$dir/find-tclsh`" "$dir/autosetup" "$@"
+}
+ catch {exec chmod 755 configure}
+}
+
# Append the contents of $file to filehandle $f
proc autosetup_install_append {f file} {
set in [open $file]
@@ -1541,15 +1610,28 @@ if {$autosetup(istcl)} {
}
return -code error "environment variable \"$name\" does not exist"
}
-} elseif {$autosetup(iswin)} {
- # On Windows, backslash convert all environment variables
- # (Assume that Tcl does this for us)
- proc getenv {name args} {
- string map {\\ /} [env $name {*}$args]
+ proc isatty? {channel} {
+ dict exists [fconfigure $channel] -xchar
}
} else {
- # Jim on unix is simple
- alias getenv env
+ if {$autosetup(iswin)} {
+ # On Windows, backslash convert all environment variables
+ # (Assume that Tcl does this for us)
+ proc getenv {name args} {
+ string map {\\ /} [env $name {*}$args]
+ }
+ } else {
+ # Jim on unix is simple
+ alias getenv env
+ }
+ proc isatty? {channel} {
+ set tty 0
+ catch {
+ # isatty is a recent addition to Jim Tcl
+ set tty [$channel isatty]
+ }
+ return $tty
+ }
}
# In case 'file normalize' doesn't exist
@@ -1598,46 +1680,42 @@ proc error-location {msg} {
return $msg
}
-# Similar to error-location, but called when user code generates an error
-# In this case we want to show the stack trace in user code, but not in autosetup code
-# (unless --debug is enabled)
+# If everything is working properly, the only errors which occur
+# should be generated in user code (e.g. auto.def).
+# By default, we only want to show the error location in user code.
+# We use [info frame] to achieve this, but it works differently on Tcl and Jim.
+#
+# This is designed to be called for incorrect usage in auto.def, via autosetup-error
#
proc error-stacktrace {msg} {
- if {$::autosetup(istcl)} {
- if {[regexp {file "([^ ]*)" line ([0-9]*)} $::errorInfo dummy file line]} {
- return "[relative-path $file]:$line $msg\n$::errorInfo"
- }
- return $::errorInfo
- } else {
- # Prepend a live stacktrace to the error stacktrace, omitting the current level
- set stacktrace [concat [info stacktrace] [lrange [stacktrace] 3 end]]
-
- if {!$::autosetup(debug)} {
- # Omit any levels from autosetup or with no file
- set newstacktrace {}
- foreach {p f l} $stacktrace {
- if {[string match "*autosetup" $f] || $f eq ""} {
- #puts "Skipping $p $f:$l"
- continue
- }
- lappend newstacktrace $p $f $l
- }
- set stacktrace $newstacktrace
- }
-
- # Convert filenames to relative paths
- set newstacktrace {}
- foreach {p f l} $stacktrace {
- lappend newstacktrace $p [relative-path $f] $l
- }
- lassign $newstacktrace p f l
- if {$f ne ""} {
- set prefix "$f:$l: "
+ if {$::autosetup(debug)} {
+ return -code error $msg
+ }
+ # Search back through the stack trace for the first error in a .def file
+ for {set i 1} {$i < [info level]} {incr i} {
+ if {$::autosetup(istcl)} {
+ array set info [info frame -$i]
} else {
- set prefix ""
+ lassign [info frame -$i] info(caller) info(file) info(line)
+ }
+ if {[string match *.def $info(file)]} {
+ return "[relative-path $info(file)]:$info(line): Error: $msg"
}
+ #puts "Skipping $info(file):$info(line)"
+ }
+ return $msg
+}
- return "${prefix}Error: $msg\n[stackdump $newstacktrace]"
+# Given the return from [catch {...} msg opts], returns an appropriate
+# error message. A nice one for Jim and a less-nice one for Tcl.
+#
+# This is designed for developer errors, e.g. in module code
+#
+proc error-dump {msg opts} {
+ if {$::autosetup(istcl)} {
+ return "Error: [dict get $opts -errorinfo]"
+ } else {
+ return "Error: $msg\n[stackdump $opts(-errorinfo)]"
}
}
}
diff --git a/autosetup/cc-lib.tcl b/autosetup/cc-lib.tcl
index e8e5e86..4df5130 100644
--- a/autosetup/cc-lib.tcl
+++ b/autosetup/cc-lib.tcl
@@ -75,3 +75,87 @@ proc cc-check-endian {} {
}
return $rc
}
+
+# @cc-check-flags flag ?...?
+#
+# Checks whether the given C/C++ compiler flags can be used. Defines feature
+# names prefixed with 'HAVE_CFLAG' and 'HAVE_CXXFLAG' respectively, and
+# appends working flags to '-cflags' and 'CFLAGS' or 'CXXFLAGS'.
+proc cc-check-flags {args} {
+ set result 1
+ array set opts [cc-get-settings]
+ switch -exact -- $opts(-lang) {
+ c++ {
+ set lang C++
+ set prefix CXXFLAG
+ }
+ c {
+ set lang C
+ set prefix CFLAG
+ }
+ default {
+ autosetup-error "cc-check-flags failed with unknown language: $opts(-lang)"
+ }
+ }
+ foreach flag $args {
+ msg-checking "Checking whether the $lang compiler accepts $flag..."
+ if {[cctest -cflags $flag]} {
+ msg-result yes
+ define-feature $prefix$flag
+ cc-with [list -cflags [list $flag]]
+ define-append ${prefix}S $flag
+ } else {
+ msg-result no
+ set result 0
+ }
+ }
+ return $result
+}
+
+# @cc-check-standards ver ?...?
+#
+# Checks whether the C/C++ compiler accepts one of the specified '-std=$ver'
+# options, and appends the first working one to '-cflags' and 'CFLAGS' or
+# 'CXXFLAGS'.
+proc cc-check-standards {args} {
+ array set opts [cc-get-settings]
+ foreach std $args {
+ if {[cc-check-flags -std=$std]} {
+ return $std
+ }
+ }
+ return ""
+}
+
+# Checks whether $keyword is usable as alignof
+proc cctest_alignof {keyword} {
+ msg-checking "Checking for $keyword..."
+ if {[cctest -code [subst -nobackslashes {
+ printf("minimum alignment is %d == %d\n", ${keyword}(char), ${keyword}('x'));
+ }]]} then {
+ msg-result ok
+ define-feature $keyword
+ } else {
+ msg-result "not found"
+ }
+}
+
+# @cc-check-c11
+#
+# Checks for several C11/C++11 extensions and their alternatives. Currently
+# checks for '_Static_assert', '_Alignof', '__alignof__', '__alignof'.
+proc cc-check-c11 {} {
+ msg-checking "Checking for _Static_assert..."
+ if {[cctest -code {
+ _Static_assert(1, "static assertions are available");
+ }]} then {
+ msg-result ok
+ define-feature _Static_assert
+ } else {
+ msg-result "not found"
+ }
+
+ cctest_alignof _Alignof
+ cctest_alignof __alignof__
+ cctest_alignof __alignof
+}
diff --git a/autosetup/cc-shared.tcl b/autosetup/cc-shared.tcl
index 1ff9071..b9ae29d 100644
--- a/autosetup/cc-shared.tcl
+++ b/autosetup/cc-shared.tcl
@@ -7,70 +7,95 @@
# It defines the following variables:
#
## SH_CFLAGS Flags to use compiling sources destined for a shared library
-## SH_LDFLAGS Flags to use linking a shared library
+## SH_LDFLAGS Flags to use linking (creating) a shared library
+## SH_SOPREFIX Prefix to use to set the soname when creating a shared library
+## SH_SOEXT Extension for shared libs
+## SH_SOEXTVER Format for versioned shared libs - %s = version
## SHOBJ_CFLAGS Flags to use compiling sources destined for a shared object
## SHOBJ_LDFLAGS Flags to use linking a shared object, undefined symbols allowed
## SHOBJ_LDFLAGS_R - as above, but all symbols must be resolved
## SH_LINKFLAGS Flags to use linking an executable which will load shared objects
## LD_LIBRARY_PATH Environment variable which specifies path to shared libraries
+## STRIPLIBFLAGS Arguments to strip to strip a dynamic library
module-options {}
-foreach i {SH_LINKFLAGS SH_CFLAGS SH_LDFLAGS SHOBJ_CFLAGS SHOBJ_LDFLAGS} {
- define $i ""
-}
-
+# Defaults: gcc on unix
+define SHOBJ_CFLAGS -fpic
+define SHOBJ_LDFLAGS -shared
+define SH_CFLAGS -fpic
+define SH_LDFLAGS -shared
+define SH_LINKFLAGS -rdynamic
+define SH_SOEXT .so
+define SH_SOEXTVER .so.%s
+define SH_SOPREFIX -Wl,-soname,
define LD_LIBRARY_PATH LD_LIBRARY_PATH
+define STRIPLIBFLAGS --strip-unneeded
+
+# Note: This is a helpful reference for identifying the toolchain
+# http://sourceforge.net/apps/mediawiki/predef/index.php?title=Compilers
switch -glob -- [get-define host] {
*-*-darwin* {
- define SH_CFLAGS -dynamic
- define SH_LDFLAGS "-dynamiclib"
define SHOBJ_CFLAGS "-dynamic -fno-common"
define SHOBJ_LDFLAGS "-bundle -undefined dynamic_lookup"
- define SHOBJ_LDFLAGS_R "-bundle"
+ define SHOBJ_LDFLAGS_R -bundle
+ define SH_CFLAGS -dynamic
+ define SH_LDFLAGS -dynamiclib
+ define SH_LINKFLAGS ""
+ define SH_SOEXT .dylib
+ define SH_SOEXTVER .%s.dylib
+ define SH_SOPREFIX -Wl,-install_name,
define LD_LIBRARY_PATH DYLD_LIBRARY_PATH
+ define STRIPLIBFLAGS -x
}
- *-*-ming* {
- define SH_LDFLAGS -shared
+ *-*-ming* - *-*-cygwin - *-*-msys {
+ define SHOBJ_CFLAGS ""
define SHOBJ_LDFLAGS -shared
- define SHOBJ_LDFLAGS_R -shared
- }
- *-*-cygwin {
+ define SH_CFLAGS ""
define SH_LDFLAGS -shared
- define SHOBJ_LDFLAGS -shared
+ define SH_LINKFLAGS ""
+ define SH_SOEXT .dll
+ define SH_SOEXTVER .dll
+ define SH_SOPREFIX ""
+ define LD_LIBRARY_PATH PATH
+ }
+ sparc* {
+ if {[msg-quiet cc-check-decls __SUNPRO_C]} {
+ msg-result "Found sun stdio compiler"
+ # sun stdio compiler
+ # XXX: These haven't been fully tested.
+ define SHOBJ_CFLAGS -KPIC
+ define SHOBJ_LDFLAGS "-G"
+ define SH_CFLAGS -KPIC
+ define SH_LINKFLAGS -Wl,-export-dynamic
+ define SH_SOPREFIX -Wl,-h,
+ } else {
+ # sparc has a very small GOT table limit, so use -fPIC
+ define SH_CFLAGS -fPIC
+ define SHOBJ_CFLAGS -fPIC
+ }
}
*-*-solaris* {
- # XXX: These haven't been fully tested.
- #define SH_LINKFLAGS -Wl,-export-dynamic
- define SH_CFLAGS -Kpic
- define SHOBJ_CFLAGS -Kpic
- define SHOBJ_LDFLAGS "-G"
+ if {[msg-quiet cc-check-decls __SUNPRO_C]} {
+ msg-result "Found sun stdio compiler"
+ # sun stdio compiler
+ # XXX: These haven't been fully tested.
+ define SHOBJ_CFLAGS -KPIC
+ define SHOBJ_LDFLAGS "-G"
+ define SH_CFLAGS -KPIC
+ define SH_LINKFLAGS -Wl,-export-dynamic
+ define SH_SOPREFIX -Wl,-h,
+ }
}
*-*-hpux {
# XXX: These haven't been tested
- define SH_LINKFLAGS -Wl,+s
- define SH_CFLAGS +z
define SHOBJ_CFLAGS "+O3 +z"
define SHOBJ_LDFLAGS -b
+ define SH_CFLAGS +z
+ define SH_LINKFLAGS -Wl,+s
define LD_LIBRARY_PATH SHLIB_PATH
}
- sparc* {
- # sparc has a very small GOT table limit, so use -fPIC
- define SH_LINKFLAGS -rdynamic
- define SH_CFLAGS -fPIC
- define SH_LDFLAGS -shared
- define SHOBJ_CFLAGS -fPIC
- define SHOBJ_LDFLAGS -shared
- }
- * {
- # Generic Unix settings
- define SH_LINKFLAGS -rdynamic
- define SH_CFLAGS -fpic
- define SH_LDFLAGS -shared
- define SHOBJ_CFLAGS -fpic
- define SHOBJ_LDFLAGS -shared
- }
}
if {![is-defined SHOBJ_LDFLAGS_R]} {
diff --git a/autosetup/cc.tcl b/autosetup/cc.tcl
index a046184..cd033c6 100644
--- a/autosetup/cc.tcl
+++ b/autosetup/cc.tcl
@@ -116,7 +116,7 @@ proc cc-check-includes {args} {
set with {}
if {[dict exists $::autosetup(cc-include-deps) $each]} {
set deps [dict keys [dict get $::autosetup(cc-include-deps) $each]]
- msg-quiet cc-check-includes $deps
+ msg-quiet cc-check-includes {*}$deps
foreach i $deps {
if {[have-feature $i]} {
lappend with $i
@@ -133,12 +133,14 @@ proc cc-check-includes {args} {
}
}
-# @cc-include-needs include required
+# @cc-include-needs include required ...
#
# Ensures that when checking for 'include', a check is first
-# made for 'required', and if found, it is #included
-proc cc-include-needs {file depfile} {
- dict set ::autosetup(cc-include-deps) $file $depfile 1
+# made for each 'required' file, and if found, it is #included
+proc cc-include-needs {file args} {
+ foreach depfile $args {
+ dict set ::autosetup(cc-include-deps) $file $depfile 1
+ }
}
# @cc-check-types type ...
@@ -256,6 +258,8 @@ proc cc-check-function-in-lib {function libs {otherlibs {}}} {
# simply "ar" is assumed depending upon whether cross compiling.
# The path is searched for this executable, and if found AR is defined
# to the executable name.
+# Note that even when cross compiling, the simple "ar" is used as a fallback,
+# but a warning is generated. This is necessary for some toolchains.
#
# It is an error if the executable is not found.
#
@@ -263,10 +267,16 @@ proc cc-check-tools {args} {
foreach tool $args {
set TOOL [string toupper $tool]
set exe [get-env $TOOL [get-define cross]$tool]
- if {![find-executable $exe]} {
- user-error "Failed to find $exe"
+ if {[find-executable {*}$exe]} {
+ define $TOOL $exe
+ continue
+ }
+ if {[find-executable {*}$tool]} {
+ msg-result "Warning: Failed to find $exe, falling back to $tool which may be incorrect"
+ define $TOOL $tool
+ continue
}
- define $TOOL $exe
+ user-error "Failed to find $exe"
}
}
@@ -491,14 +501,8 @@ proc cctest {args} {
set tmp conftest__.o
lappend cmdline -c
}
- lappend cmdline {*}$opts(-cflags)
+ lappend cmdline {*}$opts(-cflags) {*}[get-define cc-default-debug ""]
- switch -glob -- [get-define host] {
- *-*-darwin* {
- # Don't generate .dSYM directories
- lappend cmdline -gstabs
- }
- }
lappend cmdline $src -o $tmp {*}$opts(-libs)
# At this point we have the complete command line and the
@@ -589,7 +593,7 @@ proc make-config-header {file args} {
continue
}
-str {
- set value \"$value\"
+ set value \"[string map [list \\ \\\\ \" \\\"] $value]\"
}
-auto {
# Automatically determine the type
@@ -598,7 +602,7 @@ proc make-config-header {file args} {
continue
}
if {![string is integer -strict $value]} {
- set value \"$value\"
+ set value \"[string map [list \\ \\\\ \" \\\"] $value]\"
}
}
"" {
@@ -659,8 +663,6 @@ if {[env-is-set CXX]} {
# CXXFLAGS default to CFLAGS if not specified
define CXXFLAGS [get-env CXXFLAGS [get-define CFLAGS]]
-cc-check-tools ld
-
# May need a CC_FOR_BUILD, so look for one
define CC_FOR_BUILD [find-an-executable [get-env CC_FOR_BUILD ""] cc gcc false]
@@ -680,6 +682,16 @@ if {[get-define CXX] ne "false"} {
}
msg-result "Build C compiler...[get-define CC_FOR_BUILD]"
+# On Darwin, we prefer to use -gstabs to avoid creating .dSYM directories
+# but some compilers don't support -gstabs, so test for it here.
+switch -glob -- [get-define host] {
+ *-*-darwin* {
+ if {[cctest -cflags {-gstabs}]} {
+ define cc-default-debug -gstabs
+ }
+ }
+}
+
if {![cc-check-includes stdlib.h]} {
user-error "Compiler does not work. See config.log"
}
diff --git a/autosetup/config.guess b/autosetup/config.guess
index 4c8f032..089ebcc 100755
--- a/autosetup/config.guess
+++ b/autosetup/config.guess
@@ -804,6 +804,9 @@ EOF
*:MINGW*:*)
echo ${UNAME_MACHINE}-pc-mingw32
exit ;;
+ i*:MSYS*:*)
+ echo ${UNAME_MACHINE}-pc-msys
+ exit ;;
i*:windows32*:*)
# uname -m includes "-pc" on this system.
echo ${UNAME_MACHINE}-mingw32
diff --git a/autosetup/config.sub b/autosetup/config.sub
index 320e303..a09498f 100755
--- a/autosetup/config.sub
+++ b/autosetup/config.sub
@@ -798,6 +798,10 @@ case $basic_machine in
basic_machine=i370-ibm
os=-mvs
;;
+ msys)
+ basic_machine=i386-pc
+ os=-msys
+ ;;
ncr3000)
basic_machine=i486-ncr
os=-sysv4
@@ -1315,7 +1319,7 @@ case $os in
| -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
| -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
| -chorusos* | -chorusrdb* | -cegcc* \
- | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
+ | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
| -mingw32* | -linux-gnu* | -linux-android* \
| -linux-newlib* | -linux-uclibc* \
| -uxpv* | -beos* | -mpeix* | -udk* \
diff --git a/autosetup/default.auto b/autosetup/default.auto
new file mode 100644
index 0000000..b36e0f8
--- /dev/null
+++ b/autosetup/default.auto
@@ -0,0 +1,25 @@
+# Copyright (c) 2012 WorkWare Systems http://www.workware.net.au/
+# All rights reserved
+
+# Auto-load module for 'make' build system integration
+
+use init
+
+autosetup_add_init_type make {Simple "make" build system} {
+ autosetup_check_create auto.def \
+{# Initial auto.def created by 'autosetup --init=make'
+
+use cc
+
+# Add any user options here
+options {
+}
+
+make-config-header config.h
+make-template Makefile.in
+}
+
+ if {![file exists Makefile.in]} {
+ puts "Note: I don't see Makefile.in. You will probably need to create one."
+ }
+}
diff --git a/autosetup/jimsh0.c b/autosetup/jimsh0.c
index 3bf6947..bdc72e5 100644
--- a/autosetup/jimsh0.c
+++ b/autosetup/jimsh0.c
@@ -39,6 +39,7 @@
#define TCL_PLATFORM_PATH_SEPARATOR ":"
#define HAVE_VFORK
#define HAVE_WAITPID
+#define HAVE_ISATTY
#define HAVE_SYS_TIME_H
#define HAVE_DIRENT_H
#define HAVE_UNISTD_H
@@ -534,6 +535,7 @@ typedef struct Jim_Interp {
Jim_Obj *liveList;
Jim_Obj *freeList;
Jim_Obj *currentScriptObj;
+ Jim_Obj *nullScriptObj;
Jim_Obj *emptyObj;
Jim_Obj *trueObj;
Jim_Obj *falseObj;
@@ -1081,124 +1083,180 @@ int Jim_globInit(Jim_Interp *interp)
"\n"
"\n"
"\n"
-"package require readdir\n"
"\n"
+"package require readdir\n"
"\n"
"\n"
+"proc glob.globdir {dir pattern} {\n"
+" set result {}\n"
+" set files [readdir $dir]\n"
+" lappend files . ..\n"
"\n"
+" foreach name $files {\n"
+" if {[string match $pattern $name]} {\n"
"\n"
+" if {[string index $name 0] eq \".\" && [string index $pattern 0] ne \".\"} {\n"
+" continue\n"
+" }\n"
+" lappend result $name\n"
+" }\n"
+" }\n"
"\n"
+" return $result\n"
+"}\n"
"\n"
"\n"
"\n"
"\n"
+"proc glob.explode {pattern} {\n"
+" set oldexp {}\n"
+" set newexp {\"\"}\n"
"\n"
+" while 1 {\n"
+" set oldexp $newexp\n"
+" set newexp {}\n"
+" set ob [string first \\{ $pattern]\n"
+" set cb [string first \\} $pattern]\n"
"\n"
-"proc glob {args} {\n"
+" if {$ob < $cb && $ob != -1} {\n"
+" set mid [string range $pattern 0 $ob-1]\n"
+" set subexp [lassign [glob.explode [string range $pattern $ob+1 end]] pattern]\n"
+" if {$pattern eq \"\"} {\n"
+" error \"unmatched open brace in glob pattern\"\n"
+" }\n"
+" set pattern [string range $pattern 1 end]\n"
"\n"
+" foreach subs $subexp {\n"
+" foreach sub [split $subs ,] {\n"
+" foreach old $oldexp {\n"
+" lappend newexp $old$mid$sub\n"
+" }\n"
+" }\n"
+" }\n"
+" } elseif {$cb != -1} {\n"
+" set suf [string range $pattern 0 $cb-1]\n"
+" set rest [string range $pattern $cb end]\n"
+" break\n"
+" } else {\n"
+" set suf $pattern\n"
+" set rest \"\"\n"
+" break\n"
+" }\n"
+" }\n"
"\n"
+" foreach old $oldexp {\n"
+" lappend newexp $old$suf\n"
+" }\n"
+" linsert $newexp 0 $rest\n"
+"}\n"
"\n"
"\n"
-" local proc glob.readdir_pattern {dir pattern} {\n"
-" set result {}\n"
"\n"
+"proc glob.glob {base pattern} {\n"
+" set dir [file dirname $pattern]\n"
+" if {$pattern eq $dir || $pattern eq \"\"} {\n"
+" return [list [file join $base $dir] $pattern]\n"
+" } elseif {$pattern eq [file tail $pattern]} {\n"
+" set dir \"\"\n"
+" }\n"
"\n"
-" if {$pattern in {. ..}} {\n"
-" return $pattern\n"
-" }\n"
"\n"
+" set dirlist [glob.glob $base $dir]\n"
+" set pattern [file tail $pattern]\n"
"\n"
-" if {[string match {*[[*?]*} $pattern]} {\n"
"\n"
-" set files [readdir -nocomplain $dir]\n"
-" } elseif {[file isdir $dir] && [file exists $dir/$pattern]} {\n"
-" set files [list $pattern]\n"
-" } else {\n"
-" set files \"\"\n"
+" set result {}\n"
+" foreach {realdir dir} $dirlist {\n"
+" if {![file isdir $realdir]} {\n"
+" continue\n"
" }\n"
-"\n"
-" foreach name $files {\n"
-" if {[string match $pattern $name]} {\n"
-"\n"
-" if {[string index $name 0] eq \".\" && [string index $pattern 0] ne \".\"} {\n"
-" continue\n"
-" }\n"
-" lappend result $name\n"
-" }\n"
+" if {[string index $dir end] ne \"/\" && $dir ne \"\"} {\n"
+" append dir /\n"
+" }\n"
+" foreach name [glob.globdir $realdir $pattern] {\n"
+" lappend result [file join $realdir $name] $dir$name\n"
" }\n"
-"\n"
-" return $result\n"
" }\n"
+" return $result\n"
+"}\n"
"\n"
"\n"
"\n"
"\n"
"\n"
-" proc glob.expandbraces {pattern} {\n"
"\n"
"\n"
-" if {[set fb [string first \"\\{\" $pattern]] < 0} {\n"
-" return [list $pattern]\n"
-" }\n"
-" if {[set nb [string first \"\\}\" $pattern $fb]] < 0} {\n"
-" return [list $pattern]\n"
-" }\n"
-" set before [string range $pattern 0 $fb-1]\n"
-" set braced [string range $pattern $fb+1 $nb-1]\n"
-" set after [string range $pattern $nb+1 end]\n"
"\n"
-" lmap part [split $braced ,] {\n"
-" set pat $before$part$after\n"
-" }\n"
-" }\n"
"\n"
"\n"
-" proc glob.glob {pattern} {\n"
-" set dir [file dirname $pattern]\n"
-" if {$dir eq $pattern} {\n"
"\n"
-" return [list $dir]\n"
-" }\n"
"\n"
+"proc glob {args} {\n"
+" set nocomplain 0\n"
+" set base \"\"\n"
"\n"
-" set dirlist [glob.glob $dir]\n"
-" set pattern [file tail $pattern]\n"
+" set n 0\n"
+" foreach arg $args {\n"
+" if {[info exists param]} {\n"
+" set $param $arg\n"
+" unset param\n"
+" incr n\n"
+" continue\n"
+" }\n"
+" switch -glob -- $arg {\n"
+" -d* {\n"
+" set switch $arg\n"
+" set param base\n"
+" }\n"
+" -n* {\n"
+" set nocomplain 1\n"
+" }\n"
+" -t* {\n"
"\n"
+" }\n"
"\n"
-" set result {}\n"
-" foreach dir $dirlist {\n"
-" set globdir $dir\n"
-" if {[string match \"*/\" $dir]} {\n"
-" set sep \"\"\n"
-" } elseif {$dir eq \".\"} {\n"
-" set globdir \"\"\n"
-" set sep \"\"\n"
-" } else {\n"
-" set sep /\n"
+" -* {\n"
+" return -code error \"bad option \\\"$switch\\\": must be -directory, -nocomplain, -tails, or --\"\n"
" }\n"
-" foreach pat [glob.expandbraces $pattern] {\n"
-" foreach name [glob.readdir_pattern $dir $pat] {\n"
-" lappend result $globdir$sep$name\n"
-" }\n"
+" -- {\n"
+" incr n\n"
+" break\n"
+" }\n"
+" * {\n"
+" break\n"
" }\n"
" }\n"
-" return $result\n"
+" incr n\n"
" }\n"
-"\n"
-"\n"
-" set nocomplain 0\n"
-"\n"
-" if {[lindex $args 0] eq \"-nocomplain\"} {\n"
-" set nocomplain 1\n"
-" set args [lrange $args 1 end]\n"
+" if {[info exists param]} {\n"
+" return -code error \"missing argument to \\\"$switch\\\"\"\n"
+" }\n"
+" if {[llength $args] <= $n} {\n"
+" return -code error \"wrong # args: should be \\\"glob ?options? pattern ?pattern ...?\\\"\"\n"
" }\n"
"\n"
+" set args [lrange $args $n end]\n"
+"\n"
" set result {}\n"
" foreach pattern $args {\n"
-" lappend result {*}[glob.glob $pattern]\n"
+" set pattern [string map {\n"
+" \\\\\\\\ \\x01 \\\\\\{ \\x02 \\\\\\} \\x03 \\\\, \\x04\n"
+" } $pattern]\n"
+" set patexps [lassign [glob.explode $pattern] rest]\n"
+" if {$rest ne \"\"} {\n"
+" return -code error \"unmatched close brace in glob pattern\"\n"
+" }\n"
+" foreach patexp $patexps {\n"
+" set patexp [string map {\n"
+" \\x01 \\\\\\\\ \\x02 \\{ \\x03 \\} \\x04 ,\n"
+" } $patexp]\n"
+" foreach {realname name} [glob.glob $base $patexp] {\n"
+" lappend result $name\n"
+" }\n"
+" }\n"
" }\n"
"\n"
-" if {$nocomplain == 0 && [llength $result] == 0} {\n"
+" if {!$nocomplain && [llength $result] == 0} {\n"
" return -code error \"no files matched glob patterns\"\n"
" }\n"
"\n"
@@ -1631,6 +1689,7 @@ int Jim_tclcompatInit(Jim_Interp *interp)
}
+
#include <stdio.h>
#include <string.h>
#include <errno.h>
@@ -1654,6 +1713,13 @@ int Jim_tclcompatInit(Jim_Interp *interp)
#define AIO_CMD_LEN 32
#define AIO_BUF_LEN 256
+#ifndef HAVE_FTELLO
+ #define ftello ftell
+#endif
+#ifndef HAVE_FSEEKO
+ #define fseeko fseek
+#endif
+
#define AIO_KEEPOPEN 1
#if defined(JIM_IPV6)
@@ -1937,6 +2003,18 @@ static int aio_cmd_puts(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
return JIM_ERR;
}
+static int aio_cmd_isatty(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
+{
+#ifdef HAVE_ISATTY
+ AioFile *af = Jim_CmdPrivData(interp);
+ Jim_SetResultInt(interp, isatty(fileno(af->fp)));
+#else
+ Jim_SetResultInt(interp, 0);
+#endif
+
+ return JIM_OK;
+}
+
static int aio_cmd_flush(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
{
@@ -1967,7 +2045,7 @@ static int aio_cmd_seek(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
{
AioFile *af = Jim_CmdPrivData(interp);
int orig = SEEK_SET;
- long offset;
+ jim_wide offset;
if (argc == 2) {
if (Jim_CompareStringImmediate(interp, argv[1], "start"))
@@ -1980,10 +2058,10 @@ static int aio_cmd_seek(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
return -1;
}
}
- if (Jim_GetLong(interp, argv[0], &offset) != JIM_OK) {
+ if (Jim_GetWide(interp, argv[0], &offset) != JIM_OK) {
return JIM_ERR;
}
- if (fseek(af->fp, offset, orig) == -1) {
+ if (fseeko(af->fp, offset, orig) == -1) {
JimAioSetError(interp, af->filename);
return JIM_ERR;
}
@@ -1994,7 +2072,7 @@ static int aio_cmd_tell(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
{
AioFile *af = Jim_CmdPrivData(interp);
- Jim_SetResultInt(interp, ftell(af->fp));
+ Jim_SetResultInt(interp, ftello(af->fp));
return JIM_OK;
}
@@ -2170,6 +2248,13 @@ static const jim_subcmd_type aio_command_table[] = {
2,
},
+ { "isatty",
+ NULL,
+ aio_cmd_isatty,
+ 0,
+ 0,
+
+ },
{ "flush",
NULL,
aio_cmd_flush,
@@ -3050,7 +3135,9 @@ static int file_cmd_dirname(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
const char *path = Jim_String(argv[0]);
const char *p = strrchr(path, '/');
- if (!p) {
+ if (!p && path[0] == '.' && path[1] == '.' && path[2] == '\0') {
+ Jim_SetResultString(interp, "..", -1);
+ } else if (!p) {
Jim_SetResultString(interp, ".", -1);
}
else if (p == path) {
@@ -3118,12 +3205,13 @@ static int file_cmd_normalize(Jim_Interp *interp, int argc, Jim_Obj *const *argv
if (realpath(path, newname)) {
Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, newname, -1));
+ return JIM_OK;
}
else {
Jim_Free(newname);
- Jim_SetResult(interp, argv[0]);
+ Jim_SetResultFormatted(interp, "can't normalize \"%#s\": %s", argv[0], strerror(errno));
+ return JIM_ERR;
}
- return JIM_OK;
#else
Jim_SetResultString(interp, "Not implemented", -1);
return JIM_ERR;
@@ -4936,7 +5024,7 @@ static char **JimSaveEnv(char **env)
static void JimRestoreEnv(char **env)
{
- JimFreeEnv(env, NULL);
+ JimFreeEnv(env, Jim_GetEnviron());
}
static Jim_Obj *
@@ -5872,11 +5960,98 @@ static int JimCheckConversion(const char *str, const char *endptr)
return JIM_OK;
}
+static int JimNumberBase(const char *str, int *base, int *sign)
+{
+ int i = 0;
+
+ *base = 10;
+
+ while (isspace(UCHAR(str[i]))) {
+ i++;
+ }
+
+ if (str[i] == '-') {
+ *sign = -1;
+ i++;
+ }
+ else {
+ if (str[i] == '+') {
+ i++;
+ }
+ *sign = 1;
+ }
+
+ if (str[i] != '0') {
+
+ return 0;
+ }
+
+
+ switch (str[i + 1]) {
+ case 'x': case 'X': *base = 16; break;
+ case 'o': case 'O': *base = 8; break;
+ case 'b': case 'B': *base = 2; break;
+ default: return 0;
+ }
+ i += 2;
+
+ if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
+
+ return i;
+ }
+
+ return 10;
+}
+
+static long jim_strtol(const char *str, char **endptr)
+{
+ int sign;
+ int base;
+ int i = JimNumberBase(str, &base, &sign);
+
+ if (base != 10) {
+ long value = strtol(str + i, endptr, base);
+ if (endptr == NULL || *endptr != str + i) {
+ return value * sign;
+ }
+ }
+
+
+ return strtol(str, endptr, 10);
+}
+
+
+static jim_wide jim_strtoull(const char *str, char **endptr)
+{
+#ifdef HAVE_LONG_LONG
+ int sign;
+ int base;
+ int i = JimNumberBase(str, &base, &sign);
+
+ if (base != 10) {
+ jim_wide value = strtoull(str + i, endptr, base);
+ if (endptr == NULL || *endptr != str + i) {
+ return value * sign;
+ }
+ }
+
+
+ return strtoull(str, endptr, 10);
+#else
+ return (unsigned long)jim_strtol(str, endptr);
+#endif
+}
+
int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
{
char *endptr;
- *widePtr = strtoull(str, &endptr, base);
+ if (base) {
+ *widePtr = strtoull(str, &endptr, base);
+ }
+ else {
+ *widePtr = jim_strtoull(str, &endptr);
+ }
return JimCheckConversion(str, endptr);
}
@@ -7392,23 +7567,6 @@ void Jim_InvalidateStringRep(Jim_Obj *objPtr)
objPtr->bytes = NULL;
}
-#define Jim_SetStringRep(o, b, l) \
- do { (o)->bytes = b; (o)->length = l; } while (0)
-
-void Jim_InitStringRep(Jim_Obj *objPtr, const char *bytes, int length)
-{
- if (length == 0) {
- objPtr->bytes = JimEmptyStringRep;
- objPtr->length = 0;
- }
- else {
- objPtr->bytes = Jim_Alloc(length + 1);
- objPtr->length = length;
- memcpy(objPtr->bytes, bytes, length);
- objPtr->bytes[length] = '\0';
- }
-}
-
Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
{
@@ -7419,8 +7577,18 @@ Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
dupPtr->bytes = NULL;
}
+ else if (objPtr->length == 0) {
+
+ dupPtr->bytes = JimEmptyStringRep;
+ dupPtr->length = 0;
+ dupPtr->typePtr = NULL;
+ return dupPtr;
+ }
else {
- Jim_InitStringRep(dupPtr, objPtr->bytes, objPtr->length);
+ dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
+ dupPtr->length = objPtr->length;
+
+ memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
}
@@ -7598,9 +7766,8 @@ Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
{
Jim_Obj *objPtr = Jim_NewObj(interp);
- if (len == -1)
- len = strlen(s);
- Jim_SetStringRep(objPtr, s, len);
+ objPtr->bytes = s;
+ objPtr->length = len == -1 ? strlen(s) : len;
objPtr->typePtr = NULL;
return objPtr;
}
@@ -7820,7 +7987,7 @@ Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
return NULL;
}
- if (last <= first) {
+ if (last < first) {
return strObjPtr;
}
@@ -8171,7 +8338,7 @@ void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
{
- dupPtr->internalRep = srcPtr->internalRep;
+ dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
}
@@ -8179,7 +8346,7 @@ static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
Jim_Obj *fileNameObj, int lineNumber)
{
JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
- JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typePtr != NULL"));
+ JimPanic((objPtr->typePtr == &sourceObjType, "JimSetSourceInfo called with non-source object"));
Jim_IncrRefCount(fileNameObj);
objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
objPtr->internalRep.sourceValue.lineNumber = lineNumber;
@@ -8559,9 +8726,12 @@ static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, struct J
ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
{
- struct ScriptObj *script = Jim_GetIntRepPtr(objPtr);
+ if (objPtr == interp->emptyObj) {
+
+ objPtr = interp->nullScriptObj;
+ }
- if (objPtr->typePtr != &scriptObjType || script->substFlags) {
+ if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
SetScriptFromAny(interp, objPtr, NULL);
}
return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
@@ -10047,12 +10217,14 @@ Jim_Interp *Jim_CreateInterp(void)
i->unknown = Jim_NewStringObj(i, "unknown", -1);
i->errorProc = i->emptyObj;
i->currentScriptObj = Jim_NewEmptyStringObj(i);
+ i->nullScriptObj = Jim_NewEmptyStringObj(i);
Jim_IncrRefCount(i->emptyObj);
Jim_IncrRefCount(i->errorFileNameObj);
Jim_IncrRefCount(i->result);
Jim_IncrRefCount(i->stackTrace);
Jim_IncrRefCount(i->unknown);
Jim_IncrRefCount(i->currentScriptObj);
+ Jim_IncrRefCount(i->nullScriptObj);
Jim_IncrRefCount(i->errorProc);
Jim_IncrRefCount(i->trueObj);
Jim_IncrRefCount(i->falseObj);
@@ -10086,6 +10258,7 @@ void Jim_FreeInterp(Jim_Interp *i)
Jim_DecrRefCount(i, i->unknown);
Jim_DecrRefCount(i, i->errorFileNameObj);
Jim_DecrRefCount(i, i->currentScriptObj);
+ Jim_DecrRefCount(i, i->nullScriptObj);
Jim_FreeHashTable(&i->commands);
#ifdef JIM_REFERENCES
Jim_FreeHashTable(&i->references);
@@ -10161,7 +10334,7 @@ Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
if (str[0] == '#') {
char *endptr;
- level = strtol(str + 1, &endptr, 0);
+ level = jim_strtol(str + 1, &endptr);
if (str[1] == '\0' || endptr[0] != '\0') {
level = -1;
}
@@ -10824,9 +10997,7 @@ static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
return JIM_OK;
}
-#if 0
-
- if (Jim_IsDict(objPtr)) {
+ if (Jim_IsDict(objPtr) && !Jim_IsShared(objPtr)) {
Jim_Obj **listObjPtrPtr;
int len;
int i;
@@ -10845,7 +11016,6 @@ static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
return JIM_OK;
}
-#endif
if (objPtr->typePtr == &sourceObjType) {
@@ -10868,16 +11038,18 @@ static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
objPtr->internalRep.listValue.ele = NULL;
- JimParserInit(&parser, str, strLen, linenr);
- while (!parser.eof) {
- Jim_Obj *elementPtr;
+ if (strLen) {
+ JimParserInit(&parser, str, strLen, linenr);
+ while (!parser.eof) {
+ Jim_Obj *elementPtr;
- JimParseList(&parser);
- if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
- continue;
- elementPtr = JimParserGetTokenObj(interp, &parser);
- JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
- ListAppendElement(objPtr, elementPtr);
+ JimParseList(&parser);
+ if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
+ continue;
+ elementPtr = JimParserGetTokenObj(interp, &parser);
+ JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
+ ListAppendElement(objPtr, elementPtr);
+ }
}
Jim_DecrRefCount(interp, fileNameObj);
return JIM_OK;
@@ -11684,7 +11856,7 @@ int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
idx = 0;
}
else {
- idx = strtol(str, &endptr, 0);
+ idx = jim_strtol(str, &endptr);
if (endptr == str) {
goto badindex;
@@ -11696,7 +11868,7 @@ int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
if (*str == '+' || *str == '-') {
int sign = (*str == '+' ? 1 : -1);
- idx += sign * strtol(++str, &endptr, 0);
+ idx += sign * jim_strtol(++str, &endptr);
if (str == endptr || *endptr) {
goto badindex;
}
@@ -12771,28 +12943,53 @@ singlechar:
static int JimParseExprNumber(struct JimParserCtx *pc)
{
int allowdot = 1;
- int allowhex = 0;
+ int base = 10;
pc->tt = JIM_TT_EXPR_INT;
pc->tstart = pc->p;
pc->tline = pc->linenr;
+
+
+ if (pc->p[0] == '0') {
+ switch (pc->p[1]) {
+ case 'x':
+ case 'X':
+ base = 16;
+ allowdot = 0;
+ pc->p += 2;
+ pc->len -= 2;
+ break;
+ case 'o':
+ case 'O':
+ base = 8;
+ allowdot = 0;
+ pc->p += 2;
+ pc->len -= 2;
+ break;
+ case 'b':
+ case 'B':
+ base = 2;
+ allowdot = 0;
+ pc->p += 2;
+ pc->len -= 2;
+ break;
+ }
+ }
+
while (isdigit(UCHAR(*pc->p))
- || (allowhex && isxdigit(UCHAR(*pc->p)))
+ || (base == 16 && isxdigit(UCHAR(*pc->p)))
+ || (base == 8 && *pc->p >= '0' && *pc->p <= '7')
+ || (base == 2 && (*pc->p == '0' || *pc->p == '1'))
|| (allowdot && *pc->p == '.')
- || (pc->p - pc->tstart == 1 && *pc->tstart == '0' && (*pc->p == 'x' || *pc->p == 'X'))
) {
- if ((*pc->p == 'x') || (*pc->p == 'X')) {
- allowhex = 1;
- allowdot = 0;
- }
if (*pc->p == '.') {
allowdot = 0;
pc->tt = JIM_TT_EXPR_DOUBLE;
}
pc->p++;
pc->len--;
- if (!allowhex && (*pc->p == 'e' || *pc->p == 'E') && (pc->p[1] == '-' || pc->p[1] == '+'
+ if (base == 10 && (*pc->p == 'e' || *pc->p == 'E') && (pc->p[1] == '-' || pc->p[1] == '+'
|| isdigit(UCHAR(pc->p[1])))) {
pc->p += 2;
pc->len -= 2;
@@ -13185,8 +13382,9 @@ static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList
case JIM_TT_DICTSUGAR:
case JIM_TT_EXPRSUGAR:
case JIM_TT_CMD:
- token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
token->type = t->type;
+strexpr:
+ token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
if (t->type == JIM_TT_CMD) {
JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
@@ -13195,15 +13393,24 @@ static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList
break;
case JIM_TT_EXPR_INT:
- token->objPtr = Jim_NewIntObj(interp, strtoull(t->token, NULL, 0));
- token->type = t->type;
- expr->len++;
- break;
-
case JIM_TT_EXPR_DOUBLE:
- token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, NULL));
- token->type = t->type;
- expr->len++;
+ {
+ char *endptr;
+ if (t->type == JIM_TT_EXPR_INT) {
+ token->objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
+ }
+ else {
+ token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
+ }
+ if (endptr != t->token + t->len) {
+
+ Jim_FreeNewObj(interp, token->objPtr);
+ token->type = JIM_TT_STR;
+ goto strexpr;
+ }
+ token->type = t->type;
+ expr->len++;
+ }
break;
case JIM_TT_SUBEXPR_START:
@@ -13986,9 +14193,11 @@ static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen
: descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
- w = strtoull(tok, &endp, base);
- if (endp == tok && base == 0) {
- w = strtoull(tok, &endp, 10);
+ if (base == 0) {
+ w = jim_strtoull(tok, &endp);
+ }
+ else {
+ w = strtoull(tok, &endp, base);
}
if (endp != tok) {
@@ -14819,6 +15028,11 @@ static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj
return JIM_ERR;
}
+ if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
+
+ return JIM_OK;
+ }
+
if (interp->framePtr->level == interp->maxCallFrameDepth) {
Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
@@ -15081,74 +15295,45 @@ int Jim_EvalFile(Jim_Interp *interp, const char *filename)
return retcode;
}
-static int JimParseSubstStr(struct JimParserCtx *pc)
+static void JimParseSubst(struct JimParserCtx *pc, int flags)
{
pc->tstart = pc->p;
pc->tline = pc->linenr;
- while (pc->len && *pc->p != '$' && *pc->p != '[') {
- if (*pc->p == '\\' && pc->len > 1) {
- pc->p++;
- pc->len--;
- }
- pc->p++;
- pc->len--;
- }
- pc->tend = pc->p - 1;
- pc->tt = JIM_TT_ESC;
- return JIM_OK;
-}
-
-static int JimParseSubst(struct JimParserCtx *pc, int flags)
-{
- int retval;
if (pc->len == 0) {
- pc->tstart = pc->tend = pc->p;
- pc->tline = pc->linenr;
+ pc->tend = pc->p;
pc->tt = JIM_TT_EOL;
pc->eof = 1;
- return JIM_OK;
+ return;
}
- switch (*pc->p) {
- case '[':
- retval = JimParseCmd(pc);
- if (flags & JIM_SUBST_NOCMD) {
- pc->tstart--;
- pc->tend++;
- pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
- }
- return retval;
- break;
- case '$':
- if (JimParseVar(pc) == JIM_ERR) {
- pc->tstart = pc->tend = pc->p++;
- pc->len--;
- pc->tline = pc->linenr;
- pc->tt = JIM_TT_STR;
- }
- else {
- if (flags & JIM_SUBST_NOVAR) {
- pc->tstart--;
- if (flags & JIM_SUBST_NOESC)
- pc->tt = JIM_TT_STR;
- else
- pc->tt = JIM_TT_ESC;
- if (*pc->tstart == '{') {
- pc->tstart--;
- if (*(pc->tend + 1))
- pc->tend++;
- }
- }
- }
+ if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
+ JimParseCmd(pc);
+ return;
+ }
+ if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
+ if (JimParseVar(pc) == JIM_OK) {
+ return;
+ }
+
+ pc->tstart = pc->p;
+ flags |= JIM_SUBST_NOVAR;
+ }
+ while (pc->len) {
+ if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
break;
- default:
- retval = JimParseSubstStr(pc);
- if (flags & JIM_SUBST_NOESC)
- pc->tt = JIM_TT_STR;
- return retval;
+ }
+ if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
break;
+ }
+ if (*pc->p == '\\' && pc->len > 1) {
+ pc->p++;
+ pc->len--;
+ }
+ pc->p++;
+ pc->len--;
}
- return JIM_OK;
+ pc->tend = pc->p - 1;
+ pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
}
@@ -17175,6 +17360,9 @@ static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a
static const char * const nocase_options[] = {
"-nocase", NULL
};
+ static const char * const nocase_length_options[] = {
+ "-nocase", "-length", NULL
+ };
if (argc < 2) {
Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
@@ -17202,23 +17390,54 @@ static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a
case OPT_COMPARE:
case OPT_EQUAL:
- if (argc != 4 &&
- (argc != 5 ||
- Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
- JIM_ENUM_ABBREV) != JIM_OK)) {
- Jim_WrongNumArgs(interp, 2, argv, "?-nocase? string1 string2");
- return JIM_ERR;
- }
- if (opt_case == 0) {
- argv++;
- }
- if (option == OPT_COMPARE || !opt_case) {
- Jim_SetResultInt(interp, Jim_StringCompareObj(interp, argv[2], argv[3], !opt_case));
- }
- else {
- Jim_SetResultBool(interp, Jim_StringEqObj(argv[2], argv[3]));
+ {
+
+ long opt_length = -1;
+ int n = argc - 4;
+ int i = 2;
+ while (n > 0) {
+ int subopt;
+ if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
+ JIM_ENUM_ABBREV) != JIM_OK) {
+badcompareargs:
+ Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
+ return JIM_ERR;
+ }
+ if (subopt == 0) {
+
+ opt_case = 0;
+ n--;
+ }
+ else {
+
+ if (n < 2) {
+ goto badcompareargs;
+ }
+ if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
+ return JIM_ERR;
+ }
+ n -= 2;
+ }
+ }
+ if (n) {
+ goto badcompareargs;
+ }
+ argv += argc - 2;
+ if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
+
+ Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
+ }
+ else {
+ if (opt_length >= 0) {
+ n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
+ }
+ else {
+ n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
+ }
+ Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
+ }
+ return JIM_OK;
}
- return JIM_OK;
case OPT_MATCH:
if (argc != 4 &&
@@ -17283,7 +17502,7 @@ static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a
Jim_Obj *objPtr;
if (argc != 5 && argc != 6) {
- Jim_WrongNumArgs(interp, 2, argv, "string first last ?newstring?");
+ Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
return JIM_ERR;
}
objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
@@ -17741,9 +17960,9 @@ static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
htiter = Jim_GetHashTableIterator(&interp->references);
while ((he = Jim_NextHashEntry(htiter)) != NULL) {
- char buf[JIM_REFERENCE_SPACE];
+ char buf[JIM_REFERENCE_SPACE + 1];
Jim_Reference *refPtr = he->u.val;
- const jim_wide *refId = he->key;
+ const unsigned long *refId = he->key;
JimFormatReference(buf, refPtr, *refId);
Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
@@ -17990,7 +18209,6 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg
int cmd;
Jim_Obj *objPtr;
int mode = 0;
- int nons = 0;
static const char * const commands[] = {
"body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
@@ -18005,16 +18223,21 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg
INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS
};
- if (argc < 2) {
- Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
- return JIM_ERR;
- }
+#ifdef jim_ext_namespace
+ int nons = 0;
+
if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
argc--;
argv++;
nons = 1;
}
+#endif
+
+ if (argc < 2) {
+ Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
+ return JIM_ERR;
+ }
if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
!= JIM_OK) {
return JIM_ERR;
diff --git a/autosetup/system.tcl b/autosetup/system.tcl
index f05d05b..2712e39 100644
--- a/autosetup/system.tcl
+++ b/autosetup/system.tcl
@@ -217,7 +217,8 @@ if {$host eq ""} {
}
define cross [get-env CROSS $cross]
-set prefix [opt-val prefix /usr/local]
+# Do "define defaultprefix myvalue" to set the default prefix *before* the first "use"
+set prefix [opt-val prefix [get-define defaultprefix /usr/local]]
# These are for compatibility with autoconf
define target [get-define host]
@@ -254,7 +255,7 @@ define SHELL [get-env SHELL [find-an-executable sh bash ksh]]
# Windows vs. non-Windows
switch -glob -- [get-define host] {
- *-*-ming* - *-*-cygwin {
+ *-*-ming* - *-*-cygwin - *-*-msys {
define-feature windows
define EXEEXT .exe
}
diff --git a/configure b/configure
index 1c5586f..8367bd8 100755
--- a/configure
+++ b/configure
@@ -1,3 +1,3 @@
#!/bin/sh
dir="`dirname "$0"`/autosetup"
-WRAPPER="$0" exec "`$dir/find-tclsh`" "$dir/autosetup" "$@"
+WRAPPER="$0"; export WRAPPER; exec "`$dir/find-tclsh`" "$dir/autosetup" "$@"