From 52c009322f08d5c54ee93e67f439d8e06399a3a1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 27 Oct 2018 19:52:25 +0000 Subject: put back Travis CI build. All merge-marks of previous commit change done. --- README | 185 -------------------------------------------- library/tcltest/tcltest.tcl | 4 +- tests/all.tcl | 4 +- 3 files changed, 5 insertions(+), 188 deletions(-) delete mode 100644 README diff --git a/README b/README deleted file mode 100644 index c71d177..0000000 --- a/README +++ /dev/null @@ -1,185 +0,0 @@ -README: Tcl - This is the Tcl 8.5.19 source distribution. - http://sourceforge.net/projects/tcl/files/Tcl/ - You can get any source release of Tcl from the URL above. - -Contents --------- - 1. Introduction - 2. Documentation - 3. Compiling and installing Tcl - 4. Development tools - 5. Tcl newsgroup - 6. The Tcler's Wiki - 7. Mailing lists - 8. Support and Training - 9. Tracking Development - 10. Thank You - -1. Introduction ---------------- -Tcl provides a powerful platform for creating integration applications that -tie together diverse applications, protocols, devices, and frameworks. -When paired with the Tk toolkit, Tcl provides the fastest and most powerful -way to create GUI applications that run on PCs, Unix, and Mac OS X. -Tcl can also be used for a variety of web-related tasks and for creating -powerful command languages for applications. - -Tcl is maintained, enhanced, and distributed freely by the Tcl community. -Source code development and tracking of bug reports and feature requests -takes place at: - - http://core.tcl.tk/ - -Tcl/Tk release and mailing list services are hosted by SourceForge: - - http://sourceforge.net/projects/tcl/ - -with the Tcl Developer Xchange hosted at: - - http://www.tcl.tk/ - -Tcl is a freely available open source package. You can do virtually -anything you like with it, such as modifying it, redistributing it, -and selling it either in whole or in part. See the file -"license.terms" for complete information. - -2. Documentation ----------------- - -Extensive documentation is available at our website. -The home page for this release, including new features, is - http://www.tcl.tk/software/tcltk/8.5.html - -Detailed release notes can be found at the file distributions page -by clicking on the relevant version. - http://sourceforge.net/projects/tcl/files/Tcl/ - -Information about Tcl itself can be found at - http://www.tcl.tk/about/ - -There have been many Tcl books on the market. Many are mentioned in the Wiki: - http://wiki.tcl.tk/_/ref?N=25206 - -To view the complete set of reference manual entries for Tcl 8.5 online, -visit the URL: - http://www.tcl.tk/man/tcl8.5/ - -2a. Unix Documentation ----------------------- - -The "doc" subdirectory in this release contains a complete set of -reference manual entries for Tcl. Files with extension ".1" are for -programs (for example, tclsh.1); files with extension ".3" are for C -library procedures; and files with extension ".n" describe Tcl -commands. The file "doc/Tcl.n" gives a quick summary of the Tcl -language syntax. To print any of the man pages on Unix, cd to the -"doc" directory and invoke your favorite variant of troff using the -normal -man macros, for example - - ditroff -man Tcl.n - -to print Tcl.n. If Tcl has been installed correctly and your "man" program -supports it, you should be able to access the Tcl manual entries using the -normal "man" mechanisms, such as - - man Tcl - -2b. Windows Documentation -------------------------- - -The "doc" subdirectory in this release contains a complete set of Windows -help files for Tcl. Once you install this Tcl release, a shortcut to the -Windows help Tcl documentation will appear in the "Start" menu: - - Start | Programs | Tcl | Tcl Help - -3. Compiling and installing Tcl -------------------------------- - -There are brief notes in the unix/README, win/README, and macosx/README about -compiling on these different platforms. There is additional information -about building Tcl from sources at - - http://www.tcl.tk/doc/howto/compile.html - -4. Development tools ---------------------------- - -ActiveState produces a high quality set of commercial quality development -tools that is available to accelerate your Tcl application development. -Tcl Dev Kit builds on the earlier TclPro toolset and provides a debugger, -static code checker, single-file wrapping utility, bytecode compiler and -more. More information can be found at - - http://www.ActiveState.com/Tcl - -5. Tcl newsgroup ----------------- - -There is a USENET news group, "comp.lang.tcl", intended for the exchange of -information about Tcl, Tk, and related applications. The newsgroup is a -great place to ask general information questions. For bug reports, please -see the "Support and bug fixes" section below. - -6. Tcl'ers Wiki ---------------- - -A Wiki-based open community site covering all aspects of Tcl/Tk is at: - - http://wiki.tcl.tk/ - -It is dedicated to the Tcl programming language and its extensions. A -wealth of useful information can be found there. It contains code -snippets, references to papers, books, and FAQs, as well as pointers to -development tools, extensions, and applications. You can also recommend -additional URLs by editing the wiki yourself. - -7. Mailing lists ----------------- - -Several mailing lists are hosted at SourceForge to discuss development or -use issues (like Macintosh and Windows topics). For more information and -to subscribe, visit: - - http://sourceforge.net/projects/tcl/ - -and go to the Mailing Lists page. - -8. Support and Training ------------------------- - -We are very interested in receiving bug reports, patches, and suggestions -for improvements. We prefer that you send this information to us as -tickets entered into our tracker at: - - http://core.tcl.tk/tcl/reportlist - -We will log and follow-up on each bug, although we cannot promise a -specific turn-around time. Enhancements may take longer and may not happen -at all unless there is widespread support for them (we're trying to -slow the rate at which Tcl/Tk turns into a kitchen sink). It's very -difficult to make incompatible changes to Tcl/Tk at this point, due to -the size of the installed base. - -The Tcl community is too large for us to provide much individual support -for users. If you need help we suggest that you post questions to -comp.lang.tcl. We read the newsgroup and will attempt to answer esoteric -questions for which no one else is likely to know the answer. In addition, -see the following Web site for links to other organizations that offer -Tcl/Tk training: - - http://wiki.tcl.tk/training - -9. Tracking Development ------------------------ - -Tcl is developed in public. To keep an eye on how Tcl is changing, see - http://core.tcl.tk/ - -10. Thank You -------------- - -We'd like to express our thanks to the Tcl community for all the -helpful suggestions, bug reports, and patches we have received. -Tcl/Tk has improved vastly and will continue to do so with your help. diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 936acaa..f69ffd2 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -2700,7 +2700,7 @@ proc tcltest::GetMatchingDirectories {rootdir} { # shell being tested # # Results: -# None. +# Whether there were any failures. # # Side effects: # None. @@ -2846,7 +2846,7 @@ proc tcltest::runAllTests { {shell ""} } { puts [outputChannel] "" puts [outputChannel] [string repeat ~ 44] } - return + return [info exists testFileFailures] } ##################################################################### diff --git a/tests/all.tcl b/tests/all.tcl index d01a54d..f3463c6 100644 --- a/tests/all.tcl +++ b/tests/all.tcl @@ -14,4 +14,6 @@ package require Tcl 8.5 package require tcltest 2.2 namespace import tcltest::* configure {*}$argv -testdir [file dir [info script]] -runAllTests +set ErrorOnFailures [info exists env(ERROR_ON_FAILURES)] +unset -nocomplain env(ERROR_ON_FAILURES) +if {[runAllTests] && $ErrorOnFailures} {exit 1} -- cgit v0.12 From 2f4c1aecdb5225114428f32eaaf44973983ca89b Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 29 Oct 2018 14:00:48 +0000 Subject: [TIP 525] Backport package tcltest 2.5 --- doc/tcltest.n | 569 +++++++++++++++++++++++++++---------------- library/tcltest/pkgIndex.tcl | 4 +- library/tcltest/tcltest.tcl | 127 ++++++---- tests/tcltest.test | 56 +++-- unix/Makefile.in | 4 +- win/Makefile.in | 4 +- win/makefile.bc | 8 +- 7 files changed, 483 insertions(+), 289 deletions(-) diff --git a/doc/tcltest.n b/doc/tcltest.n index 399a673..b161a2b 100644 --- a/doc/tcltest.n +++ b/doc/tcltest.n @@ -7,8 +7,8 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -.TH "tcltest" n 2.3 tcltest "Tcl Bundled Packages" +'\" +.TH "tcltest" n 2.5 tcltest "Tcl Bundled Packages" .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! @@ -16,52 +16,52 @@ tcltest \- Test harness support code and utilities .SH SYNOPSIS .nf -\fBpackage require tcltest ?2.3?\fR -.sp -\fBtcltest::test \fIname description ?option value ...?\fR -\fBtcltest::test \fIname description ?constraints? body result\fR -.sp +\fBpackage require tcltest\fR ?\fB2.5\fR? + +\fBtcltest::test \fIname description\fR ?\fI\-option value ...\fR? +\fBtcltest::test \fIname description\fR ?\fIconstraints\fR? \fIbody result\fR + \fBtcltest::loadTestedCommands\fR -\fBtcltest::makeDirectory \fIname ?directory?\fR -\fBtcltest::removeDirectory \fIname ?directory?\fR -\fBtcltest::makeFile \fIcontents name ?directory?\fR -\fBtcltest::removeFile \fIname ?directory?\fR -\fBtcltest::viewFile \fIname ?directory?\fR -\fBtcltest::cleanupTests \fI?runningMultipleTests?\fR +\fBtcltest::makeDirectory \fIname\fR ?\fIdirectory\fR? +\fBtcltest::removeDirectory \fIname\fR ?\fIdirectory\fR? +\fBtcltest::makeFile \fIcontents name\fR ?\fIdirectory\fR? +\fBtcltest::removeFile \fIname\fR ?\fIdirectory\fR? +\fBtcltest::viewFile \fIname\fR ?\fIdirectory\fR? +\fBtcltest::cleanupTests \fR?\fIrunningMultipleTests\fR? \fBtcltest::runAllTests\fR -.sp + \fBtcltest::configure\fR -\fBtcltest::configure \fIoption\fR -\fBtcltest::configure \fIoption value ?option value ...?\fR +\fBtcltest::configure \fI\-option\fR +\fBtcltest::configure \fI\-option value\fR ?\fI\-option value ...\fR? \fBtcltest::customMatch \fImode command\fR -\fBtcltest::testConstraint \fIconstraint ?value?\fR -\fBtcltest::outputChannel \fI?channelID?\fR -\fBtcltest::errorChannel \fI?channelID?\fR -\fBtcltest::interpreter \fI?interp?\fR -.sp -\fBtcltest::debug \fI?level?\fR -\fBtcltest::errorFile \fI?filename?\fR -\fBtcltest::limitConstraints \fI?boolean?\fR -\fBtcltest::loadFile \fI?filename?\fR -\fBtcltest::loadScript \fI?script?\fR -\fBtcltest::match \fI?patternList?\fR -\fBtcltest::matchDirectories \fI?patternList?\fR -\fBtcltest::matchFiles \fI?patternList?\fR -\fBtcltest::outputFile \fI?filename?\fR -\fBtcltest::preserveCore \fI?level?\fR -\fBtcltest::singleProcess \fI?boolean?\fR -\fBtcltest::skip \fI?patternList?\fR -\fBtcltest::skipDirectories \fI?patternList?\fR -\fBtcltest::skipFiles \fI?patternList?\fR -\fBtcltest::temporaryDirectory \fI?directory?\fR -\fBtcltest::testsDirectory \fI?directory?\fR -\fBtcltest::verbose \fI?level?\fR -.sp +\fBtcltest::testConstraint \fIconstraint\fR ?\fIvalue\fR? +\fBtcltest::outputChannel \fR?\fIchannelID\fR? +\fBtcltest::errorChannel \fR?\fIchannelID\fR? +\fBtcltest::interpreter \fR?\fIinterp\fR? + +\fBtcltest::debug \fR?\fIlevel\fR? +\fBtcltest::errorFile \fR?\fIfilename\fR? +\fBtcltest::limitConstraints \fR?\fIboolean\fR? +\fBtcltest::loadFile \fR?\fIfilename\fR? +\fBtcltest::loadScript \fR?\fIscript\fR? +\fBtcltest::match \fR?\fIpatternList\fR? +\fBtcltest::matchDirectories \fR?\fIpatternList\fR? +\fBtcltest::matchFiles \fR?\fIpatternList\fR? +\fBtcltest::outputFile \fR?\fIfilename\fR? +\fBtcltest::preserveCore \fR?\fIlevel\fR? +\fBtcltest::singleProcess \fR?\fIboolean\fR? +\fBtcltest::skip \fR?\fIpatternList\fR? +\fBtcltest::skipDirectories \fR?\fIpatternList\fR? +\fBtcltest::skipFiles \fR?\fIpatternList\fR? +\fBtcltest::temporaryDirectory \fR?\fIdirectory\fR? +\fBtcltest::testsDirectory \fR?\fIdirectory\fR? +\fBtcltest::verbose \fR?\fIlevel\fR? + \fBtcltest::test \fIname description optionList\fR \fBtcltest::bytestring \fIstring\fR \fBtcltest::normalizeMsg \fImsg\fR \fBtcltest::normalizePath \fIpathVar\fR -\fBtcltest::workingDirectory \fI?dir?\fR +\fBtcltest::workingDirectory \fR?\fIdir\fR? .fi .BE .SH DESCRIPTION @@ -90,7 +90,8 @@ of how to use the commands of \fBtcltest\fR to produce test suites for your Tcl-enabled code. .SH COMMANDS .TP -\fBtest\fR \fIname description ?option value ...?\fR +\fBtest\fR \fIname description\fR ?\fI\-option value ...\fR? +. Defines and possibly runs a test with the name \fIname\fR and description \fIdescription\fR. The name and description of a test are used in messages reported by \fBtest\fR during the @@ -103,7 +104,8 @@ See \fBTESTS\fR below for a complete description of the valid options and how they define a test. The \fBtest\fR command returns an empty string. .TP -\fBtest\fR \fIname description ?constraints? body result\fR +\fBtest\fR \fIname description\fR ?\fIconstraints\fR? \fIbody result\fR +. This form of \fBtest\fR is provided to support test suites written for version 1 of the \fBtcltest\fR package, and also a simpler interface for a common usage. It is the same as @@ -115,14 +117,16 @@ all \fIoption\fRs begin with .QW \- . .TP \fBloadTestedCommands\fR -Evaluates in the caller's context the script specified by +. +Evaluates in the caller's context the script specified by \fBconfigure \-load\fR or \fBconfigure \-loadfile\fR. Returns the result of that script evaluation, including any error raised by the script. Use this command and the related configuration options to provide the commands to be tested to the interpreter running the test suite. .TP -\fBmakeFile\fR \fIcontents name ?directory?\fR +\fBmakeFile\fR \fIcontents name\fR ?\fIdirectory\fR? +. Creates a file named \fIname\fR relative to directory \fIdirectory\fR and write \fIcontents\fR to that file using the encoding \fBencoding system\fR. @@ -137,14 +141,16 @@ of \fBcleanupTests\fR, unless it is removed by Returns the full path of the file created. Use this command to create any text file required by a test with contents as needed. .TP -\fBremoveFile\fR \fIname ?directory?\fR +\fBremoveFile\fR \fIname\fR ?\fIdirectory\fR? +. Forces the file referenced by \fIname\fR to be removed. This file name should be relative to \fIdirectory\fR. The default value of \fIdirectory\fR is the directory \fBconfigure \-tmpdir\fR. Returns an empty string. Use this command to delete files created by \fBmakeFile\fR. .TP -\fBmakeDirectory\fR \fIname ?directory?\fR +\fBmakeDirectory\fR \fIname\fR ?\fIdirectory\fR? +. Creates a directory named \fIname\fR relative to directory \fIdirectory\fR. The directory will be removed by the next evaluation of \fBcleanupTests\fR, unless it is removed by \fBremoveDirectory\fR first. @@ -153,7 +159,8 @@ The default value of \fIdirectory\fR is the directory Returns the full path of the directory created. Use this command to create any directories that are required to exist by a test. .TP -\fBremoveDirectory\fR \fIname ?directory?\fR +\fBremoveDirectory\fR \fIname\fR ?\fIdirectory\fR? +. Forces the directory referenced by \fIname\fR to be removed. This directory should be relative to \fIdirectory\fR. The default value of \fIdirectory\fR is the directory @@ -161,7 +168,8 @@ The default value of \fIdirectory\fR is the directory Returns an empty string. Use this command to delete any directories created by \fBmakeDirectory\fR. .TP -\fBviewFile\fR \fIfile ?directory?\fR +\fBviewFile\fR \fIfile\fR ?\fIdirectory\fR? +. Returns the contents of \fIfile\fR, except for any final newline, just as \fBread \-nonewline\fR would return. This file name should be relative to \fIdirectory\fR. @@ -174,6 +182,7 @@ the system encoding, so its usefulness is limited to text files. .TP \fBcleanupTests\fR +. Intended to clean up and summarize after several tests have been run. Typically called once per test file, at the end of the file after all tests have been completed. For best effectiveness, be @@ -188,28 +197,32 @@ in the directory \fBconfigure \-tmpdir\fR created since the last \fBcleanupTests\fR, but not created by \fBmakeFile\fR or \fBmakeDirectory\fR are printed to \fBoutputChannel\fR. This command also restores the original -shell environment, as described by the \fB::env\fR +shell environment, as described by the global \fBenv\fR array. Returns an empty string. .RE .TP \fBrunAllTests\fR +. This is a master command meant to run an entire suite of tests, spanning multiple files and/or directories, as governed by the configurable options of \fBtcltest\fR. See \fBRUNNING ALL TESTS\fR below for a complete description of the many variations possible with \fBrunAllTests\fR. -.SH "CONFIGURATION COMMANDS" +.SS "CONFIGURATION COMMANDS" .TP \fBconfigure\fR +. Returns the list of configurable options supported by \fBtcltest\fR. See \fBCONFIGURABLE OPTIONS\fR below for the full list of options, their valid values, and their effect on \fBtcltest\fR operations. .TP \fBconfigure \fIoption\fR +. Returns the current value of the supported configurable option \fIoption\fR. Raises an error if \fIoption\fR is not a supported configurable option. .TP -\fBconfigure \fIoption value ?option value ...?\fR +\fBconfigure \fIoption value\fR ?\fI\-option value ...\fR? +. Sets the value of each configurable option \fIoption\fR to the corresponding value \fIvalue\fR, in order. Raises an error if an \fIoption\fR is not a supported configurable option, or if @@ -220,13 +233,14 @@ arguments are not processed. .RS .PP If the environment variable \fB::env(TCLTEST_OPTIONS)\fR exists when -the \fBtcltest\fR package is loaded (by \fBpackage require tcltest\fR) +the \fBtcltest\fR package is loaded (by \fBpackage require\fR \fBtcltest\fR) then its value is taken as a list of arguments to pass to \fBconfigure\fR. This allows the default values of the configuration options to be set by the environment. .RE .TP \fBcustomMatch \fImode script\fR +. Registers \fImode\fR as a new legal value of the \fB\-match\fR option to \fBtest\fR. When the \fB\-match \fImode\fR option is passed to \fBtest\fR, the script \fIscript\fR will be evaluated @@ -239,81 +253,119 @@ The completed script is expected to return a boolean value indicating whether or not the results match. The built-in matching modes of \fBtest\fR are \fBexact\fR, \fBglob\fR, and \fBregexp\fR. .TP -\fBtestConstraint \fIconstraint ?boolean?\fR +\fBtestConstraint \fIconstraint\fR ?\fIboolean\fR? +. Sets or returns the boolean value associated with the named \fIconstraint\fR. See \fBTEST CONSTRAINTS\fR below for more information. .TP -\fBinterpreter\fR \fI?executableName?\fR +\fBinterpreter\fR ?\fIexecutableName\fR? +. Sets or returns the name of the executable to be \fBexec\fRed by \fBrunAllTests\fR to run each test file when \fBconfigure \-singleproc\fR is false. The default value for \fBinterpreter\fR is the name of the currently running program as returned by \fBinfo nameofexecutable\fR. .TP -\fBoutputChannel\fR \fI?channelID?\fR -Sets or returns the output channel ID. This defaults to stdout. +\fBoutputChannel\fR ?\fIchannelID\fR? +. +Sets or returns the output channel ID. This defaults to \fBstdout\fR. Any test that prints test related output should send that output to \fBoutputChannel\fR rather than letting -that output default to stdout. +that output default to \fBstdout\fR. .TP -\fBerrorChannel\fR \fI?channelID?\fR -Sets or returns the error channel ID. This defaults to stderr. +\fBerrorChannel\fR ?\fIchannelID\fR? +. +Sets or returns the error channel ID. This defaults to \fBstderr\fR. Any test that prints error messages should send that output to \fBerrorChannel\fR rather than printing -directly to stderr. -.SH "SHORTCUT COMMANDS" -.TP -\fBdebug \fI?level?\fR -Same as \fBconfigure \-debug \fI?level?\fR. -.TP -\fBerrorFile \fI?filename?\fR -Same as \fBconfigure \-errfile \fI?filename?\fR. -.TP -\fBlimitConstraints \fI?boolean?\fR -Same as \fBconfigure \-limitconstraints \fI?boolean?\fR. -.TP -\fBloadFile \fI?filename?\fR -Same as \fBconfigure \-loadfile \fI?filename?\fR. -.TP -\fBloadScript \fI?script?\fR -Same as \fBconfigure \-load \fI?script?\fR. -.TP -\fBmatch \fI?patternList?\fR -Same as \fBconfigure \-match \fI?patternList?\fR. -.TP -\fBmatchDirectories \fI?patternList?\fR -Same as \fBconfigure \-relateddir \fI?patternList?\fR. -.TP -\fBmatchFiles \fI?patternList?\fR -Same as \fBconfigure \-file \fI?patternList?\fR. -.TP -\fBoutputFile \fI?filename?\fR -Same as \fBconfigure \-outfile \fI?filename?\fR. -.TP -\fBpreserveCore \fI?level?\fR -Same as \fBconfigure \-preservecore \fI?level?\fR. -.TP -\fBsingleProcess \fI?boolean?\fR -Same as \fBconfigure \-singleproc \fI?boolean?\fR. -.TP -\fBskip \fI?patternList?\fR -Same as \fBconfigure \-skip \fI?patternList?\fR. -.TP -\fBskipDirectories \fI?patternList?\fR -Same as \fBconfigure \-asidefromdir \fI?patternList?\fR. -.TP -\fBskipFiles \fI?patternList?\fR -Same as \fBconfigure \-notfile \fI?patternList?\fR. -.TP -\fBtemporaryDirectory \fI?directory?\fR -Same as \fBconfigure \-tmpdir \fI?directory?\fR. -.TP -\fBtestsDirectory \fI?directory?\fR -Same as \fBconfigure \-testdir \fI?directory?\fR. -.TP -\fBverbose \fI?level?\fR -Same as \fBconfigure \-verbose \fI?level?\fR. -.SH "OTHER COMMANDS" +directly to \fBstderr\fR. +.SS "SHORTCUT CONFIGURATION COMMANDS" +.TP +\fBdebug\fR ?\fIlevel\fR? +. +Same as +.QW "\fBconfigure \-debug\fR ?\fIlevel\fR?" . +.TP +\fBerrorFile\fR ?\fIfilename\fR? +. +Same as +.QW "\fBconfigure \-errfile\fR ?\fIfilename\fR?" . +.TP +\fBlimitConstraints\fR ?\fIboolean\fR? +. +Same as +.QW "\fBconfigure \-limitconstraints\fR ?\fIboolean\fR?" . +.TP +\fBloadFile\fR ?\fIfilename\fR? +. +Same as +.QW "\fBconfigure \-loadfile\fR ?\fIfilename\fR?" . +.TP +\fBloadScript\fR ?\fIscript\fR? +. +Same as +.QW "\fBconfigure \-load\fR ?\fIscript\fR?" . +.TP +\fBmatch\fR ?\fIpatternList\fR? +. +Same as +.QW "\fBconfigure \-match\fR ?\fIpatternList\fR?" . +.TP +\fBmatchDirectories\fR ?\fIpatternList\fR? +. +Same as +.QW "\fBconfigure \-relateddir\fR ?\fIpatternList\fR?" . +.TP +\fBmatchFiles\fR ?\fIpatternList\fR? +. +Same as +.QW "\fBconfigure \-file\fR ?\fIpatternList\fR?" . +.TP +\fBoutputFile\fR ?\fIfilename\fR? +. +Same as +.QW "\fBconfigure \-outfile\fR ?\fIfilename\fR?" . +.TP +\fBpreserveCore\fR ?\fIlevel\fR? +. +Same as +.QW "\fBconfigure \-preservecore\fR ?\fIlevel\fR?" . +.TP +\fBsingleProcess\fR ?\fIboolean\fR? +. +Same as +.QW "\fBconfigure \-singleproc\fR ?\fIboolean\fR?" . +.TP +\fBskip\fR ?\fIpatternList\fR? +. +Same as +.QW "\fBconfigure \-skip\fR ?\fIpatternList\fR?" . +.TP +\fBskipDirectories\fR ?\fIpatternList\fR? +. +Same as +.QW "\fBconfigure \-asidefromdir\fR ?\fIpatternList\fR?" . +.TP +\fBskipFiles\fR ?\fIpatternList\fR? +. +Same as +.QW "\fBconfigure \-notfile\fR ?\fIpatternList\fR?" . +.TP +\fBtemporaryDirectory\fR ?\fIdirectory\fR? +. +Same as +.QW "\fBconfigure \-tmpdir\fR ?\fIdirectory\fR?" . +.TP +\fBtestsDirectory\fR ?\fIdirectory\fR? +. +Same as +.QW "\fBconfigure \-testdir\fR ?\fIdirectory\fR?" . +.TP +\fBverbose\fR ?\fIlevel\fR? +. +Same as +.QW "\fBconfigure \-verbose\fR ?\fIlevel\fR?" . +.SS "OTHER COMMANDS" .PP The remaining commands provided by \fBtcltest\fR have better alternatives provided by \fBtcltest\fR or \fBTcl\fR itself. They @@ -321,6 +373,7 @@ are retained to support existing test suites, but should be avoided in new code. .TP \fBtest\fR \fIname description optionList\fR +. This form of \fBtest\fR was provided to enable passing many options spanning several lines to \fBtest\fR as a single argument quoted by braces, rather than needing to backslash quote @@ -344,13 +397,15 @@ the source code of \fBtcltest\fR if you want to know the substitution details, or just enclose the third through last argument to \fBtest\fR in braces and hope for the best. .TP -\fBworkingDirectory\fR \fI?directoryName?\fR +\fBworkingDirectory\fR ?\fIdirectoryName\fR? +. Sets or returns the current working directory when the test suite is running. The default value for workingDirectory is the directory in which the test suite was launched. The Tcl commands \fBcd\fR and \fBpwd\fR are sufficient replacements. .TP -\fBnormalizeMsg\fR \fImsg\fR +\fBnormalizeMsg \fImsg\fR +. Returns the result of removing the .QW extra newlines from \fImsg\fR, where @@ -360,20 +415,23 @@ processing commands to modify strings as you wish, and \fBcustomMatch\fR allows flexible matching of actual and expected results. .TP -\fBnormalizePath\fR \fIpathVar\fR +\fBnormalizePath \fIpathVar\fR +. Resolves symlinks in a path, thus creating a path without internal redirection. It is assumed that \fIpathVar\fR is absolute. \fIpathVar\fR is modified in place. The Tcl command \fBfile normalize\fR is a sufficient replacement. .TP -\fBbytestring\fR \fIstring\fR +\fBbytestring \fIstring\fR +. Construct a string that consists of the requested sequence of bytes, as opposed to a string of properly formed UTF-8 characters using the value supplied in \fIstring\fR. This allows the tester to create denormalized or improperly formed strings to pass to C procedures that are supposed to accept strings with embedded NULL types and confirm that a string result has a certain pattern of bytes. This is -exactly equivalent to the Tcl command \fBencoding convertfrom identity\fR. +exactly equivalent to the Tcl command \fBencoding convertfrom\fR +\fBidentity\fR. .SH TESTS .PP The \fBtest\fR command is the heart of the \fBtcltest\fR package. @@ -388,15 +446,16 @@ The valid options for \fBtest\fR are summarized: .PP .CS \fBtest\fR \fIname\fR \fIdescription\fR - ?-constraints \fIkeywordList|expression\fR? - ?-setup \fIsetupScript\fR? - ?-body \fItestScript\fR? - ?-cleanup \fIcleanupScript\fR? - ?-result \fIexpectedAnswer\fR? - ?-output \fIexpectedOutput\fR? - ?-errorOutput \fIexpectedError\fR? - ?-returnCodes \fIcodeList\fR? - ?-match \fImode\fR? + ?\fB\-constraints \fIkeywordList|expression\fR? + ?\fB\-setup \fIsetupScript\fR? + ?\fB\-body \fItestScript\fR? + ?\fB\-cleanup \fIcleanupScript\fR? + ?\fB\-result \fIexpectedAnswer\fR? + ?\fB\-output \fIexpectedOutput\fR? + ?\fB\-errorOutput \fIexpectedError\fR? + ?\fB\-returnCodes \fIcodeList\fR? + ?\fB\-errorCode \fIexpectedErrorCode\fR? + ?\fB\-match \fImode\fR? .CE .PP The \fIname\fR may be any string. It is conventional to choose @@ -428,11 +487,12 @@ test, typically test failure messages. Good \fIdescription\fR values should briefly explain the purpose of the test to users of a test suite. The name of a Tcl or C function being tested should be included in the description for regression tests. If the test case exists to reproduce -a bug, include the bug ID in the description. +a bug, include the bug ID in the description. .PP Valid attributes and associated values are: .TP -\fB\-constraints \fIkeywordList|expression\fR +\fB\-constraints \fIkeywordList\fR|\fIexpression\fR +. The optional \fB\-constraints\fR attribute can be list of one or more keywords or an expression. If the \fB\-constraints\fR value is a list of keywords, each of these keywords should be the name of a constraint @@ -449,29 +509,35 @@ should be accomplished by the \fB\-constraints\fR option, not by conditional evaluation of \fBtest\fR. In that way, the same number of tests are always reported by the test suite, though the number skipped may change based on the testing environment. -The default value is an empty list. -See \fBTEST CONSTRAINTS\fR below for a list of built-in constraints +The default value is an empty list. +See \fBTEST CONSTRAINTS\fR below for a list of built-in constraints and information on how to add your own constraints. .TP \fB\-setup \fIscript\fR +. The optional \fB\-setup\fR attribute indicates a \fIscript\fR that will be run before the script indicated by the \fB\-body\fR attribute. If evaluation of \fIscript\fR raises an error, the test will fail. The default value is an empty script. .TP \fB\-body \fIscript\fR -The \fB\-body\fR attribute indicates the \fIscript\fR to run to carry out the -test. It must return a result that can be checked for correctness. -If evaluation of \fIscript\fR raises an error, the test will fail. +. +The \fB\-body\fR attribute indicates the \fIscript\fR to run to carry out the +test, which must return a result that can be checked for correctness. +If evaluation of \fIscript\fR raises an error, the test will fail +(unless the \fB\-returnCodes\fR option is used to state that an error +is expected). The default value is an empty script. .TP \fB\-cleanup \fIscript\fR +. The optional \fB\-cleanup\fR attribute indicates a \fIscript\fR that will be run after the script indicated by the \fB\-body\fR attribute. If evaluation of \fIscript\fR raises an error, the test will fail. The default value is an empty script. .TP \fB\-match \fImode\fR +. The \fB\-match\fR attribute determines how expected answers supplied by \fB\-result\fR, \fB\-output\fR, and \fB\-errorOutput\fR are compared. Valid values for \fImode\fR are \fBregexp\fR, \fBglob\fR, \fBexact\fR, and @@ -479,27 +545,31 @@ any value registered by a prior call to \fBcustomMatch\fR. The default value is \fBexact\fR. .TP \fB\-result \fIexpectedValue\fR +. The \fB\-result\fR attribute supplies the \fIexpectedValue\fR against which the return value from script will be compared. The default value is an empty string. .TP \fB\-output \fIexpectedValue\fR +. The \fB\-output\fR attribute supplies the \fIexpectedValue\fR against which any output sent to \fBstdout\fR or \fBoutputChannel\fR during evaluation of the script(s) will be compared. Note that only output printed using -\fB::puts\fR is used for comparison. If \fB\-output\fR is not specified, -output sent to \fBstdout\fR and \fBoutputChannel\fR is not processed for -comparison. +the global \fBputs\fR command is used for comparison. If \fB\-output\fR is +not specified, output sent to \fBstdout\fR and \fBoutputChannel\fR is not +processed for comparison. .TP \fB\-errorOutput \fIexpectedValue\fR +. The \fB\-errorOutput\fR attribute supplies the \fIexpectedValue\fR against -which any output sent to \fBstderr\fR or \fBerrorChannel\fR during +which any output sent to \fBstderr\fR or \fBerrorChannel\fR during evaluation of the script(s) will be compared. Note that only output -printed using \fB::puts\fR is used for comparison. If \fB\-errorOutput\fR -is not specified, output sent to \fBstderr\fR and \fBerrorChannel\fR is -not processed for comparison. +printed using the global \fBputs\fR command is used for comparison. If +\fB\-errorOutput\fR is not specified, output sent to \fBstderr\fR and +\fBerrorChannel\fR is not processed for comparison. .TP \fB\-returnCodes \fIexpectedCodeList\fR +. The optional \fB\-returnCodes\fR attribute supplies \fIexpectedCodeList\fR, a list of return codes that may be accepted from evaluation of the \fB\-body\fR script. If evaluation of the \fB\-body\fR script returns @@ -507,7 +577,16 @@ a code not in the \fIexpectedCodeList\fR, the test fails. All return codes known to \fBreturn\fR, in both numeric and symbolic form, including extended return codes, are acceptable elements in the \fIexpectedCodeList\fR. Default value is -.QW \fBok return\fR. +.QW "\fBok return\fR" . +.TP +\fB\-errorCode \fIexpectedErrorCode\fR +. +The optional \fB\-errorCode\fR attribute supplies \fIexpectedErrorCode\fR, +a glob pattern that should match the error code reported from evaluation of the +\fB\-body\fR script. If evaluation of the \fB\-body\fR script returns +a code not matching \fIexpectedErrorCode\fR, the test fails. Default value is +.QW "\fB*\fR" . +If \fB\-returnCodes\fR does not include \fBerror\fR it is set to \fBerror\fR. .PP To pass, a test must successfully evaluate its \fB\-setup\fR, \fB\-body\fR, and \fB\-cleanup\fR scripts. The return code of the \fB\-body\fR script and @@ -524,12 +603,12 @@ In default operation, a successful test produces no output. The output messages produced by \fBtest\fR are controlled by the \fBconfigure \-verbose\fR option as described in \fBCONFIGURABLE OPTIONS\fR below. Any output produced by the test scripts themselves should be -produced using \fB::puts\fR to \fBoutputChannel\fR or +produced using \fBputs\fR to \fBoutputChannel\fR or \fBerrorChannel\fR, so that users of the test suite may easily capture output with the \fBconfigure \-outfile\fR and \fBconfigure \-errfile\fR options, and so that the \fB\-output\fR and \fB\-errorOutput\fR attributes work properly. -.SH "TEST CONSTRAINTS" +.SS "TEST CONSTRAINTS" .PP Constraints are used to determine whether or not a test should be skipped. Each constraint has a name, which may be any string, and a boolean @@ -557,112 +636,133 @@ The following is a list of constraints pre-defined by the \fBtcltest\fR package itself: .TP \fIsingleTestInterp\fR -test can only be run if all test files are sourced into a single interpreter +. +This test can only be run if all test files are sourced into a single +interpreter. .TP \fIunix\fR -test can only be run on any Unix platform +. +This test can only be run on any Unix platform. .TP \fIwin\fR -test can only be run on any Windows platform +. +This test can only be run on any Windows platform. .TP \fInt\fR -test can only be run on any Windows NT platform -.TP -\fI95\fR -test can only be run on any Windows 95 platform -.TP -\fI98\fR -test can only be run on any Windows 98 platform +. +This test can only be run on any Windows NT platform. .TP \fImac\fR -test can only be run on any Mac platform +. +This test can only be run on any Mac platform. .TP \fIunixOrWin\fR -test can only be run on a Unix or Windows platform +. +This test can only be run on a Unix or Windows platform. .TP \fImacOrWin\fR -test can only be run on a Mac or Windows platform +. +This test can only be run on a Mac or Windows platform. .TP \fImacOrUnix\fR -test can only be run on a Mac or Unix platform +. +This test can only be run on a Mac or Unix platform. .TP \fItempNotWin\fR -test can not be run on Windows. This flag is used to temporarily -disable a test. +. +This test can not be run on Windows. This flag is used to temporarily +disable a test. .TP \fItempNotMac\fR -test can not be run on a Mac. This flag is used +. +This test can not be run on a Mac. This flag is used to temporarily disable a test. .TP \fIunixCrash\fR -test crashes if it is run on Unix. This flag is used to temporarily -disable a test. +. +This test crashes if it is run on Unix. This flag is used to temporarily +disable a test. .TP \fIwinCrash\fR -test crashes if it is run on Windows. This flag is used to temporarily -disable a test. +. +This test crashes if it is run on Windows. This flag is used to temporarily +disable a test. .TP \fImacCrash\fR -test crashes if it is run on a Mac. This flag is used to temporarily -disable a test. +. +This test crashes if it is run on a Mac. This flag is used to temporarily +disable a test. .TP \fIemptyTest\fR -test is empty, and so not worth running, but it remains as a +. +This test is empty, and so not worth running, but it remains as a place-holder for a test to be written in the future. This constraint has value false to cause tests to be skipped unless the user specifies otherwise. .TP \fIknownBug\fR -test is known to fail and the bug is not yet fixed. This constraint +. +This test is known to fail and the bug is not yet fixed. This constraint has value false to cause tests to be skipped unless the user specifies otherwise. .TP \fInonPortable\fR -test can only be run in some known development environment. +. +This test can only be run in some known development environment. Some tests are inherently non-portable because they depend on things like word length, file system configuration, window manager, etc. This constraint has value false to cause tests to be skipped unless -the user specifies otherwise. +the user specifies otherwise. .TP \fIuserInteraction\fR -test requires interaction from the user. This constraint has +. +This test requires interaction from the user. This constraint has value false to causes tests to be skipped unless the user specifies -otherwise. +otherwise. .TP \fIinteractive\fR -test can only be run in if the interpreter is in interactive mode +. +This test can only be run in if the interpreter is in interactive mode (when the global tcl_interactive variable is set to 1). .TP \fInonBlockFiles\fR -test can only be run if platform supports setting files into -nonblocking mode +. +This test can only be run if platform supports setting files into +nonblocking mode. .TP \fIasyncPipeClose\fR -test can only be run if platform supports async flush and async close -on a pipe +. +This test can only be run if platform supports async flush and async close +on a pipe. .TP \fIunixExecs\fR -test can only be run if this machine has Unix-style commands +. +This test can only be run if this machine has Unix-style commands \fBcat\fR, \fBecho\fR, \fBsh\fR, \fBwc\fR, \fBrm\fR, \fBsleep\fR, -\fBfgrep\fR, \fBps\fR, \fBchmod\fR, and \fBmkdir\fR available +\fBfgrep\fR, \fBps\fR, \fBchmod\fR, and \fBmkdir\fR available. .TP \fIhasIsoLocale\fR -test can only be run if can switch to an ISO locale +. +This test can only be run if can switch to an ISO locale. .TP \fIroot\fR -test can only run if Unix user is root +. +This test can only run if Unix user is root. .TP \fInotRoot\fR -test can only run if Unix user is not root +. +This test can only run if Unix user is not root. .TP \fIeformat\fR -test can only run if app has a working version of sprintf with respect +. +This test can only run if app has a working version of sprintf with respect to the .QW e format of floating-point numbers. .TP \fIstdio\fR -test can only be run if \fBinterpreter\fR can be \fBopen\fRed +. +This test can only be run if \fBinterpreter\fR can be \fBopen\fRed as a pipe. .PP The alternative mode of constraint control is enabled by setting @@ -685,7 +785,7 @@ up a configuration with .PP to run exactly those tests that exercise known bugs, and discover whether any of them pass, indicating the bug had been fixed. -.SH "RUNNING ALL TESTS" +.SS "RUNNING ALL TESTS" .PP The single command \fBrunAllTests\fR is evaluated to run an entire test suite, spanning many files and directories. The configuration @@ -702,7 +802,7 @@ and sorted. Then each file will be evaluated in turn. If be \fBsource\fRd in the caller's context. If it is false, then a copy of \fBinterpreter\fR will be \fBexec\fR'd to evaluate each file. The multi-process operation is useful -when testing can cause errors so severe that a process +when testing can cause errors so severe that a process terminates. Although such an error may terminate a child process evaluating one file, the master process can continue with the rest of the test suite. In multi-process operation, @@ -748,17 +848,19 @@ The \fBconfigure\fR command is used to set and query the configurable options of \fBtcltest\fR. The valid options are: .TP \fB\-singleproc \fIboolean\fR +. Controls whether or not \fBrunAllTests\fR spawns a child process for each test file. No spawning when \fIboolean\fR is true. Default value is false. .TP \fB\-debug \fIlevel\fR +. Sets the debug level to \fIlevel\fR, an integer value indicating how -much debugging information should be printed to stdout. Note that -debug messages always go to stdout, independent of the value of +much debugging information should be printed to \fBstdout\fR. Note that +debug messages always go to \fBstdout\fR, independent of the value of \fBconfigure \-outfile\fR. Default value is 0. Levels are defined as: .RS -.IP 0 +.IP 0 4 Do not display any debug information. .IP 1 Display information regarding whether a test is skipped because it @@ -769,41 +871,55 @@ print warnings about possible lack of cleanup or balance in test files. Also print warnings about any re-use of test names. .IP 2 Display the flag array parsed by the command line processor, the -contents of the ::env array, and all user-defined variables that exist -in the current namespace as they are used. +contents of the global \fBenv\fR array, and all user-defined variables +that exist in the current namespace as they are used. .IP 3 Display information regarding what individual procs in the test harness are doing. .RE .TP \fB\-verbose \fIlevel\fR +. Sets the type of output verbosity desired to \fIlevel\fR, a list of zero or more of the elements \fBbody\fR, \fBpass\fR, -\fBskip\fR, \fBstart\fR, \fBerror\fR and \fBline\fR. Default value -is \fB{body error}\fR. -Levels are defined as: +\fBskip\fR, \fBstart\fR, \fBerror\fR, \fBline\fR, \fBmsec\fR and \fBusec\fR. +Default value is +.QW "\fBbody error\fR" . +Levels are defined as: .RS -.IP "body (b)" +.IP "body (\fBb\fR)" Display the body of failed tests -.IP "pass (p)" +.IP "pass (\fBp\fR)" Print output when a test passes -.IP "skip (s)" +.IP "skip (\fBs\fR)" Print output when a test is skipped -.IP "start (t)" +.IP "start (\fBt\fR)" Print output whenever a test starts -.IP "error (e)" +.IP "error (\fBe\fR)" Print errorInfo and errorCode, if they exist, when a test return code does not match its expected return code -.IP "line (l)" +.IP "line (\fBl\fR)" Print source file line information of failed tests -.RE +.IP "msec (\fBm\fR)" +Print each test's execution time in milliseconds +.IP "usec (\fBu\fR)" +Print each test's execution time in microseconds +.PP +Note that the \fBmsec\fR and \fBusec\fR verbosity levels are provided as +indicative measures only. They do not tackle the problem of repeatibility which +should be considered in performance tests or benchmarks. To use these verbosity +levels to thoroughly track performance degradations, consider wrapping your +test bodies with \fBtime\fR commands. +.PP The single letter abbreviations noted above are also recognized so that .QW "\fBconfigure \-verbose pt\fR" is the same as .QW "\fBconfigure \-verbose {pass start}\fR" . +.RE .TP \fB\-preservecore \fIlevel\fR +. Sets the core preservation level to \fIlevel\fR. This level determines how stringent checks for core files are. Default value is 0. Levels are defined as: @@ -815,21 +931,24 @@ test files have been evaluated. .IP 1 Also check for core files at the end of each \fBtest\fR command. .IP 2 -Check for core files at all times described above, and save a +Check for core files at all times described above, and save a copy of each core file produced in \fBconfigure \-tmpdir\fR. .RE .TP \fB\-limitconstraints \fIboolean\fR +. Sets the mode by which \fBtest\fR honors constraints as described in \fBTESTS\fR above. Default value is false. .TP \fB\-constraints \fIlist\fR +. Sets all the constraints in \fIlist\fR to true. Also used in combination with \fBconfigure \-limitconstraints true\fR to control an alternative constraint mode as described in \fBTESTS\fR above. Default value is an empty list. .TP \fB\-tmpdir \fIdirectory\fR +. Sets the temporary directory to be used by \fBmakeFile\fR, \fBmakeDirectory\fR, \fBviewFile\fR, \fBremoveFile\fR, and \fBremoveDirectory\fR as the default directory where @@ -837,55 +956,66 @@ temporary files and directories created by test files should be created. Default value is \fBworkingDirectory\fR. .TP \fB\-testdir \fIdirectory\fR +. Sets the directory searched by \fBrunAllTests\fR for test files and subdirectories. Default value is \fBworkingDirectory\fR. .TP \fB\-file \fIpatternList\fR +. Sets the list of patterns used by \fBrunAllTests\fR to determine what test files to evaluate. Default value is .QW \fB*.test\fR . .TP \fB\-notfile \fIpatternList\fR +. Sets the list of patterns used by \fBrunAllTests\fR to determine what test files to skip. Default value is .QW \fBl.*.test\fR , so that any SCCS lock files are skipped. .TP \fB\-relateddir \fIpatternList\fR +. Sets the list of patterns used by \fBrunAllTests\fR to determine what subdirectories to search for an \fBall.tcl\fR file. Default value is .QW \fB*\fR . .TP \fB\-asidefromdir \fIpatternList\fR +. Sets the list of patterns used by \fBrunAllTests\fR to determine what subdirectories to skip when searching for an \fBall.tcl\fR file. Default value is an empty list. .TP \fB\-match \fIpatternList\fR +. Set the list of patterns used by \fBtest\fR to determine whether a test should be run. Default value is .QW \fB*\fR . .TP \fB\-skip \fIpatternList\fR +. Set the list of patterns used by \fBtest\fR to determine whether a test should be skipped. Default value is an empty list. .TP \fB\-load \fIscript\fR +. Sets a script to be evaluated by \fBloadTestedCommands\fR. Default value is an empty script. .TP \fB\-loadfile \fIfilename\fR +. Sets the filename from which to read a script to be evaluated by \fBloadTestedCommands\fR. This is an alternative to \fB\-load\fR. They cannot be used together. .TP -\fB\-outfile \fIfilename\fR +\fB\-outfile \fIfilename\fR +. Sets the file to which all output produced by tcltest should be written. A file named \fIfilename\fR will be \fBopen\fRed for writing, and the resulting channel will be set as the value of \fBoutputChannel\fR. .TP \fB\-errfile \fIfilename\fR +. Sets the file to which all error output produced by tcltest should be written. A file named \fIfilename\fR will be \fBopen\fRed for writing, and the resulting channel will be set as the value @@ -948,12 +1078,14 @@ Test with a constraint. .PP At the next higher layer of organization, several \fBtest\fR commands are gathered together into a single test file. Test files should have -names with the \fB.test\fR extension, because that is the default pattern +names with the +.QW \fB.test\fR +extension, because that is the default pattern used by \fBrunAllTests\fR to find test files. It is a good rule of thumb to have one test file for each source code file of your project. It is good practice to edit the test file and the source code file together, keeping tests synchronized with code changes. -.PP +.PP Most of the code in the test file should be the \fBtest\fR commands. Use constraints to skip tests, rather than conditional evaluation of \fBtest\fR. @@ -976,7 +1108,7 @@ guard: .PP .CS if $myRequirement { - test badConditionalTest {} { + \fBtest\fR badConditionalTest {} { #body } result } @@ -1066,7 +1198,7 @@ to continue to support existing test suites written to the older interface specifications, many of those deprecated commands and variables still work as before. For example, in many circumstances, \fBconfigure\fR will be automatically called shortly after -\fBpackage require tcltest 2.1\fR succeeds with arguments +\fBpackage require\fR \fBtcltest 2.1\fR succeeds with arguments from the variable \fB::argv\fR. This is to support test suites that depend on the old behavior that \fBtcltest\fR was automatically configured from command line arguments. New test files should not @@ -1076,12 +1208,18 @@ depend on this, but should explicitly include eval \fB::tcltest::configure\fR $::argv .CE .PP +or +.PP +.CS +\fB::tcltest::configure\fR {*}$::argv +.CE +.PP to establish a configuration from command line arguments. .SH "KNOWN ISSUES" There are two known issues related to nested evaluations of \fBtest\fR. The first issue relates to the stack level in which test scripts are executed. Tests nested within other tests may be executed at the same -stack level as the outermost test. For example, in the following code: +stack level as the outermost test. For example, in the following code: .PP .CS \fBtest\fR level-1.1 {level 1} { @@ -1093,7 +1231,7 @@ stack level as the outermost test. For example, in the following code: .CE .PP any script executed in level-2.1 may be executed at the same stack -level as the script defined for level-1.1. +level as the script defined for level-1.1. .PP In addition, while two \fBtest\fRs have been run, results will only be reported by \fBcleanupTests\fR for tests at the same level as @@ -1117,12 +1255,15 @@ and refer to tests that were run at the same test level as test level-1.1. .PP Implementation of output and error comparison in the test command -depends on usage of ::puts in your application code. Output is -intercepted by redefining the ::puts command while the defined test +depends on usage of \fBputs\fR in your application code. Output is +intercepted by redefining the global \fBputs\fR command while the defined test script is being run. Errors thrown by C procedures or printed -directly from C applications will not be caught by the test command. +directly from C applications will not be caught by the \fBtest\fR command. Therefore, usage of the \fB\-output\fR and \fB\-errorOutput\fR options to \fBtest\fR is useful only for pure Tcl applications -that use \fB::puts\fR to produce output. +that use \fBputs\fR to produce output. .SH KEYWORDS test, test harness, test suite +.\" Local Variables: +.\" mode: nroff +.\" End: diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index 987725f..fde3ffe 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.tcl @@ -8,5 +8,5 @@ # script is sourced, the variable $dir must contain the # full path name of this file's directory. -if {![package vsatisfies [package provide Tcl] 8.5]} {return} -package ifneeded tcltest 2.3.8 [list source [file join $dir tcltest.tcl]] +if {![package vsatisfies [package provide Tcl] 8.5-]} {return} +package ifneeded tcltest 2.5.0 [list source [file join $dir tcltest.tcl]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 936acaa..410aa24 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -16,13 +16,13 @@ # Contributions from Don Porter, NIST, 2002. (not subject to US copyright) # All rights reserved. -package require Tcl 8.5 ;# -verbose line uses [info frame] +package require Tcl 8.5- ;# -verbose line uses [info frame] namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, # and the install directory in the Makefiles. When the minor version # changes (new feature) be sure to update the man page as well. - variable Version 2.3.8 + variable Version 2.5.0 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] @@ -347,7 +347,7 @@ namespace eval tcltest { # This is very subtle and tricky, so let me try to explain. # (Hopefully this longer comment will be clear when I come # back in a few months, unlike its predecessor :) ) - # + # # The [outputChannel] command (and underlying variable) have to # be kept in sync with the [configure -outfile] configuration # option ( and underlying variable Option(-outfile) ). This is @@ -362,12 +362,12 @@ namespace eval tcltest { # configuration options to parse the command line option the first # time they are read. These traces are cancelled whenever the # program itself calls [configure]. - # + # # OK, then so to support tcltest 1 compatibility, it seems we want # to get the return from [outputFile] to trigger the read traces, # just in case. # - # BUT! A little known feature of Tcl variable traces is that + # BUT! A little known feature of Tcl variable traces is that # traces are disabled during the handling of other traces. So, # if we trigger read traces on Option(-outfile) and that triggers # command line parsing which turns around and sets an initial @@ -608,19 +608,30 @@ namespace eval tcltest { set code [catch {Configure {*}$args} msg] return -code $code $msg } - + proc AcceptVerbose { level } { set level [AcceptList $level] + set levelMap { + l list + p pass + b body + s skip + t start + e error + l line + m msec + u usec + } + set levelRegexp "^([join [dict values $levelMap] |])\$" if {[llength $level] == 1} { - if {![regexp {^(pass|body|skip|start|error|line)$} $level]} { + if {![regexp $levelRegexp $level]} { # translate single characters abbreviations to expanded list - set level [string map {p pass b body s skip t start e error l line} \ - [split $level {}]] + set level [string map $levelMap [split $level {}]] } } set valid [list] foreach v $level { - if {[regexp {^(pass|body|skip|start|error|line)$} $v]} { + if {[regexp $levelRegexp $v]} { lappend valid $v } } @@ -639,7 +650,7 @@ namespace eval tcltest { skipped tests if 's' is specified, the bodies of failed tests if 'b' is specified, and when tests start if 't' is specified. ErrorInfo is displayed if 'e' is specified. Source file line - information of failed tests is displayed if 'l' is specified. + information of failed tests is displayed if 'l' is specified. } AcceptVerbose verbose # Match and skip patterns default to the empty list, except for @@ -687,7 +698,7 @@ namespace eval tcltest { # some additional output regarding operations of the test harness. # The tcltest package currently implements only up to debug level 3. Option -debug 0 { - Internal debug level + Internal debug level } AcceptInteger debug proc SetSelectedConstraints args { @@ -715,7 +726,7 @@ namespace eval tcltest { } Option -limitconstraints 0 { whether to run only tests with the constraints - } AcceptBoolean limitConstraints + } AcceptBoolean limitConstraints trace add variable Option(-limitconstraints) write \ [namespace code {ClearUnselectedConstraints ;#}] @@ -728,7 +739,7 @@ namespace eval tcltest { # Default is to run each test file in a separate process Option -singleproc 0 { whether to run all tests in one process - } AcceptBoolean singleProcess + } AcceptBoolean singleProcess proc AcceptTemporaryDirectory { directory } { set directory [AcceptAbsolutePath $directory] @@ -1243,10 +1254,6 @@ proc tcltest::DefineConstraintInitializers {} { ConstraintInitializer interactive \ {expr {[info exists ::tcl_interactive] && $::tcl_interactive}} - # Skip slow tests (to enable slow tests add parameter `-constraints slowTest`) - - ConstraintInitializer slowTest {format 0} - # Some tests can only be run if the installation came from a CD # image instead of a web image. Some tests must be skipped if you # are running as root on Unix. Other tests can only be run if you @@ -1261,7 +1268,7 @@ proc tcltest::DefineConstraintInitializers {} { # setting files into nonblocking mode. ConstraintInitializer nonBlockFiles { - set code [expr {[catch {set f [open defs r]}] + set code [expr {[catch {set f [open defs r]}] || [catch {chan configure $f -blocking off}]}] catch {close $f} set code @@ -1275,7 +1282,7 @@ proc tcltest::DefineConstraintInitializers {} { # (Mark Diekhans). ConstraintInitializer asyncPipeClose {expr { - !([string equal unix $::tcl_platform(platform)] + !([string equal unix $::tcl_platform(platform)] && ([catch {exec uname -X | fgrep {Release = 3.2v}}] == 0))}} # Test to see if we have a broken version of sprintf with respect @@ -1834,6 +1841,9 @@ proc tcltest::SubstArguments {argList} { # is optional; default is {}. # returnCodes - Expected return codes. This attribute is # optional; default is {0 2}. +# errorCode - Expected error code. This attribute is +# optional; default is {*}. It is a glob pattern. +# If given, returnCodes defaults to {1}. # setup - Code to run before $script (above). This # attribute is optional; default is {}. # cleanup - Code to run after $script (above). This @@ -1875,7 +1885,7 @@ proc tcltest::test {name description args} { # Pre-define everything to null except output and errorOutput. We # determine whether or not to trap output based on whether or not # these variables (output & errorOutput) are defined. - lassign {} constraints setup cleanup body result returnCodes match + lassign {} constraints setup cleanup body result returnCodes errorCode match # Set the default match mode set match exact @@ -1885,6 +1895,9 @@ proc tcltest::test {name description args} { # 'return' being used in the test script). set returnCodes [list 0 2] + # Set the default error code pattern + set errorCode "*" + # The old test format can't have a 3rd argument (constraints or # script) that starts with '-'. if {[string match -* [lindex $args 0]] || ([llength $args] <= 1)} { @@ -1894,7 +1907,7 @@ proc tcltest::test {name description args} { set testAttributes($element) $value } foreach item {constraints match setup body cleanup \ - result returnCodes output errorOutput} { + result returnCodes errorCode output errorOutput} { if {[info exists testAttributes(-$item)]} { set testAttributes(-$item) [uplevel 1 \ ::concat $testAttributes(-$item)] @@ -1905,7 +1918,7 @@ proc tcltest::test {name description args} { } set validFlags {-setup -cleanup -body -result -returnCodes \ - -match -output -errorOutput -constraints} + -errorCode -match -output -errorOutput -constraints} foreach flag [array names testAttributes] { if {$flag ni $validFlags} { @@ -1937,6 +1950,10 @@ proc tcltest::test {name description args} { foreach {strcode numcode} {ok 0 normal 0 error 1 return 2 break 3 continue 4} { set returnCodes [string map -nocase [list $strcode $numcode] $returnCodes] } + # errorCode without returnCode 1 is meaningless + if {$errorCode ne "*" && 1 ni $returnCodes} { + set returnCodes 1 + } } else { # This is parsing for the old test command format; it is here # for backward compatibility. @@ -1958,7 +1975,7 @@ proc tcltest::test {name description args} { return } - # Save information about the core file. + # Save information about the core file. if {[preserveCore]} { if {[file exists [file join [workingDirectory] core]]} { set coreModTime [file mtime [file join [workingDirectory] core]] @@ -1969,13 +1986,18 @@ proc tcltest::test {name description args} { set code [catch {uplevel 1 $setup} setupMsg] if {$code == 1} { set errorInfo(setup) $::errorInfo - set errorCode(setup) $::errorCode + set errorCodeRes(setup) $::errorCode } set setupFailure [expr {$code != 0}] # Only run the test body if the setup was successful if {!$setupFailure} { + # Register startup time + if {[IsVerbose msec] || [IsVerbose usec]} { + set timeStart [clock microseconds] + } + # Verbose notification of $body start if {[IsVerbose start]} { puts [outputChannel] "---- $name start" @@ -1991,7 +2013,7 @@ proc tcltest::test {name description args} { lassign $testResult actualAnswer returnCode if {$returnCode == 1} { set errorInfo(body) $::errorInfo - set errorCode(body) $::errorCode + set errorCodeRes(body) $::errorCode } } @@ -2000,6 +2022,11 @@ proc tcltest::test {name description args} { if {!$setupFailure && ($returnCode ni $returnCodes)} { set codeFailure 1 } + set errorCodeFailure 0 + if {!$setupFailure && !$codeFailure && $returnCode == 1 && \ + ![string match $errorCode $errorCodeRes(body)]} { + set errorCodeFailure 1 + } # If expected output/error strings exist, we have to compare # them. If the comparison fails, then so did the test. @@ -2043,7 +2070,7 @@ proc tcltest::test {name description args} { set code [catch {uplevel 1 $cleanup} cleanupMsg] if {$code == 1} { set errorInfo(cleanup) $::errorInfo - set errorCode(cleanup) $::errorCode + set errorCodeRes(cleanup) $::errorCode } set cleanupFailure [expr {$code != 0}] @@ -2064,7 +2091,7 @@ proc tcltest::test {name description args} { } else { set coreFailure 1 } - + if {([preserveCore] > 1) && ($coreFailure)} { append coreMsg "\nMoving file to:\ [file join [temporaryDirectory] core-$name]" @@ -2080,11 +2107,21 @@ proc tcltest::test {name description args} { } } + if {[IsVerbose msec] || [IsVerbose usec]} { + set t [expr {[clock microseconds] - $timeStart}] + if {[IsVerbose usec]} { + puts [outputChannel] "++++ $name took $t μs" + } + if {[IsVerbose msec]} { + puts [outputChannel] "++++ $name took [expr {round($t/1000.)}] ms" + } + } + # if we didn't experience any failures, then we passed variable numTests if {!($setupFailure || $cleanupFailure || $coreFailure || $outputFailure || $errorFailure || $codeFailure - || $scriptFailure)} { + || $errorCodeFailure || $scriptFailure)} { if {$testLevel == 1} { incr numTests(Passed) if {[IsVerbose pass]} { @@ -2104,7 +2141,7 @@ proc tcltest::test {name description args} { variable currentFailure true if {![IsVerbose body]} { set body "" - } + } puts [outputChannel] "\n" if {[IsVerbose line]} { if {![catch {set testFrame [info frame -1]}] && @@ -2125,7 +2162,7 @@ proc tcltest::test {name description args} { puts [outputChannel] "$testFile:$testLine: error: test failed:\ $name [string trim $description]" } - } + } puts [outputChannel] "==== $name\ [string trim $description] FAILED" if {[string length $body]} { @@ -2137,7 +2174,7 @@ proc tcltest::test {name description args} { failed:\n$setupMsg" if {[info exists errorInfo(setup)]} { puts [outputChannel] "---- errorInfo(setup): $errorInfo(setup)" - puts [outputChannel] "---- errorCode(setup): $errorCode(setup)" + puts [outputChannel] "---- errorCode(setup): $errorCodeRes(setup)" } } if {$scriptFailure} { @@ -2149,6 +2186,10 @@ proc tcltest::test {name description args} { ($match matching):\n$result" } } + if {$errorCodeFailure} { + puts [outputChannel] "---- Error code was: '$errorCodeRes(body)'" + puts [outputChannel] "---- Error code should have been: '$errorCode'" + } if {$codeFailure} { switch -- $returnCode { 0 { set msg "Test completed normally" } @@ -2164,7 +2205,7 @@ proc tcltest::test {name description args} { if {[IsVerbose error]} { if {[info exists errorInfo(body)] && (1 ni $returnCodes)} { puts [outputChannel] "---- errorInfo: $errorInfo(body)" - puts [outputChannel] "---- errorCode: $errorCode(body)" + puts [outputChannel] "---- errorCode: $errorCodeRes(body)" } } } @@ -2190,7 +2231,7 @@ proc tcltest::test {name description args} { puts [outputChannel] "---- Test cleanup failed:\n$cleanupMsg" if {[info exists errorInfo(cleanup)]} { puts [outputChannel] "---- errorInfo(cleanup): $errorInfo(cleanup)" - puts [outputChannel] "---- errorCode(cleanup): $errorCode(cleanup)" + puts [outputChannel] "---- errorCode(cleanup): $errorCodeRes(cleanup)" } } if {$coreFailure} { @@ -2281,7 +2322,7 @@ proc tcltest::Skipped {name constraints} { } } } - + if {!$doTest} { if {[IsVerbose skip]} { puts [outputChannel] "++++ $name SKIPPED: $constraints" @@ -2687,7 +2728,7 @@ proc tcltest::GetMatchingDirectories {rootdir} { DebugPuts 1 "No test directories remain after applying match\ and skip patterns!" } - return $matchDirs + return [lsort $matchDirs] } # tcltest::runAllTests -- @@ -2700,7 +2741,7 @@ proc tcltest::GetMatchingDirectories {rootdir} { # shell being tested # # Results: -# None. +# Whether there were any failures. # # Side effects: # None. @@ -2838,15 +2879,15 @@ proc tcltest::runAllTests { {shell ""} } { set dir [file tail $directory] puts [outputChannel] [string repeat ~ 44] puts [outputChannel] "$dir test began at [eval $timeCmd]\n" - + uplevel 1 [list ::source [file join $directory all.tcl]] - + set endTime [eval $timeCmd] puts [outputChannel] "\n$dir test ended at $endTime" puts [outputChannel] "" puts [outputChannel] [string repeat ~ 44] } - return + return [info exists testFileFailures] } ##################################################################### @@ -3023,7 +3064,7 @@ proc tcltest::removeFile {name {directory ""}} { DebugDo 1 { Warn "removeFile removing \"$fullName\":\n not created by makeFile" } - } + } if {![file isfile $fullName]} { DebugDo 1 { Warn "removeFile removing \"$fullName\":\n not a file" @@ -3094,7 +3135,7 @@ proc tcltest::removeDirectory {name {directory ""}} { Warn "removeDirectory removing \"$fullName\":\n not created\ by makeDirectory" } - } + } if {![file isdirectory $fullName]} { DebugDo 1 { Warn "removeDirectory removing \"$fullName\":\n not a directory" @@ -3289,7 +3330,7 @@ proc tcltest::threadReap {} { testthread errorproc ThreadError return [llength [testthread names]] } elseif {[info commands thread::id] ne {}} { - + # Thread extension thread::errorproc ThreadNullError diff --git a/tests/tcltest.test b/tests/tcltest.test index 028d4fa..ca720ee 100644 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -46,6 +46,7 @@ makeFile { cd [temporaryDirectory] testConstraint exec [llength [info commands exec]] + # test -help # Child processes because -help [exit]s. test tcltest-1.1 {tcltest -help} {exec} { @@ -142,7 +143,7 @@ test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrPc} { } {0 1 1 1 1} test tcltest-2.6 {tcltest -verbose 't'} { - -constraints {unixOrPc} + -constraints {unixOrPc} -body { set result [slave msg test.tcl -verbose 't'] list $result $msg @@ -152,7 +153,7 @@ test tcltest-2.6 {tcltest -verbose 't'} { } test tcltest-2.6a {tcltest -verbose 'start'} { - -constraints {unixOrPc} + -constraints {unixOrPc} -body { set result [slave msg test.tcl -verbose start] list $result $msg @@ -169,7 +170,7 @@ test tcltest-2.7 {tcltest::verbose} { verbose foo set newVerbosity [verbose] verbose $oldVerbosity - list $currentVerbosity $newVerbosity + list $currentVerbosity $newVerbosity } -result {body {}} } @@ -217,7 +218,7 @@ test tcltest-3.5 {tcltest::match} { } -result {foo bar} } - + # -skip, [skip] test tcltest-4.1 {tcltest -skip 'a*'} {unixOrPc} { set result [slave msg test.tcl -skip a* -verbose 'ps'] @@ -299,8 +300,8 @@ test tcltest-5.3 {testConstraint - constraint empty (tcltest::safeFetch)} { # -result {{} tcltestFakeConstraint1 {tcltestFakeConstraint1 tcltestFakeConstraint2}} # -cleanup { # set ::tcltest::constraintsSpecified $constraintlist -# unset ::tcltest::testConstraints(tcltestFakeConstraint1) -# unset ::tcltest::testConstraints(tcltestFakeConstraint2) +# unset ::tcltest::testConstraints(tcltestFakeConstraint1) +# unset ::tcltest::testConstraints(tcltestFakeConstraint2) # } #} @@ -311,7 +312,7 @@ test tcltest-5.5 {InitConstraints: list of built-in constraints} \ -result [lsort { 95 98 asyncPipeClose eformat emptyTest exec hasIsoLocale interactive knownBug mac macCrash macOnly macOrPc macOrUnix macOrWin nonBlockFiles - nonPortable notRoot nt pc pcCrash pcOnly root singleTestInterp slowTest socket + nonPortable notRoot nt pc pcCrash pcOnly root singleTestInterp socket stdio tempNotMac tempNotPc tempNotUnix tempNotWin unix unixCrash unixExecs unixOnly unixOrPc unixOrWin userInteraction win winCrash winOnly }] @@ -348,7 +349,7 @@ set printerror [makeFile { ::tcltest::PrintError "a really really long string containing a \ \"Path/that/is/really/long/and/contains/no/spaces\"" ::tcltest::PrintError "a really really long string containing a \ - \"Really/Long/Path/that/contains/no/spaces/and/is/longer/than/eighty/characters/to/see/what/happens\"" + \"Really/Long/Path/that/contains/no/spaces/and/is/longer/than/eighty/characters/to/see/what/happens\"" ::tcltest::PrintError "Problem renaming file: error renaming \"Z:/ws/tcl8.2/win32-ix86/tests/core\" to \"Z:/ws/tcl8.2/win32-ix86/tests/movecore-core\"" exit } printerror.tcl] @@ -367,7 +368,7 @@ test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrPc unixExecs} { set result1 [catch {exec grep "a test" a.tmp}] set result2 [catch {exec grep "a really" a.tmp}] list [regexp "a test" $msg] [regexp "a really" $msg] \ - $result1 $result2 [file exists a.tmp] [file delete a.tmp] + $result1 $result2 [file exists a.tmp] [file delete a.tmp] } {0 1 0 1 1 {}} test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrPc unixExecs} { slave msg $printerror -errfile a.tmp @@ -413,7 +414,7 @@ test tcltest-6.6 {tcltest::errorFile (implicit errorChannel)} { set f2 [errorFile $ef] set f3 [errorChannel] set f4 [errorFile] - subst {$f0;$f1;$f2;$f3;$f4} + subst {$f0;$f1;$f2;$f3;$f4} } -result {stderr;stderr;.*efile;file[0-9a-f]+;.*efile} -match regexp @@ -449,7 +450,7 @@ test tcltest-6.8 {tcltest::outputFile (implicit outputFile)} { set f2 [outputFile $ef] set f3 [outputChannel] set f4 [outputFile] - subst {$f0;$f1;$f2;$f3;$f4} + subst {$f0;$f1;$f2;$f3;$f4} } -result {stdout;stdout;.*efile;file[0-9a-f]+;.*efile} -match regexp @@ -719,7 +720,7 @@ switch -- $::tcl_platform(platform) { file attributes $notWriteableDir -permissions 777 } default { - catch {testchmod 777 $notWriteableDir} + catch {testchmod 0o777 $notWriteableDir} catch {file attributes $notWriteableDir -readonly 0} } } @@ -760,7 +761,7 @@ test tcltest-9.3 {matchFiles} { set new [matchFiles] matchFiles $old list $current $new - } + } -result {foo bar} } @@ -773,7 +774,7 @@ test tcltest-9.4 {skipFiles} { set new [skipFiles] skipFiles $old list $current $new - } + } -result {foo bar} } @@ -907,7 +908,9 @@ removeFile load.tcl # [interpreter] test tcltest-13.1 {interpreter} { + -constraints notValgrind -setup { + #to do: Why is $::tcltest::tcltest being saved and restored here? set old $::tcltest::tcltest set ::tcltest::tcltest tcltest } @@ -919,6 +922,11 @@ test tcltest-13.1 {interpreter} { } -result {tcltest tclsh tclsh} -cleanup { + # writing ::tcltest::tcltest triggers a trace that sets up the stdio + # constraint, which involves a call to [exec] that might fail after + # "fork" and before "exec", in which case the forked process will not + # have a chance to clean itself up before exiting, which causes + # valgrind to issue numerous "still reachable" reports. set ::tcltest::tcltest $old } } @@ -1148,7 +1156,7 @@ test tcltest-19.1 {TCLTEST_OPTIONS default} -setup { interp delete slave2 interp delete slave1 if {$oldoptions eq "none"} { - unset ::env(TCLTEST_OPTIONS) + unset ::env(TCLTEST_OPTIONS) } else { set ::env(TCLTEST_OPTIONS) $oldoptions } @@ -1199,7 +1207,7 @@ test tcltest-21.2 {force a test command failure} { } {1} } -returnCodes 1 - -result {bad option "1": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup} + -result {bad option "1": must be -body, -cleanup, -constraints, -errorCode, -errorOutput, -match, -output, -result, -returnCodes, or -setup} } test tcltest-21.3 {test command with setup} { @@ -1262,7 +1270,7 @@ test tcltest-21.6 {test command - setup occurs before cleanup & before script} { } set foo 1 set expected 2 - } + } -body { incr foo set foo @@ -1292,7 +1300,7 @@ test tcltest-21.7 {test command - bad flag} { } } -returnCodes 1 - -result {bad option "-foobar": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup} + -result {bad option "-foobar": must be -body, -cleanup, -constraints, -errorCode, -errorOutput, -match, -output, -result, -returnCodes, or -setup} } # alternate test command format (these are the same as 21.1-21.6, with the @@ -1312,7 +1320,7 @@ test tcltest-21.8 {force a test command failure} \ } \ -returnCodes 1 \ -cleanup {set ::tcltest::currentFailure $fail} \ - -result {bad option "1": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup} + -result {bad option "1": must be -body, -cleanup, -constraints, -errorCode, -errorOutput, -match, -output, -result, -returnCodes, or -setup} test tcltest-21.9 {test command with setup} \ -setup {set foo 1} \ @@ -1426,7 +1434,7 @@ test tcltest-23.1 {makeFile} { } -cleanup { file delete -force $mfdir \ - [file join [temporaryDirectory] t1.tmp] + [file join [temporaryDirectory] t1.tmp] } -result {1 1} } @@ -1449,7 +1457,7 @@ test tcltest-23.2 {removeFile} { } -cleanup { file delete -force $mfdir \ - [file join [temporaryDirectory] t1.tmp] + [file join [temporaryDirectory] t1.tmp] } -result {0 0} } @@ -1826,9 +1834,13 @@ test tcltest-26.2 {Bug/RFE 1017151} -setup { ---- errorInfo: body error * ---- errorInfo(cleanup): cleanup error*} - + cleanupTests } namespace delete ::tcltest::test return + +# Local Variables: +# mode: tcl +# End: diff --git a/unix/Makefile.in b/unix/Makefile.in index 50f4bb3..7e8e4a3 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -785,8 +785,8 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs done; @echo "Installing package msgcat 1.5.2 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.5.2.tm; - @echo "Installing package tcltest 2.3.8 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.8.tm; + @echo "Installing package tcltest 2.5.0 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.5.0.tm; @echo "Installing package platform 1.0.14 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.14.tm; diff --git a/win/Makefile.in b/win/Makefile.in index 7fc415d..f197190 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -659,8 +659,8 @@ install-libraries: libraries install-tzdata install-msgs done; @echo "Installing package msgcat 1.5.2 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.2.tm; - @echo "Installing package tcltest 2.3.8 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.8.tm; + @echo "Installing package tcltest 2.5.0 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.5.0.tm; @echo "Installing package platform 1.0.14 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; diff --git a/win/makefile.bc b/win/makefile.bc index 577c865..8f337e3 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -432,10 +432,10 @@ install-libraries: -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.5" -@copy "$(ROOT)\library\msgcat\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.5" -@copy "$(ROOT)\library\msgcat\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.5" - @echo Installing tcltest2.3 - -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\tcltest2.3" - -@copy "$(ROOT)\library\tcltest\tcltest.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3" - -@copy "$(ROOT)\library\tcltest\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3" + @echo Installing tcltest2.5 + -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\tcltest2.5" + -@copy "$(ROOT)\library\tcltest\tcltest.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.5" + -@copy "$(ROOT)\library\tcltest\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.5" @echo Installing platform1.0 -@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\platform1.0" -@copy "$(ROOT)\library\platform\platform.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0" -- cgit v0.12 From ce6023fade965eb75c891c4d455cd95c25a169d1 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 29 Oct 2018 14:38:24 +0000 Subject: [TIP 525] Backport package tcltest 2.5 --- doc/tcltest.n | 14 ++++++++++++-- library/tcltest/pkgIndex.tcl | 4 ++-- library/tcltest/tcltest.tcl | 45 +++++++++++++++++++++++++++++++------------- tests/tcltest.test | 10 +++++----- unix/Makefile.in | 4 ++-- win/Makefile.in | 4 ++-- 6 files changed, 55 insertions(+), 26 deletions(-) diff --git a/doc/tcltest.n b/doc/tcltest.n index 05c1922..b161a2b 100644 --- a/doc/tcltest.n +++ b/doc/tcltest.n @@ -8,7 +8,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.TH "tcltest" n 2.3 tcltest "Tcl Bundled Packages" +.TH "tcltest" n 2.5 tcltest "Tcl Bundled Packages" .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! @@ -16,7 +16,7 @@ tcltest \- Test harness support code and utilities .SH SYNOPSIS .nf -\fBpackage require tcltest\fR ?\fB2.3\fR? +\fBpackage require tcltest\fR ?\fB2.5\fR? \fBtcltest::test \fIname description\fR ?\fI\-option value ...\fR? \fBtcltest::test \fIname description\fR ?\fIconstraints\fR? \fIbody result\fR @@ -454,6 +454,7 @@ The valid options for \fBtest\fR are summarized: ?\fB\-output \fIexpectedOutput\fR? ?\fB\-errorOutput \fIexpectedError\fR? ?\fB\-returnCodes \fIcodeList\fR? + ?\fB\-errorCode \fIexpectedErrorCode\fR? ?\fB\-match \fImode\fR? .CE .PP @@ -577,6 +578,15 @@ return codes known to \fBreturn\fR, in both numeric and symbolic form, including extended return codes, are acceptable elements in the \fIexpectedCodeList\fR. Default value is .QW "\fBok return\fR" . +.TP +\fB\-errorCode \fIexpectedErrorCode\fR +. +The optional \fB\-errorCode\fR attribute supplies \fIexpectedErrorCode\fR, +a glob pattern that should match the error code reported from evaluation of the +\fB\-body\fR script. If evaluation of the \fB\-body\fR script returns +a code not matching \fIexpectedErrorCode\fR, the test fails. Default value is +.QW "\fB*\fR" . +If \fB\-returnCodes\fR does not include \fBerror\fR it is set to \fBerror\fR. .PP To pass, a test must successfully evaluate its \fB\-setup\fR, \fB\-body\fR, and \fB\-cleanup\fR scripts. The return code of the \fB\-body\fR script and diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index c9d3759..fde3ffe 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.tcl @@ -8,5 +8,5 @@ # script is sourced, the variable $dir must contain the # full path name of this file's directory. -if {![package vsatisfies [package provide Tcl] 8.5]} {return} -package ifneeded tcltest 2.4.1 [list source [file join $dir tcltest.tcl]] +if {![package vsatisfies [package provide Tcl] 8.5-]} {return} +package ifneeded tcltest 2.5.0 [list source [file join $dir tcltest.tcl]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index f1b6082..410aa24 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -22,7 +22,7 @@ namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, # and the install directory in the Makefiles. When the minor version # changes (new feature) be sure to update the man page as well. - variable Version 2.4.1 + variable Version 2.5.0 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] @@ -1841,6 +1841,9 @@ proc tcltest::SubstArguments {argList} { # is optional; default is {}. # returnCodes - Expected return codes. This attribute is # optional; default is {0 2}. +# errorCode - Expected error code. This attribute is +# optional; default is {*}. It is a glob pattern. +# If given, returnCodes defaults to {1}. # setup - Code to run before $script (above). This # attribute is optional; default is {}. # cleanup - Code to run after $script (above). This @@ -1882,7 +1885,7 @@ proc tcltest::test {name description args} { # Pre-define everything to null except output and errorOutput. We # determine whether or not to trap output based on whether or not # these variables (output & errorOutput) are defined. - lassign {} constraints setup cleanup body result returnCodes match + lassign {} constraints setup cleanup body result returnCodes errorCode match # Set the default match mode set match exact @@ -1892,6 +1895,9 @@ proc tcltest::test {name description args} { # 'return' being used in the test script). set returnCodes [list 0 2] + # Set the default error code pattern + set errorCode "*" + # The old test format can't have a 3rd argument (constraints or # script) that starts with '-'. if {[string match -* [lindex $args 0]] || ([llength $args] <= 1)} { @@ -1901,7 +1907,7 @@ proc tcltest::test {name description args} { set testAttributes($element) $value } foreach item {constraints match setup body cleanup \ - result returnCodes output errorOutput} { + result returnCodes errorCode output errorOutput} { if {[info exists testAttributes(-$item)]} { set testAttributes(-$item) [uplevel 1 \ ::concat $testAttributes(-$item)] @@ -1912,7 +1918,7 @@ proc tcltest::test {name description args} { } set validFlags {-setup -cleanup -body -result -returnCodes \ - -match -output -errorOutput -constraints} + -errorCode -match -output -errorOutput -constraints} foreach flag [array names testAttributes] { if {$flag ni $validFlags} { @@ -1944,6 +1950,10 @@ proc tcltest::test {name description args} { foreach {strcode numcode} {ok 0 normal 0 error 1 return 2 break 3 continue 4} { set returnCodes [string map -nocase [list $strcode $numcode] $returnCodes] } + # errorCode without returnCode 1 is meaningless + if {$errorCode ne "*" && 1 ni $returnCodes} { + set returnCodes 1 + } } else { # This is parsing for the old test command format; it is here # for backward compatibility. @@ -1976,7 +1986,7 @@ proc tcltest::test {name description args} { set code [catch {uplevel 1 $setup} setupMsg] if {$code == 1} { set errorInfo(setup) $::errorInfo - set errorCode(setup) $::errorCode + set errorCodeRes(setup) $::errorCode } set setupFailure [expr {$code != 0}] @@ -2003,7 +2013,7 @@ proc tcltest::test {name description args} { lassign $testResult actualAnswer returnCode if {$returnCode == 1} { set errorInfo(body) $::errorInfo - set errorCode(body) $::errorCode + set errorCodeRes(body) $::errorCode } } @@ -2012,6 +2022,11 @@ proc tcltest::test {name description args} { if {!$setupFailure && ($returnCode ni $returnCodes)} { set codeFailure 1 } + set errorCodeFailure 0 + if {!$setupFailure && !$codeFailure && $returnCode == 1 && \ + ![string match $errorCode $errorCodeRes(body)]} { + set errorCodeFailure 1 + } # If expected output/error strings exist, we have to compare # them. If the comparison fails, then so did the test. @@ -2055,7 +2070,7 @@ proc tcltest::test {name description args} { set code [catch {uplevel 1 $cleanup} cleanupMsg] if {$code == 1} { set errorInfo(cleanup) $::errorInfo - set errorCode(cleanup) $::errorCode + set errorCodeRes(cleanup) $::errorCode } set cleanupFailure [expr {$code != 0}] @@ -2106,7 +2121,7 @@ proc tcltest::test {name description args} { variable numTests if {!($setupFailure || $cleanupFailure || $coreFailure || $outputFailure || $errorFailure || $codeFailure - || $scriptFailure)} { + || $errorCodeFailure || $scriptFailure)} { if {$testLevel == 1} { incr numTests(Passed) if {[IsVerbose pass]} { @@ -2159,7 +2174,7 @@ proc tcltest::test {name description args} { failed:\n$setupMsg" if {[info exists errorInfo(setup)]} { puts [outputChannel] "---- errorInfo(setup): $errorInfo(setup)" - puts [outputChannel] "---- errorCode(setup): $errorCode(setup)" + puts [outputChannel] "---- errorCode(setup): $errorCodeRes(setup)" } } if {$scriptFailure} { @@ -2171,6 +2186,10 @@ proc tcltest::test {name description args} { ($match matching):\n$result" } } + if {$errorCodeFailure} { + puts [outputChannel] "---- Error code was: '$errorCodeRes(body)'" + puts [outputChannel] "---- Error code should have been: '$errorCode'" + } if {$codeFailure} { switch -- $returnCode { 0 { set msg "Test completed normally" } @@ -2186,7 +2205,7 @@ proc tcltest::test {name description args} { if {[IsVerbose error]} { if {[info exists errorInfo(body)] && (1 ni $returnCodes)} { puts [outputChannel] "---- errorInfo: $errorInfo(body)" - puts [outputChannel] "---- errorCode: $errorCode(body)" + puts [outputChannel] "---- errorCode: $errorCodeRes(body)" } } } @@ -2212,7 +2231,7 @@ proc tcltest::test {name description args} { puts [outputChannel] "---- Test cleanup failed:\n$cleanupMsg" if {[info exists errorInfo(cleanup)]} { puts [outputChannel] "---- errorInfo(cleanup): $errorInfo(cleanup)" - puts [outputChannel] "---- errorCode(cleanup): $errorCode(cleanup)" + puts [outputChannel] "---- errorCode(cleanup): $errorCodeRes(cleanup)" } } if {$coreFailure} { @@ -2722,7 +2741,7 @@ proc tcltest::GetMatchingDirectories {rootdir} { # shell being tested # # Results: -# None. +# Whether there were any failures. # # Side effects: # None. @@ -2868,7 +2887,7 @@ proc tcltest::runAllTests { {shell ""} } { puts [outputChannel] "" puts [outputChannel] [string repeat ~ 44] } - return + return [info exists testFileFailures] } ##################################################################### diff --git a/tests/tcltest.test b/tests/tcltest.test index 0bcf342..ca720ee 100644 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -908,7 +908,7 @@ removeFile load.tcl # [interpreter] test tcltest-13.1 {interpreter} { - -constraints notValgrind + -constraints notValgrind -setup { #to do: Why is $::tcltest::tcltest being saved and restored here? set old $::tcltest::tcltest @@ -926,7 +926,7 @@ test tcltest-13.1 {interpreter} { # constraint, which involves a call to [exec] that might fail after # "fork" and before "exec", in which case the forked process will not # have a chance to clean itself up before exiting, which causes - # valgrind to issue numerous "still reachable" reports. + # valgrind to issue numerous "still reachable" reports. set ::tcltest::tcltest $old } } @@ -1207,7 +1207,7 @@ test tcltest-21.2 {force a test command failure} { } {1} } -returnCodes 1 - -result {bad option "1": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup} + -result {bad option "1": must be -body, -cleanup, -constraints, -errorCode, -errorOutput, -match, -output, -result, -returnCodes, or -setup} } test tcltest-21.3 {test command with setup} { @@ -1300,7 +1300,7 @@ test tcltest-21.7 {test command - bad flag} { } } -returnCodes 1 - -result {bad option "-foobar": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup} + -result {bad option "-foobar": must be -body, -cleanup, -constraints, -errorCode, -errorOutput, -match, -output, -result, -returnCodes, or -setup} } # alternate test command format (these are the same as 21.1-21.6, with the @@ -1320,7 +1320,7 @@ test tcltest-21.8 {force a test command failure} \ } \ -returnCodes 1 \ -cleanup {set ::tcltest::currentFailure $fail} \ - -result {bad option "1": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup} + -result {bad option "1": must be -body, -cleanup, -constraints, -errorCode, -errorOutput, -match, -output, -result, -returnCodes, or -setup} test tcltest-21.9 {test command with setup} \ -setup {set foo 1} \ diff --git a/unix/Makefile.in b/unix/Makefile.in index a2621a3..66114ba 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -851,8 +851,8 @@ install-libraries: libraries done; @echo "Installing package msgcat 1.6.1 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.6.1.tm; - @echo "Installing package tcltest 2.4.1 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.4.1.tm; + @echo "Installing package tcltest 2.5.0 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.5.0.tm; @echo "Installing package platform 1.0.14 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.14.tm; diff --git a/win/Makefile.in b/win/Makefile.in index 8ce57f2..9d955cd 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -660,8 +660,8 @@ install-libraries: libraries install-tzdata install-msgs done; @echo "Installing package msgcat 1.6.1 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.6.1.tm; - @echo "Installing package tcltest 2.4.1 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.4.1.tm; + @echo "Installing package tcltest 2.5.0 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.5.0.tm; @echo "Installing package platform 1.0.14 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; -- cgit v0.12 From 22a5d73ebf204659f328464091641c1b71c865c1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 29 Oct 2018 19:54:58 +0000 Subject: squelch some warnings on higher Visual Studio versions: we are not going to bother on this any more. --- win/tclWinPort.h | 2 ++ 1 file changed, 2 insertions(+) diff --git a/win/tclWinPort.h b/win/tclWinPort.h index 0f7d1fa..c30d1bd 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -382,6 +382,8 @@ typedef DWORD_PTR * PDWORD_PTR; #if defined(_MSC_VER) && (_MSC_VER >= 1400) # pragma warning(disable:4244) # pragma warning(disable:4267) +# pragma warning(disable:4311) +# pragma warning(disable:4312) # pragma warning(disable:4996) #endif -- cgit v0.12 From 74707353e824dd0dced5d646f6603f80e9647ae5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 30 Oct 2018 20:39:24 +0000 Subject: Add support for TIP #494 to registry and dde. Only effective when compiled against Tcl 9.0 headers. This way we can keep the source-code for those extensions 100% equal in all branches. Work-around for gcc warning in tclWinFile.c. Discovered by Travis CI. --- win/tclWinDde.c | 26 ++++++++++++++++++++++---- win/tclWinFile.c | 9 +++++++++ win/tclWinReg.c | 23 +++++++++++++++++++++-- 3 files changed, 52 insertions(+), 6 deletions(-) diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 38f1d88..27ddfc8 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -117,6 +117,24 @@ static int DdeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static unsigned char * +getByteArrayFromObj( + Tcl_Obj *objPtr, + size_t *lengthPtr +) { + int length; + + unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length); +#if TCL_MAJOR_VERSION > 8 + if (sizeof(TCL_HASH_TYPE) > sizeof(int)) { + /* 64-bit and TIP #494 situation: */ + *lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1; + } else +#endif + /* 32-bit or without TIP #494 */ + *lengthPtr = (size_t) (unsigned) length; + return result; +} DLLEXPORT int Dde_Init(Tcl_Interp *interp); DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp); @@ -1279,7 +1297,7 @@ DdeObjCmd( }; int index, i, argIndex; - int length; + size_t length; int flags = 0, result = TCL_OK, firstArg = 0; HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn; @@ -1489,14 +1507,14 @@ DdeObjCmd( break; case DDE_EXECUTE: { - int dataLength; + size_t dataLength; const void *dataString; Tcl_DString dsBuf; Tcl_DStringInit(&dsBuf); if (flags & DDE_FLAG_BINARY) { dataString = - Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength); + getByteArrayFromObj(objv[firstArg + 2], &dataLength); } else { const char *src; @@ -1633,7 +1651,7 @@ DdeObjCmd( Tcl_DStringInit(&dsBuf); if (flags & DDE_FLAG_BINARY) { dataString = (BYTE *) - Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length); + getByteArrayFromObj(objv[firstArg + 3], &length); } else { const char *data = Tcl_GetString(objv[firstArg + 3]); diff --git a/win/tclWinFile.c b/win/tclWinFile.c index cbd8814..8ee4bce 100755 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -569,6 +569,11 @@ TclWinSymLinkDelete( *-------------------------------------------------------------------- */ +#if defined (__clang__) || ((__GNUC__) && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5)))) +#pragma GCC diagnostic push +#pragma GCC diagnostic ignored "-Warray-bounds" +#endif + static Tcl_Obj * WinReadLinkDirectory( const TCHAR *linkDirPath) @@ -684,6 +689,10 @@ WinReadLinkDirectory( Tcl_SetErrno(EINVAL); return NULL; } + +#if defined (__clang__) || ((__GNUC__) && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5)))) +#pragma GCC diagnostic pop +#endif /* *-------------------------------------------------------------------- diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 0d2cd94..f93a553 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -124,6 +124,25 @@ static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, Tcl_Obj *typeObj, REGSAM mode); +static unsigned char * +getByteArrayFromObj( + Tcl_Obj *objPtr, + size_t *lengthPtr +) { + int length; + + unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length); +#if TCL_MAJOR_VERSION > 8 + if (sizeof(TCL_HASH_TYPE) > sizeof(int)) { + /* 64-bit and TIP #494 situation: */ + *lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1; + } else +#endif + /* 32-bit or without TIP #494 */ + *lengthPtr = (size_t) (unsigned) length; + return result; +} + DLLEXPORT int Registry_Init(Tcl_Interp *interp); DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags); @@ -1324,13 +1343,13 @@ SetValue( Tcl_DStringFree(&buf); } else { BYTE *data; - int bytelength; + size_t bytelength; /* * Store binary data in the registry. */ - data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &bytelength); + data = (BYTE *) getByteArrayFromObj(dataObj, &bytelength); result = RegSetValueEx(key, (TCHAR *) valueName, 0, (DWORD) type, data, (DWORD) bytelength); } -- cgit v0.12 From 434a115a3c3cbd45b3e01a1af2ad1e960077a056 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 30 Oct 2018 20:40:03 +0000 Subject: Add support for DragonFly --- unix/configure | 4 ++-- unix/tcl.m4 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/unix/configure b/unix/configure index 61d922a..1e15a25 100755 --- a/unix/configure +++ b/unix/configure @@ -7646,7 +7646,7 @@ fi fi ;; - FreeBSD-*) + DragonFly-*|FreeBSD-*) # This configuration from FreeBSD Ports. SHLIB_CFLAGS="-fPIC" SHLIB_LD="${CC} -shared" @@ -8854,7 +8854,7 @@ fi BSD/OS*) ;; CYGWIN_*|MINGW32_*) ;; IRIX*) ;; - NetBSD-*|FreeBSD-*|OpenBSD-*) ;; + NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;; Darwin-*) ;; SCO_SV-3.2*) ;; *) SHLIB_CFLAGS="-fPIC" ;; diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 99e0cbd..38f1377 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -1563,7 +1563,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ LDFLAGS="$LDFLAGS -pthread" ]) ;; - FreeBSD-*) + DragonFly-*|FreeBSD-*) # This configuration from FreeBSD Ports. SHLIB_CFLAGS="-fPIC" SHLIB_LD="${CC} -shared" @@ -2059,7 +2059,7 @@ dnl # preprocessing tests use only CPPFLAGS. BSD/OS*) ;; CYGWIN_*|MINGW32_*) ;; IRIX*) ;; - NetBSD-*|FreeBSD-*|OpenBSD-*) ;; + NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;; Darwin-*) ;; SCO_SV-3.2*) ;; *) SHLIB_CFLAGS="-fPIC" ;; -- cgit v0.12 From a0c7ff582a10cc77bd4f95cf577516beeb416ce5 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 1 Nov 2018 14:46:07 +0000 Subject: Eliminate fallback attempts when broken strtod() routines are detected. This has long been creating more problems than it solves. --- compat/fixstrtod.c | 36 ------ compat/stdlib.h | 1 - compat/strtod.c | 252 -------------------------------------- unix/Makefile.in | 6 - unix/configure | 352 ----------------------------------------------------- unix/configure.in | 20 --- unix/tcl.m4 | 53 -------- 7 files changed, 720 deletions(-) delete mode 100644 compat/fixstrtod.c delete mode 100644 compat/strtod.c diff --git a/compat/fixstrtod.c b/compat/fixstrtod.c deleted file mode 100644 index 63fb8ef..0000000 --- a/compat/fixstrtod.c +++ /dev/null @@ -1,36 +0,0 @@ -/* - * fixstrtod.c -- - * - * Source code for the "fixstrtod" procedure. This procedure is - * used in place of strtod under Solaris 2.4, in order to fix - * a bug where the "end" pointer gets set incorrectly. - * - * Copyright (c) 1995 Sun Microsystems, Inc. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - -#include - -#undef strtod - -/* - * Declare strtod explicitly rather than including stdlib.h, since in - * somes systems (e.g. SunOS 4.1.4) stdlib.h doesn't declare strtod. - */ - -extern double strtod(char *, char **); - -double -fixstrtod( - char *string, - char **endPtr) -{ - double d; - d = strtod(string, endPtr); - if ((endPtr != NULL) && (*endPtr != string) && ((*endPtr)[-1] == 0)) { - *endPtr -= 1; - } - return d; -} diff --git a/compat/stdlib.h b/compat/stdlib.h index 0ad4c1d..6900be3 100644 --- a/compat/stdlib.h +++ b/compat/stdlib.h @@ -29,7 +29,6 @@ extern char * malloc(unsigned int numBytes); extern void qsort(void *base, int n, int size, int (*compar)( const void *element1, const void *element2)); extern char * realloc(char *ptr, unsigned int numBytes); -extern double strtod(const char *string, char **endPtr); extern long strtol(const char *string, char **endPtr, int base); extern unsigned long strtoul(const char *string, char **endPtr, int base); diff --git a/compat/strtod.c b/compat/strtod.c deleted file mode 100644 index 9643c09..0000000 --- a/compat/strtod.c +++ /dev/null @@ -1,252 +0,0 @@ -/* - * strtod.c -- - * - * Source code for the "strtod" library procedure. - * - * Copyright (c) 1988-1993 The Regents of the University of California. - * Copyright (c) 1994 Sun Microsystems, Inc. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - -#include "tclInt.h" - -#ifndef TRUE -#define TRUE 1 -#define FALSE 0 -#endif -#ifndef NULL -#define NULL 0 -#endif - -static const int maxExponent = 511; /* Largest possible base 10 exponent. Any - * exponent larger than this will already - * produce underflow or overflow, so there's - * no need to worry about additional digits. - */ -static const double powersOf10[] = { /* Table giving binary powers of 10. Entry */ - 10., /* is 10^2^i. Used to convert decimal */ - 100., /* exponents into floating-point numbers. */ - 1.0e4, - 1.0e8, - 1.0e16, - 1.0e32, - 1.0e64, - 1.0e128, - 1.0e256 -}; - -/* - *---------------------------------------------------------------------- - * - * strtod -- - * - * This procedure converts a floating-point number from an ASCII - * decimal representation to internal double-precision format. - * - * Results: - * The return value is the double-precision floating-point - * representation of the characters in string. If endPtr isn't - * NULL, then *endPtr is filled in with the address of the - * next character after the last one that was part of the - * floating-point number. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -double -strtod( - const char *string, /* A decimal ASCII floating-point number, - * optionally preceded by white space. Must - * have form "-I.FE-X", where I is the integer - * part of the mantissa, F is the fractional - * part of the mantissa, and X is the - * exponent. Either of the signs may be "+", - * "-", or omitted. Either I or F may be - * omitted, or both. The decimal point isn't - * necessary unless F is present. The "E" may - * actually be an "e". E and X may both be - * omitted (but not just one). */ - char **endPtr) /* If non-NULL, store terminating character's - * address here. */ -{ - int sign, expSign = FALSE; - double fraction, dblExp; - const double *d; - register const char *p; - register int c; - int exp = 0; /* Exponent read from "EX" field. */ - int fracExp = 0; /* Exponent that derives from the fractional - * part. Under normal circumstatnces, it is - * the negative of the number of digits in F. - * However, if I is very long, the last digits - * of I get dropped (otherwise a long I with a - * large negative exponent could cause an - * unnecessary overflow on I alone). In this - * case, fracExp is incremented one for each - * dropped digit. */ - int mantSize; /* Number of digits in mantissa. */ - int decPt; /* Number of mantissa digits BEFORE decimal - * point. */ - const char *pExp; /* Temporarily holds location of exponent in - * string. */ - - /* - * Strip off leading blanks and check for a sign. - */ - - p = string; - while (isspace(UCHAR(*p))) { - p += 1; - } - if (*p == '-') { - sign = TRUE; - p += 1; - } else { - if (*p == '+') { - p += 1; - } - sign = FALSE; - } - - /* - * Count the number of digits in the mantissa (including the decimal - * point), and also locate the decimal point. - */ - - decPt = -1; - for (mantSize = 0; ; mantSize += 1) - { - c = *p; - if (!isdigit(c)) { - if ((c != '.') || (decPt >= 0)) { - break; - } - decPt = mantSize; - } - p += 1; - } - - /* - * Now suck up the digits in the mantissa. Use two integers to collect 9 - * digits each (this is faster than using floating-point). If the mantissa - * has more than 18 digits, ignore the extras, since they can't affect the - * value anyway. - */ - - pExp = p; - p -= mantSize; - if (decPt < 0) { - decPt = mantSize; - } else { - mantSize -= 1; /* One of the digits was the point. */ - } - if (mantSize > 18) { - fracExp = decPt - 18; - mantSize = 18; - } else { - fracExp = decPt - mantSize; - } - if (mantSize == 0) { - fraction = 0.0; - p = string; - goto done; - } else { - int frac1, frac2; - - frac1 = 0; - for ( ; mantSize > 9; mantSize -= 1) { - c = *p; - p += 1; - if (c == '.') { - c = *p; - p += 1; - } - frac1 = 10*frac1 + (c - '0'); - } - frac2 = 0; - for (; mantSize > 0; mantSize -= 1) { - c = *p; - p += 1; - if (c == '.') { - c = *p; - p += 1; - } - frac2 = 10*frac2 + (c - '0'); - } - fraction = (1.0e9 * frac1) + frac2; - } - - /* - * Skim off the exponent. - */ - - p = pExp; - if ((*p == 'E') || (*p == 'e')) { - p += 1; - if (*p == '-') { - expSign = TRUE; - p += 1; - } else { - if (*p == '+') { - p += 1; - } - expSign = FALSE; - } - if (!isdigit(UCHAR(*p))) { - p = pExp; - goto done; - } - while (isdigit(UCHAR(*p))) { - exp = exp * 10 + (*p - '0'); - p += 1; - } - } - if (expSign) { - exp = fracExp - exp; - } else { - exp = fracExp + exp; - } - - /* - * Generate a floating-point number that represents the exponent. Do this - * by processing the exponent one bit at a time to combine many powers of - * 2 of 10. Then combine the exponent with the fraction. - */ - - if (exp < 0) { - expSign = TRUE; - exp = -exp; - } else { - expSign = FALSE; - } - if (exp > maxExponent) { - exp = maxExponent; - errno = ERANGE; - } - dblExp = 1.0; - for (d = powersOf10; exp != 0; exp >>= 1, ++d) { - if (exp & 01) { - dblExp *= *d; - } - } - if (expSign) { - fraction /= dblExp; - } else { - fraction *= dblExp; - } - - done: - if (endPtr != NULL) { - *endPtr = (char *) p; - } - - if (sign) { - return -fraction; - } - return fraction; -} diff --git a/unix/Makefile.in b/unix/Makefile.in index 66114ba..aaff7ae 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -1632,9 +1632,6 @@ tclXtTest.o: $(UNIX_DIR)/tclXtTest.c # relocatable. #-------------------------------------------------------------------------- -fixstrtod.o: $(COMPAT_DIR)/fixstrtod.c - $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/fixstrtod.c - opendir.o: $(COMPAT_DIR)/opendir.c $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/opendir.c @@ -1650,9 +1647,6 @@ strncasecmp.o: $(COMPAT_DIR)/strncasecmp.c strstr.o: $(COMPAT_DIR)/strstr.c $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strstr.c -strtod.o: $(COMPAT_DIR)/strtod.c - $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtod.c - strtol.o: $(COMPAT_DIR)/strtol.c $(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtol.c diff --git a/unix/configure b/unix/configure index f254ca4..c8453a8 100755 --- a/unix/configure +++ b/unix/configure @@ -14983,358 +14983,6 @@ esac #-------------------------------------------------------------------- -# Check for the strtod function. This is tricky because in some -# versions of Linux strtod mis-parses strings starting with "+". -#-------------------------------------------------------------------- - - - echo "$as_me:$LINENO: checking for strtod" >&5 -echo $ECHO_N "checking for strtod... $ECHO_C" >&6 -if test "${ac_cv_func_strtod+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -/* Define strtod to an innocuous variant, in case declares strtod. - For example, HP-UX 11i declares gettimeofday. */ -#define strtod innocuous_strtod - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char strtod (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef strtod - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char strtod (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_strtod) || defined (__stub___strtod) -choke me -#else -char (*f) () = strtod; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != strtod; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>conftest.er1 - ac_status=$? - grep -v '^ *+' conftest.er1 >conftest.err - rm -f conftest.er1 - cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" - || test ! -s conftest.err' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; } && - { ac_try='test -s conftest$ac_exeext' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; }; then - ac_cv_func_strtod=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_strtod=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_strtod" >&5 -echo "${ECHO_T}$ac_cv_func_strtod" >&6 -if test $ac_cv_func_strtod = yes; then - tcl_ok=1 -else - tcl_ok=0 -fi - - if test "$tcl_ok" = 1; then - echo "$as_me:$LINENO: checking proper strtod implementation" >&5 -echo $ECHO_N "checking proper strtod implementation... $ECHO_C" >&6 -if test "${tcl_cv_strtod_unbroken+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - if test "$cross_compiling" = yes; then - tcl_cv_strtod_unbroken=unknown -else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -int main() { - extern double strtod(); - char *term, *string = " +69"; - exit(strtod(string,&term) != 69 || term != string+4); -} -_ACEOF -rm -f conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { ac_try='./conftest$ac_exeext' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; }; then - tcl_cv_strtod_unbroken=ok -else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -( exit $ac_status ) -tcl_cv_strtod_unbroken=broken -fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext -fi -fi -echo "$as_me:$LINENO: result: $tcl_cv_strtod_unbroken" >&5 -echo "${ECHO_T}$tcl_cv_strtod_unbroken" >&6 - if test "$tcl_cv_strtod_unbroken" = "ok"; then - tcl_ok=1 - else - tcl_ok=0 - fi - fi - if test "$tcl_ok" = 0; then - case $LIBOBJS in - "strtod.$ac_objext" | \ - *" strtod.$ac_objext" | \ - "strtod.$ac_objext "* | \ - *" strtod.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS strtod.$ac_objext" ;; -esac - - USE_COMPAT=1 - fi - - -#-------------------------------------------------------------------- -# Under Solaris 2.4, strtod returns the wrong value for the -# terminating character under some conditions. Check for this -# and if the problem exists use a substitute procedure -# "fixstrtod" that corrects the error. -#-------------------------------------------------------------------- - - - echo "$as_me:$LINENO: checking for strtod" >&5 -echo $ECHO_N "checking for strtod... $ECHO_C" >&6 -if test "${ac_cv_func_strtod+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -/* Define strtod to an innocuous variant, in case declares strtod. - For example, HP-UX 11i declares gettimeofday. */ -#define strtod innocuous_strtod - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char strtod (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef strtod - -/* Override any gcc2 internal prototype to avoid an error. */ -#ifdef __cplusplus -extern "C" -{ -#endif -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char strtod (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_strtod) || defined (__stub___strtod) -choke me -#else -char (*f) () = strtod; -#endif -#ifdef __cplusplus -} -#endif - -int -main () -{ -return f != strtod; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>conftest.er1 - ac_status=$? - grep -v '^ *+' conftest.er1 >conftest.err - rm -f conftest.er1 - cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" - || test ! -s conftest.err' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; } && - { ac_try='test -s conftest$ac_exeext' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; }; then - ac_cv_func_strtod=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_func_strtod=no -fi -rm -f conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -echo "$as_me:$LINENO: result: $ac_cv_func_strtod" >&5 -echo "${ECHO_T}$ac_cv_func_strtod" >&6 -if test $ac_cv_func_strtod = yes; then - tcl_strtod=1 -else - tcl_strtod=0 -fi - - if test "$tcl_strtod" = 1; then - echo "$as_me:$LINENO: checking for Solaris2.4/Tru64 strtod bugs" >&5 -echo $ECHO_N "checking for Solaris2.4/Tru64 strtod bugs... $ECHO_C" >&6 -if test "${tcl_cv_strtod_buggy+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - - if test "$cross_compiling" = yes; then - tcl_cv_strtod_buggy=buggy -else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - - extern double strtod(); - int main() { - char *infString="Inf", *nanString="NaN", *spaceString=" "; - char *term; - double value; - value = strtod(infString, &term); - if ((term != infString) && (term[-1] == 0)) { - exit(1); - } - value = strtod(nanString, &term); - if ((term != nanString) && (term[-1] == 0)) { - exit(1); - } - value = strtod(spaceString, &term); - if (term == (spaceString+1)) { - exit(1); - } - exit(0); - } -_ACEOF -rm -f conftest$ac_exeext -if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 - (eval $ac_link) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { ac_try='./conftest$ac_exeext' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; }; then - tcl_cv_strtod_buggy=ok -else - echo "$as_me: program exited with status $ac_status" >&5 -echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -( exit $ac_status ) -tcl_cv_strtod_buggy=buggy -fi -rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext -fi -fi -echo "$as_me:$LINENO: result: $tcl_cv_strtod_buggy" >&5 -echo "${ECHO_T}$tcl_cv_strtod_buggy" >&6 - if test "$tcl_cv_strtod_buggy" = buggy; then - case $LIBOBJS in - "fixstrtod.$ac_objext" | \ - *" fixstrtod.$ac_objext" | \ - "fixstrtod.$ac_objext "* | \ - *" fixstrtod.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS fixstrtod.$ac_objext" ;; -esac - - USE_COMPAT=1 - -cat >>confdefs.h <<\_ACEOF -#define strtod fixstrtod -_ACEOF - - fi - fi - - -#-------------------------------------------------------------------- # Check for various typedefs and provide substitutes if # they don't exist. #-------------------------------------------------------------------- diff --git a/unix/configure.in b/unix/configure.in index bfa2ef7..5ecd886 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -359,26 +359,6 @@ SC_TCL_CHECK_BROKEN_FUNC(strtoul, [ ]) #-------------------------------------------------------------------- -# Check for the strtod function. This is tricky because in some -# versions of Linux strtod mis-parses strings starting with "+". -#-------------------------------------------------------------------- - -SC_TCL_CHECK_BROKEN_FUNC(strtod, [ - extern double strtod(); - char *term, *string = " +69"; - exit(strtod(string,&term) != 69 || term != string+4); -]) - -#-------------------------------------------------------------------- -# Under Solaris 2.4, strtod returns the wrong value for the -# terminating character under some conditions. Check for this -# and if the problem exists use a substitute procedure -# "fixstrtod" that corrects the error. -#-------------------------------------------------------------------- - -SC_BUGGY_STRTOD - -#-------------------------------------------------------------------- # Check for various typedefs and provide substitutes if # they don't exist. #-------------------------------------------------------------------- diff --git a/unix/tcl.m4 b/unix/tcl.m4 index ed11f9b..1953798 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -2398,59 +2398,6 @@ AC_DEFUN([SC_TIME_HANDLER], [ ]) #-------------------------------------------------------------------- -# SC_BUGGY_STRTOD -# -# Under Solaris 2.4, strtod returns the wrong value for the -# terminating character under some conditions. Check for this -# and if the problem exists use a substitute procedure -# "fixstrtod" (provided by Tcl) that corrects the error. -# Also, on Compaq's Tru64 Unix 5.0, -# strtod(" ") returns 0.0 instead of a failure to convert. -# -# Arguments: -# none -# -# Results: -# -# Might defines some of the following vars: -# strtod (=fixstrtod) -# -#-------------------------------------------------------------------- - -AC_DEFUN([SC_BUGGY_STRTOD], [ - AC_CHECK_FUNC(strtod, tcl_strtod=1, tcl_strtod=0) - if test "$tcl_strtod" = 1; then - AC_CACHE_CHECK([for Solaris2.4/Tru64 strtod bugs], tcl_cv_strtod_buggy,[ - AC_TRY_RUN([ - extern double strtod(); - int main() { - char *infString="Inf", *nanString="NaN", *spaceString=" "; - char *term; - double value; - value = strtod(infString, &term); - if ((term != infString) && (term[-1] == 0)) { - exit(1); - } - value = strtod(nanString, &term); - if ((term != nanString) && (term[-1] == 0)) { - exit(1); - } - value = strtod(spaceString, &term); - if (term == (spaceString+1)) { - exit(1); - } - exit(0); - }], tcl_cv_strtod_buggy=ok, tcl_cv_strtod_buggy=buggy, - tcl_cv_strtod_buggy=buggy)]) - if test "$tcl_cv_strtod_buggy" = buggy; then - AC_LIBOBJ([fixstrtod]) - USE_COMPAT=1 - AC_DEFINE(strtod, fixstrtod, [Do we want to use the strtod() in compat?]) - fi - fi -]) - -#-------------------------------------------------------------------- # SC_TCL_LINK_LIBS # # Search for the libraries needed to link the Tcl shell. -- cgit v0.12