diff options
author | Steve Bennett <steveb@workware.net.au> | 2013-03-28 07:15:00 +1000 |
---|---|---|
committer | Steve Bennett <steveb@workware.net.au> | 2013-03-28 07:19:55 +1000 |
commit | 738b8b93eec3ffcac1b84ddd85179a4351bc82ef (patch) | |
tree | 13aa0401a28123ea376d3ccd793d928ff894b100 | |
parent | c7e5c48c4434835a19628ebecfa1bf59883f5f58 (diff) | |
download | jimtcl-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.autosetup | 2 | ||||
-rwxr-xr-x | autosetup/autosetup | 282 | ||||
-rw-r--r-- | autosetup/cc-lib.tcl | 84 | ||||
-rw-r--r-- | autosetup/cc-shared.tcl | 99 | ||||
-rw-r--r-- | autosetup/cc.tcl | 50 | ||||
-rwxr-xr-x | autosetup/config.guess | 3 | ||||
-rwxr-xr-x | autosetup/config.sub | 6 | ||||
-rw-r--r-- | autosetup/default.auto | 25 | ||||
-rw-r--r-- | autosetup/jimsh0.c | 665 | ||||
-rw-r--r-- | autosetup/system.tcl | 5 | ||||
-rwxr-xr-x | configure | 2 |
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 } @@ -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" "$@" |