From d32d625787febc9c08fa7e1118df87ebfd4a9315 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 20 Oct 2018 11:57:59 +0000 Subject: Travis CI build --- .travis.yml | 63 ++++++++++++++++++++++ README.md | 172 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 235 insertions(+) create mode 100644 .travis.yml create mode 100644 README.md diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..3abeb6b --- /dev/null +++ b/.travis.yml @@ -0,0 +1,63 @@ +dist: trusty +language: c +matrix: + include: + - os: linux + env: + - MATRIX_EVAL="BUILD_DIR=unix" + - os: linux + addons: + apt: + sources: + - ubuntu-toolchain-r-test + packages: + - g++-4.9 + env: + - MATRIX_EVAL="CC=gcc-4.9 && BUILD_DIR=unix" + - os: linux + addons: + apt: + sources: + - ubuntu-toolchain-r-test + packages: + - g++-5 + env: + - MATRIX_EVAL="CC=gcc-5 && BUILD_DIR=unix" + - os: linux + addons: + apt: + sources: + - ubuntu-toolchain-r-test + packages: + - g++-6 + env: + - MATRIX_EVAL="CC=gcc-6 && BUILD_DIR=unix" + - os: linux + addons: + apt: + sources: + - ubuntu-toolchain-r-test + packages: + - g++-7 + env: + - MATRIX_EVAL="CC=gcc-7 && BUILD_DIR=unix" + - os: osx + osx_image: xcode8 + env: + - MATRIX_EVAL="BUILD_DIR=unix" + - os: osx + osx_image: xcode8 + env: + - MATRIX_EVAL="BUILD_DIR=macosx" + - os: windows + env: + - MATRIX_EVAL="BUILD_DIR=win" + +before_install: + - eval "${MATRIX_EVAL}" + - cd ${BUILD_DIR} +install: + - ./configure +script: + - make + - make test diff --git a/README.md b/README.md new file mode 100644 index 0000000..db67791 --- /dev/null +++ b/README.md @@ -0,0 +1,172 @@ +README: Tcl +============ +This is the **Tcl 8.5.19** source distribution. + +You can get any source release of Tcl from [our distribution +site](https://sourceforge.net/projects/tcl/files/Tcl/). + +[![Build Status](https://travis-ci.org/tcltk/tcl.svg?branch=core-8-5-branch)](https://travis-ci.org/tcltk/tcl) + +Contents +-------- + 1. [Introduction](#intro) + 2. [Documentation](#doc) + 3. [Compiling and installing Tcl](#build) + 4. [Development tools](#devtools) + 5. [Tcl newsgroup](#complangtcl) + 6. [The Tcler's Wiki](#wiki) + 7. [Mailing lists](#email) + 8. [Support and Training](#support) + 9. [Tracking Development](#watch) + 10. [Thank You](#thanks) + +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 [core.tcl-lang.org](https://core.tcl-lang.org/). +Tcl/Tk release and mailing list services are [hosted by +SourceForge](https://sourceforge.net/projects/tcl/) +with the Tcl Developer Xchange hosted at +[www.tcl-lang.org](https://www.tcl-lang.org). + +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 +[here](https://www.tcl.tk/software/tcltk/8.5.html). +Detailed release notes can be found at the +[file distributions page](https://sourceforge.net/projects/tcl/files/Tcl/) +by clicking on the relevant version. + +Information about Tcl itself can be found at the [Developer +Xchange](https://www.tcl-lang.org/about/). +There have been many Tcl books on the market. Many are mentioned in +[the Wiki](https://wiki.tcl-lang.org/_/ref?N=25206). + +The complete set of reference manual entries for Tcl 8.5 is [online, +here](https://www.tcl-lang.org/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 + + groff -man -Tpdf Tcl.n >output.pdf + +to print Tcl.n to PDF. 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 +[online](https://www.tcl-lang.org/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 +--------------- + +There is a [wiki-based open community site](https://wiki.tcl-lang.org/) +covering all aspects of 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 [here](https://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 issue tracker](https://core.tcl-lang.org/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` +or ask a question on [Stack +Overflow](https://stackoverflow.com/questions/tagged/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 wiki for [links to other +organizations](https://wiki.tcl-lang.org/training) that offer Tcl/Tk training. + +9. Tracking Development +----------------------- + +Tcl is developed in public. You can keep an eye on how Tcl is changing at +[core.tcl-lang.org](https://core.tcl-lang.org/). + +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. -- cgit v0.12 From ea29292705d5531747a472e71d3c59e9e9518f03 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 20 Oct 2018 12:01:49 +0000 Subject: formatting fix --- README.md | 54 +++++++++++++++--------------------------------------- 1 file changed, 15 insertions(+), 39 deletions(-) diff --git a/README.md b/README.md index db67791..d5fe033 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,5 @@ -README: Tcl -============ +# README: Tcl + This is the **Tcl 8.5.19** source distribution. You can get any source release of Tcl from [our distribution @@ -7,8 +7,7 @@ site](https://sourceforge.net/projects/tcl/files/Tcl/). [![Build Status](https://travis-ci.org/tcltk/tcl.svg?branch=core-8-5-branch)](https://travis-ci.org/tcltk/tcl) -Contents --------- +## Contents 1. [Introduction](#intro) 2. [Documentation](#doc) 3. [Compiling and installing Tcl](#build) @@ -20,8 +19,7 @@ Contents 9. [Tracking Development](#watch) 10. [Thank You](#thanks) -1. Introduction ---------------- +## 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 @@ -42,9 +40,7 @@ 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 ----------------- - +## 2. Documentation Extensive documentation is available at our website. The home page for this release, including new features, is [here](https://www.tcl.tk/software/tcltk/8.5.html). @@ -60,9 +56,7 @@ There have been many Tcl books on the market. Many are mentioned in The complete set of reference manual entries for Tcl 8.5 is [online, here](https://www.tcl-lang.org/man/tcl8.5/). -2a. Unix Documentation ----------------------- - +### 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 @@ -80,26 +74,20 @@ normal "man" mechanisms, such as man Tcl -2b. Windows Documentation -------------------------- - +### 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 -------------------------------- - +## 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 [online](https://www.tcl-lang.org/doc/howto/compile.html). -4. Development tools ---------------------------- - +## 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, @@ -108,17 +96,13 @@ more. More information can be found at http://www.ActiveState.com/Tcl -5. Tcl newsgroup ----------------- - +## 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 ---------------- - +## 6. Tcl'ers Wiki There is a [wiki-based open community site](https://wiki.tcl-lang.org/) covering all aspects of Tcl/Tk. @@ -128,17 +112,13 @@ 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 ----------------- - +## 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 [here](https://sourceforge.net/projects/tcl/) and go to the Mailing Lists page. -8. Support and Training ------------------------- - +## 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 issue tracker](https://core.tcl-lang.org/tcl/reportlist). @@ -158,15 +138,11 @@ newsgroup and will attempt to answer esoteric questions for which no one else is likely to know the answer. In addition, see the wiki for [links to other organizations](https://wiki.tcl-lang.org/training) that offer Tcl/Tk training. -9. Tracking Development ------------------------ - +## 9. Tracking Development Tcl is developed in public. You can keep an eye on how Tcl is changing at [core.tcl-lang.org](https://core.tcl-lang.org/). -10. Thank You -------------- - +## 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. -- cgit v0.12 From e5cf3448bd80bc3f8d4b0441e759c17885c508fa Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 20 Oct 2018 12:54:28 +0000 Subject: formatting tweak --- README.md | 46 +++++++++++++++++++++++----------------------- 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/README.md b/README.md index d5fe033..cbc49f0 100644 --- a/README.md +++ b/README.md @@ -8,18 +8,18 @@ site](https://sourceforge.net/projects/tcl/files/Tcl/). [![Build Status](https://travis-ci.org/tcltk/tcl.svg?branch=core-8-5-branch)](https://travis-ci.org/tcltk/tcl) ## Contents - 1. [Introduction](#intro) - 2. [Documentation](#doc) - 3. [Compiling and installing Tcl](#build) - 4. [Development tools](#devtools) - 5. [Tcl newsgroup](#complangtcl) - 6. [The Tcler's Wiki](#wiki) - 7. [Mailing lists](#email) - 8. [Support and Training](#support) - 9. [Tracking Development](#watch) - 10. [Thank You](#thanks) - -## 1. Introduction + 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 @@ -40,7 +40,7 @@ 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 +## 2. Documentation Extensive documentation is available at our website. The home page for this release, including new features, is [here](https://www.tcl.tk/software/tcltk/8.5.html). @@ -56,7 +56,7 @@ There have been many Tcl books on the market. Many are mentioned in The complete set of reference manual entries for Tcl 8.5 is [online, here](https://www.tcl-lang.org/man/tcl8.5/). -### 2a. Unix Documentation +### 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 @@ -74,20 +74,20 @@ normal "man" mechanisms, such as man Tcl -### 2b. Windows Documentation +### 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 +## 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 [online](https://www.tcl-lang.org/doc/howto/compile.html). -## 4. Development tools +## 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, @@ -96,13 +96,13 @@ more. More information can be found at http://www.ActiveState.com/Tcl -## 5. Tcl newsgroup +## 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 +## 6. Tcl'ers Wiki There is a [wiki-based open community site](https://wiki.tcl-lang.org/) covering all aspects of Tcl/Tk. @@ -112,13 +112,13 @@ 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 +## 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 [here](https://sourceforge.net/projects/tcl/) and go to the Mailing Lists page. -## 8. Support and Training +## 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 issue tracker](https://core.tcl-lang.org/tcl/reportlist). @@ -138,11 +138,11 @@ newsgroup and will attempt to answer esoteric questions for which no one else is likely to know the answer. In addition, see the wiki for [links to other organizations](https://wiki.tcl-lang.org/training) that offer Tcl/Tk training. -## 9. Tracking Development +## 9. Tracking Development Tcl is developed in public. You can keep an eye on how Tcl is changing at [core.tcl-lang.org](https://core.tcl-lang.org/). -## 10. Thank You +## 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. -- cgit v0.12 From 6efd8f71f2a7f42d036b4899461500a0ec69b1fa Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 20 Oct 2018 16:44:51 +0000 Subject: formatting tweak --- README.md | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/README.md b/README.md index cbc49f0..094a189 100644 --- a/README.md +++ b/README.md @@ -8,16 +8,16 @@ site](https://sourceforge.net/projects/tcl/files/Tcl/). [![Build Status](https://travis-ci.org/tcltk/tcl.svg?branch=core-8-5-branch)](https://travis-ci.org/tcltk/tcl) ## 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 + 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 -- cgit v0.12 From 1caba8a761ad4d16139496bcbd931d91ed3931f7 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 20 Oct 2018 16:47:29 +0000 Subject: Add local links --- README.md | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/README.md b/README.md index 094a189..3c4440e 100644 --- a/README.md +++ b/README.md @@ -8,16 +8,16 @@ site](https://sourceforge.net/projects/tcl/files/Tcl/). [![Build Status](https://travis-ci.org/tcltk/tcl.svg?branch=core-8-5-branch)](https://travis-ci.org/tcltk/tcl) ## 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](#intro) + 2. [Documentation](#doc) + 3. [Compiling and installing Tcl](#build) + 4. [Development tools](#devtools) + 5. [Tcl newsgroup](#complangtcl) + 6. [The Tcler's Wiki](#wiki) + 7. [Mailing lists](#email) + 8. [Support and Training](#support) + 9. [Tracking Development](#watch) + 10. [Thank You](#thanks) ## 1. Introduction Tcl provides a powerful platform for creating integration applications that -- cgit v0.12 From 2e0a0b53053f3699f0593ca9e50b5ba45a548da1 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 20 Oct 2018 18:02:45 +0000 Subject: Remove old README --- README | 185 ----------------------------------------------------------------- 1 file changed, 185 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. -- cgit v0.12 From 0c78f5bbada0703c8063287e2e063604c4023ba7 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 21 Oct 2018 10:16:05 +0000 Subject: Disable windows builds. Make test failures fatal. --- .travis.yml | 12 +++++++----- library/tcltest/tcltest.tcl | 4 ++-- tests/all.tcl | 4 +++- 3 files changed, 12 insertions(+), 8 deletions(-) diff --git a/.travis.yml b/.travis.yml index 3abeb6b..d5c93c1 100644 --- a/.travis.yml +++ b/.travis.yml @@ -48,16 +48,18 @@ matrix: - os: osx osx_image: xcode8 env: - - MATRIX_EVAL="BUILD_DIR=macosx" - - os: windows - env: - - MATRIX_EVAL="BUILD_DIR=win" + - MATRIX_EVAL="BUILD_DIR=macosx && NO_DIRECT_CONFIGURE=1" +### C builds not currently supported on Windows instances +# - os: windows +# env: +# - MATRIX_EVAL="BUILD_DIR=win" before_install: - eval "${MATRIX_EVAL}" + - export ERROR_ON_FAILURES=1 - cd ${BUILD_DIR} install: - - ./configure + - test -z "$NO_DIRECT_CONFIGURE" || ./configure script: - make - make test diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 8e43859..0d55ff7 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -2696,7 +2696,7 @@ proc tcltest::GetMatchingDirectories {rootdir} { # shell being tested # # Results: -# None. +# Whether there were any failures. # # Side effects: # None. @@ -2842,7 +2842,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 c201290179fd33b699c27e7ed181281c18a8fa06 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 22 Oct 2018 13:11:45 +0000 Subject: Expand the build matrix --- .travis.yml | 44 +++++++++++++++++++++++++++++++++++--------- 1 file changed, 35 insertions(+), 9 deletions(-) diff --git a/.travis.yml b/.travis.yml index d5c93c1..0f8af5a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,11 +1,26 @@ dist: trusty +sudo: false language: c matrix: include: - os: linux + compiler: clang env: - - MATRIX_EVAL="BUILD_DIR=unix" + - MATRIX_EVAL="" BUILD_DIR=unix - os: linux + compiler: clang + env: + - MATRIX_EVAL="" BUILD_DIR=unix CFGOPT=--disable-shared + - os: linux + compiler: gcc + env: + - MATRIX_EVAL="" BUILD_DIR=unix + - os: linux + compiler: gcc + env: + - MATRIX_EVAL="" BUILD_DIR=unix CFGOPT=--disable-shared + - os: linux + compiler: gcc addons: apt: sources: @@ -13,8 +28,9 @@ matrix: packages: - g++-4.9 env: - - MATRIX_EVAL="CC=gcc-4.9 && BUILD_DIR=unix" + - MATRIX_EVAL="CC=gcc-4.9" BUILD_DIR=unix - os: linux + compiler: gcc addons: apt: sources: @@ -22,8 +38,9 @@ matrix: packages: - g++-5 env: - - MATRIX_EVAL="CC=gcc-5 && BUILD_DIR=unix" + - MATRIX_EVAL="CC=gcc-5" BUILD_DIR=unix - os: linux + compiler: gcc addons: apt: sources: @@ -31,8 +48,9 @@ matrix: packages: - g++-6 env: - - MATRIX_EVAL="CC=gcc-6 && BUILD_DIR=unix" + - MATRIX_EVAL="CC=gcc-6" BUILD_DIR=unix - os: linux + compiler: gcc addons: apt: sources: @@ -40,26 +58,34 @@ matrix: packages: - g++-7 env: - - MATRIX_EVAL="CC=gcc-7 && BUILD_DIR=unix" + - MATRIX_EVAL="CC=gcc-7" BUILD_DIR=unix - os: osx osx_image: xcode8 env: - - MATRIX_EVAL="BUILD_DIR=unix" + - MATRIX_EVAL="" BUILD_DIR=unix - os: osx osx_image: xcode8 env: - - MATRIX_EVAL="BUILD_DIR=macosx && NO_DIRECT_CONFIGURE=1" + - MATRIX_EVAL="" BUILD_DIR=macosx NO_DIRECT_CONFIGURE=1 + - os: osx + osx_image: xcode9 + env: + - MATRIX_EVAL="" BUILD_DIR=macosx NO_DIRECT_CONFIGURE=1 + - os: osx + osx_image: xcode10 + env: + - MATRIX_EVAL="" BUILD_DIR=macosx NO_DIRECT_CONFIGURE=1 ### C builds not currently supported on Windows instances # - os: windows # env: -# - MATRIX_EVAL="BUILD_DIR=win" +# - MATRIX_EVAL="" BUILD_DIR=win before_install: - eval "${MATRIX_EVAL}" - export ERROR_ON_FAILURES=1 - cd ${BUILD_DIR} install: - - test -z "$NO_DIRECT_CONFIGURE" || ./configure + - test -n "$NO_DIRECT_CONFIGURE" || ./configure ${CFGOPT} script: - make - make test -- cgit v0.12 From c69ccc749e9de9c32a0e0c7b6f733b8e64e1209f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 24 Oct 2018 21:22:18 +0000 Subject: Backport "registry" version 1.3.3, so all active branches now have the same registry version. (this commit must -eventually- be merge-marked to core-8-6-branch, since everything is there already) --- library/reg/pkgIndex.tcl | 8 +- tests/registry.test | 294 +++++++++++++-------- win/Makefile.in | 6 +- win/configure.in | 4 +- win/makefile.bc | 4 +- win/makefile.vc | 10 +- win/rules.vc | 4 +- win/tclWinReg.c | 666 +++++++++++++++++++++++------------------------ 8 files changed, 519 insertions(+), 477 deletions(-) diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl index 1241f2a..12c7ea5 100755 --- a/library/reg/pkgIndex.tcl +++ b/library/reg/pkgIndex.tcl @@ -1,9 +1,9 @@ if {![package vsatisfies [package provide Tcl] 8]} return if {[info sharedlibextension] != ".dll"} return if {[info exists ::tcl_platform(debug)]} { - package ifneeded registry 1.2.2 \ - [list load [file join $dir tclreg12g.dll] registry] + package ifneeded registry 1.3.3 \ + [list load [file join $dir tclreg13g.dll] registry] } else { - package ifneeded registry 1.2.2 \ - [list load [file join $dir tclreg12.dll] registry] + package ifneeded registry 1.3.3 \ + [list load [file join $dir tclreg13.dll] registry] } diff --git a/tests/registry.test b/tests/registry.test index cbca4fd..539ba2d 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -19,7 +19,7 @@ testConstraint reg 0 if {[testConstraint win]} { if {![catch { ::tcltest::loadTestedCommands - package require registry + set ::regver [package require registry 1.3.3] }]} { testConstraint reg 1 } @@ -30,17 +30,35 @@ testConstraint english [expr { [llength [info commands testlocale]] && [string match "English*" [testlocale all ""]] }] - + +test registry-1.0 {check if we are testing the right dll} {win reg} { + set ::regver +} {1.3.3} test registry-1.1 {argument parsing for registry command} {win reg} { list [catch {registry} msg] $msg -} {1 {wrong # args: should be "registry option ?arg arg ...?"}} +} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} +test registry-1.1a {argument parsing for registry command} {win reg} { + list [catch {registry -32bit} msg] $msg +} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} +test registry-1.1b {argument parsing for registry command} {win reg} { + list [catch {registry -64bit} msg] $msg +} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} test registry-1.2 {argument parsing for registry command} {win reg} { list [catch {registry foo} msg] $msg } {1 {bad option "foo": must be broadcast, delete, get, keys, set, type, or values}} +test registry-1.2a {argument parsing for registry command} {win reg} { + list [catch {registry -33bit foo} msg] $msg +} {1 {bad mode "-33bit": must be -32bit or -64bit}} test registry-1.3 {argument parsing for registry command} {win reg} { list [catch {registry d} msg] $msg } {1 {wrong # args: should be "registry delete keyName ?valueName?"}} +test registry-1.3a {argument parsing for registry command} {win reg} { + list [catch {registry -32bit d} msg] $msg +} {1 {wrong # args: should be "registry -32bit delete keyName ?valueName?"}} +test registry-1.3b {argument parsing for registry command} {win reg} { + list [catch {registry -64bit d} msg] $msg +} {1 {wrong # args: should be "registry -64bit delete keyName ?valueName?"}} test registry-1.4 {argument parsing for registry command} {win reg} { list [catch {registry delete} msg] $msg } {1 {wrong # args: should be "registry delete keyName ?valueName?"}} @@ -51,6 +69,12 @@ test registry-1.5 {argument parsing for registry command} {win reg} { test registry-1.6 {argument parsing for registry command} {win reg} { list [catch {registry g} msg] $msg } {1 {wrong # args: should be "registry get keyName valueName"}} +test registry-1.6a {argument parsing for registry command} {win reg} { + list [catch {registry -32bit g} msg] $msg +} {1 {wrong # args: should be "registry -32bit get keyName valueName"}} +test registry-1.6b {argument parsing for registry command} {win reg} { + list [catch {registry -64bit g} msg] $msg +} {1 {wrong # args: should be "registry -64bit get keyName valueName"}} test registry-1.7 {argument parsing for registry command} {win reg} { list [catch {registry get} msg] $msg } {1 {wrong # args: should be "registry get keyName valueName"}} @@ -64,6 +88,12 @@ test registry-1.9 {argument parsing for registry command} {win reg} { test registry-1.10 {argument parsing for registry command} {win reg} { list [catch {registry k} msg] $msg } {1 {wrong # args: should be "registry keys keyName ?pattern?"}} +test registry-1.10a {argument parsing for registry command} {win reg} { + list [catch {registry -32bit k} msg] $msg +} {1 {wrong # args: should be "registry -32bit keys keyName ?pattern?"}} +test registry-1.10b {argument parsing for registry command} {win reg} { + list [catch {registry -64bit k} msg] $msg +} {1 {wrong # args: should be "registry -64bit keys keyName ?pattern?"}} test registry-1.11 {argument parsing for registry command} {win reg} { list [catch {registry keys} msg] $msg } {1 {wrong # args: should be "registry keys keyName ?pattern?"}} @@ -74,6 +104,12 @@ test registry-1.12 {argument parsing for registry command} {win reg} { test registry-1.13 {argument parsing for registry command} {win reg} { list [catch {registry s} msg] $msg } {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}} +test registry-1.13a {argument parsing for registry command} {win reg} { + list [catch {registry -32bit s} msg] $msg +} {1 {wrong # args: should be "registry -32bit set keyName ?valueName data ?type??"}} +test registry-1.13b {argument parsing for registry command} {win reg} { + list [catch {registry -64bit s} msg] $msg +} {1 {wrong # args: should be "registry -64bit set keyName ?valueName data ?type??"}} test registry-1.14 {argument parsing for registry command} {win reg} { list [catch {registry set} msg] $msg } {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}} @@ -87,6 +123,12 @@ test registry-1.16 {argument parsing for registry command} {win reg} { test registry-1.17 {argument parsing for registry command} {win reg} { list [catch {registry t} msg] $msg } {1 {wrong # args: should be "registry type keyName valueName"}} +test registry-1.17a {argument parsing for registry command} {win reg} { + list [catch {registry -32bit t} msg] $msg +} {1 {wrong # args: should be "registry -32bit type keyName valueName"}} +test registry-1.17b {argument parsing for registry command} {win reg} { + list [catch {registry -64bit t} msg] $msg +} {1 {wrong # args: should be "registry -64bit type keyName valueName"}} test registry-1.18 {argument parsing for registry command} {win reg} { list [catch {registry type} msg] $msg } {1 {wrong # args: should be "registry type keyName valueName"}} @@ -100,6 +142,12 @@ test registry-1.20 {argument parsing for registry command} {win reg} { test registry-1.21 {argument parsing for registry command} {win reg} { list [catch {registry v} msg] $msg } {1 {wrong # args: should be "registry values keyName ?pattern?"}} +test registry-1.21a {argument parsing for registry command} {win reg} { + list [catch {registry -32bit v} msg] $msg +} {1 {wrong # args: should be "registry -32bit values keyName ?pattern?"}} +test registry-1.21b {argument parsing for registry command} {win reg} { + list [catch {registry -64bit v} msg] $msg +} {1 {wrong # args: should be "registry -64bit values keyName ?pattern?"}} test registry-1.22 {argument parsing for registry command} {win reg} { list [catch {registry values} msg] $msg } {1 {wrong # args: should be "registry values keyName ?pattern?"}} @@ -111,10 +159,10 @@ test registry-2.1 {DeleteKey: bad key} {win reg} { list [catch {registry delete foo} msg] $msg } {1 {bad root name "foo": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}} test registry-2.2 {DeleteKey: bad key} {win reg} { - list [catch {registry delete HKEY_CURRENT_USER} msg] $msg + list [catch {registry delete HKEY_CLASSES_ROOT} msg] $msg } {1 {bad key: cannot delete root keys}} test registry-2.3 {DeleteKey: bad key} {win reg} { - list [catch {registry delete HKEY_CURRENT_USER\\} msg] $msg + list [catch {registry delete HKEY_CLASSES_ROOT\\} msg] $msg } {1 {bad key: cannot delete root keys}} test registry-2.4 {DeleteKey: subkey at root level} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar @@ -235,7 +283,7 @@ test registry-4.7 {GetKeyNames: Unicode} {win reg english} { registry delete HKEY_CURRENT_USER\\TclFoobar set result } "baz\u00c7bar blat" -test registry-4.8 {GetKeyNames: Unicode} {win reg nt} { +test registry-4.8 {GetKeyNames: Unicode} {win reg} { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u30b7bar registry set HKEY_CURRENT_USER\\TclFoobar\\blat @@ -439,7 +487,7 @@ test registry-6.17 {GetValue: Unicode value names} {win reg} { registry delete HKEY_CURRENT_USER\\TclFoobar set result } foobar -test registry-6.18 {GetValue: values with Unicode strings} {win reg nt} { +test registry-6.18 {GetValue: values with Unicode strings} {win reg} { registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u30b7r baz} multi_sz set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] registry delete HKEY_CURRENT_USER\\TclFoobar @@ -457,161 +505,181 @@ test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} { registry delete HKEY_CURRENT_USER\\TclFoobar set result } "foo ba r baz" -test registry-6.21 {GetValue: very long value names and values} {pcOnly reg} { - registry set HKEY_CURRENT_USER\\TclFoobar [string repeat k 199] [string repeat x 199] multi_sz - set result [registry get HKEY_CURRENT_USER\\TclFoobar [string repeat k 199]] +test registry-6.21 {GetValue: very long value names and values} {win reg} { + registry set HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383] [string repeat x 16383] multi_sz + set result [registry get HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383]] registry delete HKEY_CURRENT_USER\\TclFoobar set result -} [string repeat x 199] +} [string repeat x 16383] -test registry-7.1 {GetValueNames: bad key} {win reg english} { +test registry-7.1 {GetValueNames: bad key} -constraints {win reg english} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar - list [catch {registry values HKEY_CURRENT_USER\\TclFoobar} msg] $msg -} {1 {unable to open key: The system cannot find the file specified.}} -test registry-7.2 {GetValueNames} {win reg} { +} -body { + registry values HKEY_CURRENT_USER\\TclFoobar +} -returnCodes error -result {unable to open key: The system cannot find the file specified.} +test registry-7.2 {GetValueNames} -constraints {win reg} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar baz foobar - set result [registry values HKEY_CURRENT_USER\\TclFoobar] +} -body { + registry values HKEY_CURRENT_USER\\TclFoobar +} -cleanup { registry delete HKEY_CURRENT_USER\\TclFoobar - set result -} baz -test registry-7.3 {GetValueNames} {win reg} { +} -result baz +test registry-7.3 {GetValueNames} -constraints {win reg} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar baz foobar1 registry set HKEY_CURRENT_USER\\TclFoobar blat foobar2 registry set HKEY_CURRENT_USER\\TclFoobar {} foobar3 - set result [lsort [registry values HKEY_CURRENT_USER\\TclFoobar]] +} -body { + lsort [registry values HKEY_CURRENT_USER\\TclFoobar] +} -cleanup { registry delete HKEY_CURRENT_USER\\TclFoobar - set result -} {{} baz blat} -test registry-7.4 {GetValueNames: remote key} {win reg nonPortable english} { +} -result {{} baz blat} +test registry-7.4 {GetValueNames: remote key} -constraints {win reg nonPortable english} -body { set hostname [info hostname] registry set \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar baz blat set result [registry values \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar] registry delete \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar set result -} baz -test registry-7.5 {GetValueNames: empty key} {win reg} { +} -result baz +test registry-7.5 {GetValueNames: empty key} -constraints {win reg} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar - set result [registry values HKEY_CURRENT_USER\\TclFoobar] +} -body { + registry values HKEY_CURRENT_USER\\TclFoobar +} -cleanup { registry delete HKEY_CURRENT_USER\\TclFoobar - set result -} {} -test registry-7.6 {GetValueNames: patterns} {win reg} { +} -result {} +test registry-7.6 {GetValueNames: patterns} -constraints {win reg} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar baz foobar1 registry set HKEY_CURRENT_USER\\TclFoobar blat foobar2 registry set HKEY_CURRENT_USER\\TclFoobar foo foobar3 - set result [lsort [registry values HKEY_CURRENT_USER\\TclFoobar b*]] +} -body { + lsort [registry values HKEY_CURRENT_USER\\TclFoobar b*] +} -cleanup { registry delete HKEY_CURRENT_USER\\TclFoobar - set result -} {baz blat} -test registry-7.7 {GetValueNames: names with spaces} {win reg} { +} -result {baz blat} +test registry-7.7 {GetValueNames: names with spaces} -constraints {win reg} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar baz\ bar foobar1 registry set HKEY_CURRENT_USER\\TclFoobar blat foobar2 registry set HKEY_CURRENT_USER\\TclFoobar foo foobar3 - set result [lsort [registry values HKEY_CURRENT_USER\\TclFoobar b*]] +} -body { + lsort [registry values HKEY_CURRENT_USER\\TclFoobar b*] +} -cleanup { registry delete HKEY_CURRENT_USER\\TclFoobar - set result -} {{baz bar} blat} +} -result {{baz bar} blat} -test registry-8.1 {OpenSubKey} {win reg nonPortable english} { - # This test will only succeed if the current user does not have registry - # access on the specified machine. - list [catch {registry keys {\\mom\HKEY_LOCAL_MACHINE}} msg] $msg -} {1 {unable to open key: Access is denied.}} -test registry-8.2 {OpenSubKey} {win reg} { +test registry-8.1 {OpenSubKey} -constraints {win reg nonPortable english} \ + -body { + # This test will only succeed if the current user does not have + # registry access on the specified machine. + registry keys {\\mom\HKEY_LOCAL_MACHINE} + } -returnCodes error -result "unable to open key: Access is denied." +test registry-8.2 {OpenSubKey} -constraints {win reg} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar - set result [registry keys HKEY_CURRENT_USER TclFoobar] +} -body { + registry keys HKEY_CURRENT_USER TclFoobar +} -cleanup { registry delete HKEY_CURRENT_USER\\TclFoobar - set result -} TclFoobar -test registry-8.3 {OpenSubKey} {win reg english} { +} -result {TclFoobar} +test registry-8.3 {OpenSubKey} -constraints {win reg english} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar - list [catch {registry keys HKEY_CURRENT_USER\\TclFoobar} msg] $msg -} {1 {unable to open key: The system cannot find the file specified.}} +} -body { + registry keys HKEY_CURRENT_USER\\TclFoobar +} -returnCodes error \ + -result "unable to open key: The system cannot find the file specified." -test registry-9.1 {ParseKeyName: bad keys} {win reg} { - list [catch {registry values \\} msg] $msg -} "1 {bad key \"\\\": must start with a valid root}" -test registry-9.2 {ParseKeyName: bad keys} {win reg} { - list [catch {registry values \\foobar} msg] $msg -} {1 {bad key "\foobar": must start with a valid root}} -test registry-9.3 {ParseKeyName: bad keys} {win reg} { - list [catch {registry values \\\\} msg] $msg -} {1 {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}} -test registry-9.4 {ParseKeyName: bad keys} {win reg} { - list [catch {registry values \\\\\\} msg] $msg -} {1 {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}} -test registry-9.5 {ParseKeyName: bad keys} {win reg english nt} { - list [catch {registry values \\\\\\HKEY_CURRENT_USER} msg] $msg -} {1 {unable to open key: The network address is invalid.}} -test registry-9.6 {ParseKeyName: bad keys} {win reg} { - list [catch {registry values \\\\gaspode} msg] $msg -} {1 {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}} -test registry-9.7 {ParseKeyName: bad keys} {win reg} { - list [catch {registry values foobar} msg] $msg -} {1 {bad root name "foobar": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}} -test registry-9.8 {ParseKeyName: null keys} {win reg} { - list [catch {registry delete HKEY_CURRENT_USER\\} msg] $msg -} {1 {bad key: cannot delete root keys}} -test registry-9.9 {ParseKeyName: null keys} {win reg english} { - list [catch {registry keys HKEY_CURRENT_USER\\TclFoobar\\baz} msg] $msg -} {1 {unable to open key: The system cannot find the file specified.}} +test registry-9.1 {ParseKeyName: bad keys} -constraints {win reg} -body { + registry values \\ +} -returnCodes error -result "bad key \"\\\": must start with a valid root" +test registry-9.2 {ParseKeyName: bad keys} -constraints {win reg} -body { + registry values \\foobar +} -returnCodes error -result {bad key "\foobar": must start with a valid root} +test registry-9.3 {ParseKeyName: bad keys} -constraints {win reg} -body { + registry values \\\\ +} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA} +test registry-9.4 {ParseKeyName: bad keys} -constraints {win reg} -body { + registry values \\\\\\ +} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA} +test registry-9.5 {ParseKeyName: bad keys} -constraints {win reg english} -body { + registry values \\\\\\HKEY_CLASSES_ROOT +} -returnCodes error -result {unable to open key: The network address is invalid.} +test registry-9.6 {ParseKeyName: bad keys} -constraints {win reg} -body { + registry values \\\\gaspode +} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA} +test registry-9.7 {ParseKeyName: bad keys} -constraints {win reg} -body { + registry values foobar +} -returnCodes error -result {bad root name "foobar": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA} +test registry-9.8 {ParseKeyName: null keys} -constraints {win reg} -body { + registry delete HKEY_CLASSES_ROOT\\ +} -returnCodes error -result {bad key: cannot delete root keys} +test registry-9.9 {ParseKeyName: null keys} \ + -constraints {win reg english} \ + -body {registry keys HKEY_CLASSES_ROOT\\TclFoobar\\baz} \ + -returnCodes error \ + -result {unable to open key: The system cannot find the file specified.} -test registry-10.1 {RecursiveDeleteKey} {win reg} { +test registry-10.1 {RecursiveDeleteKey} -constraints {win reg} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar +} -body { registry set HKEY_CURRENT_USER\\TclFoobar\\test1 registry set HKEY_CURRENT_USER\\TclFoobar\\test2\\test3 registry delete HKEY_CURRENT_USER\\TclFoobar set result [registry keys HKEY_CURRENT_USER TclFoobar] set result -} {} -test registry-10.2 {RecursiveDeleteKey} {win reg} { +} -result {} +test registry-10.2 {RecursiveDeleteKey} -constraints {win reg} -setup { registry delete HKEY_CURRENT_USER\\TclFoobar registry set HKEY_CURRENT_USER\\TclFoobar\\test1 registry set HKEY_CURRENT_USER\\TclFoobar\\test2\\test3 - set result [registry delete HKEY_CURRENT_USER\\TclFoobar\\test2\\test4] +} -body { + registry delete HKEY_CURRENT_USER\\TclFoobar\\test2\\test4 +} -cleanup { registry delete HKEY_CURRENT_USER\\TclFoobar - set result -} {} - -test registry-11.1 {SetValue: recursive creation} {win reg} { - registry delete HKEY_CURRENT_USER\\TclFoobar - registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat foobar - set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat] -} foobar -test registry-11.2 {SetValue: modification} {win reg} { - registry delete HKEY_CURRENT_USER\\TclFoobar - registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat foobar - registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat frob - set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat] -} frob -test registry-11.3 {SetValue: failure} {win reg nonPortable english} { - # This test will only succeed if the current user does not have registry - # access on the specified machine. - list [catch {registry set {\\mom\HKEY_CURRENT_USER\TclFoobar} bar foobar} msg] $msg -} {1 {unable to open key: Access is denied.}} +} -result {} -test registry-12.1 {BroadcastValue} {win reg} { - list [catch {registry broadcast} msg] $msg -} {1 {wrong # args: should be "registry broadcast keyName ?-timeout millisecs?"}} -test registry-12.2 {BroadcastValue} {win reg} { - list [catch {registry broadcast "" -time} msg] $msg -} {1 {wrong # args: should be "registry broadcast keyName ?-timeout millisecs?"}} -test registry-12.3 {BroadcastValue} {win reg} { - list [catch {registry broadcast "" - 500} msg] $msg -} {1 {wrong # args: should be "registry broadcast keyName ?-timeout millisecs?"}} -test registry-12.4 {BroadcastValue} {win reg} { - list [catch {registry broadcast {Environment}} msg] $msg -} {0 {1 0}} -test registry-12.5 {BroadcastValue} {win reg} { - list [catch {registry b {}} msg] $msg -} {0 {1 0}} +test registry-11.1 {SetValue: recursive creation} \ + -constraints {win reg} -setup { + registry delete HKEY_CURRENT_USER\\TclFoobar + } -body { + registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat foobar + set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat] + } -result {foobar} +test registry-11.2 {SetValue: modification} -constraints {win reg} \ + -setup { + registry delete HKEY_CURRENT_USER\\TclFoobar + } -body { + registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat foobar + registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat frob + set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat] + } -result {frob} +test registry-11.3 {SetValue: failure} \ + -constraints {win reg nonPortable english} \ + -body { + # This test will only succeed if the current user does not have + # registry access on the specified machine. + registry set {\\mom\HKEY_CURRENT_USER\TclFoobar} bar foobar + } -returnCodes error -result {unable to open key: Access is denied.} +test registry-12.1 {BroadcastValue} -constraints {win reg} -body { + registry broadcast +} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\"" +test registry-12.2 {BroadcastValue} -constraints {win reg} -body { + registry broadcast "" -time +} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\"" +test registry-12.3 {BroadcastValue} -constraints {win reg} -body { + registry broadcast "" - 500 +} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\"" +test registry-12.4 {BroadcastValue} -constraints {win reg} -body { + registry broadcast {Environment} +} -result {1 0} +test registry-12.5 {BroadcastValue} -constraints {win reg} -body { + registry b {} +} -result {1 0} + # cleanup ::tcltest::cleanupTests return diff --git a/win/Makefile.in b/win/Makefile.in index d9b52fa..6d1ce95 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -495,7 +495,7 @@ tclAppInit.${OBJEXT} : tclAppInit.c # The following objects should be built using the stub interfaces tclWinReg.${OBJEXT} : tclWinReg.c - $(CC) -c $(CC_SWITCHES) -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME) + $(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME) tclWinDde.${OBJEXT} : tclWinDde.c $(CC) -c $(CC_SWITCHES) -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME) @@ -710,13 +710,13 @@ test: binaries $(TCLTEST) TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ -load "package ifneeded dde 1.3.3 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ - package ifneeded registry 1.2.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32) + package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32) # Useful target to launch a built tcltest with the proper path,... runtest: binaries $(TCLTEST) @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./$(TCLTEST) $(TESTFLAGS) -load "package ifneeded dde 1.3.3 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ - package ifneeded registry 1.2.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT) + package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT) # This target can be used to run tclsh from the build directory via # `make shell SCRIPT=foo.tcl` diff --git a/win/configure.in b/win/configure.in index 8931a38..fa75e5b 100644 --- a/win/configure.in +++ b/win/configure.in @@ -22,9 +22,9 @@ TCL_DDE_MAJOR_VERSION=1 TCL_DDE_MINOR_VERSION=3 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION -TCL_REG_VERSION=1.2 +TCL_REG_VERSION=1.3 TCL_REG_MAJOR_VERSION=1 -TCL_REG_MINOR_VERSION=2 +TCL_REG_MINOR_VERSION=3 REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION #------------------------------------------------------------------------ diff --git a/win/makefile.bc b/win/makefile.bc index 6421682..20d89bc 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -130,8 +130,8 @@ VERSION = 85 DDEVERSION = 13 DDEDOTVERSION = 1.3 -REGVERSION = 12 -REGDOTVERSION = 1.2 +REGVERSION = 13 +REGDOTVERSION = 1.3 BINROOT = .. !IF "$(NODEBUG)" == "1" diff --git a/win/makefile.vc b/win/makefile.vc index aedb7a6..c330fcd 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -185,7 +185,7 @@ VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) DDEDOTVERSION = 1.3 DDEVERSION = $(DDEDOTVERSION:.=) -REGDOTVERSION = 1.2 +REGDOTVERSION = 1.3 REGVERSION = $(REGDOTVERSION:.=) BINROOT = . @@ -539,13 +539,13 @@ test-core: setup $(TCLTEST) dlls $(CAT32) !if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE" $(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << package ifneeded dde 1.3.3 [list load "$(TCLDDELIB:\=/)" dde] - package ifneeded registry 1.2.2 [list load "$(TCLREGLIB:\=/)" registry] + package ifneeded registry 1.3.3 [list load "$(TCLREGLIB:\=/)" registry] << !else @echo Please wait while the tests are collected... $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log package ifneeded dde 1.3.3 "$(TCLDDELIB:\=/)" dde] - package ifneeded registry 1.2.2 "$(TCLREGLIB:\=/)" registry] + package ifneeded registry 1.3.3 "$(TCLREGLIB:\=/)" registry] << type tests.log | more !endif @@ -885,9 +885,9 @@ $(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c $(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c !if $(STATIC_BUILD) - $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $? + $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -DUNICODE -D_UNICODE -Fo$@ $? !else - $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $? + $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -DUNICODE -D_UNICODE -Fo$@ $? !endif diff --git a/win/rules.vc b/win/rules.vc index 2edaa49..0ae0e8e 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -590,7 +590,7 @@ TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe" TCLSTUBLIB = "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib" TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib" TCL_LIBRARY = $(_TCLDIR)\lib -TCLREGLIB = "$(_TCLDIR)\lib\tclreg12$(SUFX:t=).lib" +TCLREGLIB = "$(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib" TCLDDELIB = "$(_TCLDIR)\lib\tcldde13$(SUFX:t=).lib" COFFBASE = \must\have\tcl\sources\to\build\this\target TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target @@ -603,7 +603,7 @@ TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX).exe" TCLSTUBLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib" TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib" TCL_LIBRARY = $(_TCLDIR)\library -TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg12$(SUFX:t=).lib" +TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib" TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde13$(SUFX:t=).lib" COFFBASE = "$(_TCLDIR)\win\coffbase.txt" TCLTOOLSDIR = $(_TCLDIR)\tools diff --git a/win/tclWinReg.c b/win/tclWinReg.c index a6ce2ce..f3d7a07 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -12,36 +12,41 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#undef STATIC_BUILD +#ifndef USE_TCL_STUBS +# define USE_TCL_STUBS +#endif #include "tclInt.h" -#include "tclPort.h" #ifdef _MSC_VER # pragma comment (lib, "advapi32.lib") #endif #include /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Registry_Init declaration is in the source file itself, which is only - * accessed when we are building a library. + * Ensure that we can say which registry is being accessed. */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT +#ifndef KEY_WOW64_64KEY +# define KEY_WOW64_64KEY (0x0100) +#endif +#ifndef KEY_WOW64_32KEY +# define KEY_WOW64_32KEY (0x0200) +#endif /* * The maximum length of a sub-key name. */ #ifndef MAX_KEY_LENGTH -#define MAX_KEY_LENGTH 256 +# define MAX_KEY_LENGTH 256 #endif /* * The following macros convert between different endian ints. */ -#define SWAPWORD(x) MAKEWORD(HIBYTE(x), LOBYTE(x)) -#define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x))) +#define SWAPWORD(x) MAKEWORD(HIBYTE(x), LOBYTE(x)) +#define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x))) /* * The following flag is used in OpenKeys to indicate that the specified key @@ -55,7 +60,7 @@ * system predefined keys. */ -static CONST char *rootKeyNames[] = { +static const char *const rootKeyNames[] = { "HKEY_LOCAL_MACHINE", "HKEY_USERS", "HKEY_CLASSES_ROOT", "HKEY_CURRENT_USER", "HKEY_CURRENT_CONFIG", "HKEY_PERFORMANCE_DATA", "HKEY_DYN_DATA", NULL @@ -66,7 +71,7 @@ static const HKEY rootKeys[] = { HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA }; -static CONST char REGISTRY_ASSOC_KEY[] = "registry::command"; +static const char REGISTRY_ASSOC_KEY[] = "registry::command"; /* * The following table maps from registry types to strings. Note that the @@ -74,7 +79,7 @@ static CONST char REGISTRY_ASSOC_KEY[] = "registry::command"; * types so we don't need a separate table to hold the mapping. */ -static CONST char *typeNames[] = { +static const char *const typeNames[] = { "none", "sz", "expand_sz", "binary", "dword", "dword_big_endian", "link", "multi_sz", "resource_list", NULL }; @@ -82,100 +87,26 @@ static CONST char *typeNames[] = { static DWORD lastType = REG_RESOURCE_LIST; /* - * The following structures allow us to select between the Unicode and ASCII - * interfaces at run time based on whether Unicode APIs are available. The - * Unicode APIs are preferable because they will handle characters outside of - * the current code page. - */ - -typedef struct RegWinProcs { - int useWide; - - LONG (WINAPI *regConnectRegistryProc)(CONST TCHAR *, HKEY, PHKEY); - LONG (WINAPI *regCreateKeyExProc)(HKEY, CONST TCHAR *, DWORD, TCHAR *, - DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, DWORD *); - LONG (WINAPI *regDeleteKeyProc)(HKEY, CONST TCHAR *); - LONG (WINAPI *regDeleteValueProc)(HKEY, CONST TCHAR *); - LONG (WINAPI *regEnumKeyProc)(HKEY, DWORD, TCHAR *, DWORD); - LONG (WINAPI *regEnumKeyExProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, - TCHAR *, DWORD *, FILETIME *); - LONG (WINAPI *regEnumValueProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, - DWORD *, BYTE *, DWORD *); - LONG (WINAPI *regOpenKeyExProc)(HKEY, CONST TCHAR *, DWORD, REGSAM, - HKEY *); - LONG (WINAPI *regQueryValueExProc)(HKEY, CONST TCHAR *, DWORD *, DWORD *, - BYTE *, DWORD *); - LONG (WINAPI *regSetValueExProc)(HKEY, CONST TCHAR *, DWORD, DWORD, - CONST BYTE*, DWORD); -} RegWinProcs; - -static RegWinProcs *regWinProcs; - -static RegWinProcs asciiProcs = { - 0, - - (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryA, - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *, - DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, - DWORD *)) RegCreateKeyExA, - (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyA, - (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueA, - (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyA, - (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, - TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExA, - (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, - DWORD *, BYTE *, DWORD *)) RegEnumValueA, - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM, - HKEY *)) RegOpenKeyExA, - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *, - BYTE *, DWORD *)) RegQueryValueExA, - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD, - CONST BYTE*, DWORD)) RegSetValueExA, -}; - -static RegWinProcs unicodeProcs = { - 1, - - (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryW, - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *, - DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, - DWORD *)) RegCreateKeyExW, - (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyW, - (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueW, - (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyW, - (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, - TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExW, - (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, - DWORD *, BYTE *, DWORD *)) RegEnumValueW, - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM, - HKEY *)) RegOpenKeyExW, - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *, - BYTE *, DWORD *)) RegQueryValueExW, - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD, - CONST BYTE*, DWORD)) RegSetValueExW, -}; - - -/* * Declarations for functions defined in this file. */ static void AppendSystemError(Tcl_Interp *interp, DWORD error); static int BroadcastValue(Tcl_Interp *interp, int objc, - Tcl_Obj * CONST objv[]); + Tcl_Obj *const objv[]); static DWORD ConvertDWORD(DWORD type, DWORD value); static void DeleteCmd(ClientData clientData); -static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj); +static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj, + REGSAM mode); static int DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *valueNameObj); + Tcl_Obj *valueNameObj, REGSAM mode); static int GetKeyNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *patternObj); + Tcl_Obj *patternObj, REGSAM mode); static int GetType(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *valueNameObj); + Tcl_Obj *valueNameObj, REGSAM mode); static int GetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *valueNameObj); + Tcl_Obj *valueNameObj, REGSAM mode); static int GetValueNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *patternObj); + Tcl_Obj *patternObj, REGSAM mode); static int OpenKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj, REGSAM mode, int flags, HKEY *keyPtr); static DWORD OpenSubKey(char *hostName, HKEY rootKey, @@ -185,16 +116,16 @@ static int ParseKeyName(Tcl_Interp *interp, char *name, char **hostNamePtr, HKEY *rootKeyPtr, char **keyNamePtr); static DWORD RecursiveDeleteKey(HKEY hStartKey, - CONST TCHAR * pKeyName); + const TCHAR * pKeyName, REGSAM mode); static int RegistryObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj * CONST objv[]); + Tcl_Obj *const objv[]); static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, - Tcl_Obj *typeObj); + Tcl_Obj *typeObj, REGSAM mode); -EXTERN int Registry_Init(Tcl_Interp *interp); -EXTERN int Registry_Unload(Tcl_Interp *interp, int flags); +DLLEXPORT int Registry_Init(Tcl_Interp *interp); +DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags); /* *---------------------------------------------------------------------- @@ -218,25 +149,14 @@ Registry_Init( { Tcl_Command cmd; - if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { return TCL_ERROR; } - /* - * Determine if the unicode interfaces are available and select the - * appropriate registry function table. - */ - - if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { - regWinProcs = &unicodeProcs; - } else { - regWinProcs = &asciiProcs; - } - cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, - (ClientData)interp, DeleteCmd); - Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)cmd); - return Tcl_PkgProvide(interp, "registry", "1.2.2"); + interp, DeleteCmd); + Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd); + return Tcl_PkgProvide(interp, "registry", "1.3.3"); } /* @@ -276,7 +196,7 @@ Registry_Unload( * Delete the originally registered command. */ - cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL); + cmd = Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL); if (cmd != NULL) { Tcl_DeleteCommandFromToken(interp, cmd); } @@ -306,7 +226,8 @@ DeleteCmd( ClientData clientData) { Tcl_Interp *interp = clientData; - Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)NULL); + + Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, NULL); } /* @@ -330,89 +251,125 @@ RegistryObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj * CONST objv[]) /* Argument values. */ + Tcl_Obj *const objv[]) /* Argument values. */ { - int index; - char *errString = NULL; + int n = 1; + int index, argc; + REGSAM mode = 0; + const char *errString = NULL; - static CONST char *subcommands[] = { + static const char *const subcommands[] = { "broadcast", "delete", "get", "keys", "set", "type", "values", NULL }; enum SubCmdIdx { BroadcastIdx, DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx }; + static const char *const modes[] = { + "-32bit", "-64bit", NULL + }; if (objc < 2) { - Tcl_WrongNumArgs(interp, objc, objv, "option ?arg arg ...?"); + wrongArgs: + Tcl_WrongNumArgs(interp, 1, objv, "?-32bit|-64bit? option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "option", 0, &index) - != TCL_OK) { + if (Tcl_GetString(objv[n])[0] == '-') { + if (Tcl_GetIndexFromObj(interp, objv[n++], modes, "mode", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + switch (index) { + case 0: /* -32bit */ + mode |= KEY_WOW64_32KEY; + break; + case 1: /* -64bit */ + mode |= KEY_WOW64_64KEY; + break; + } + if (objc < 3) { + goto wrongArgs; + } + } + + if (Tcl_GetIndexFromObj(interp, objv[n++], subcommands, "option", 0, + &index) != TCL_OK) { return TCL_ERROR; } + argc = (objc - n); switch (index) { case BroadcastIdx: /* broadcast */ - return BroadcastValue(interp, objc, objv); + if (argc == 1 || argc == 3) { + int res = BroadcastValue(interp, argc, objv + n); + + if (res != TCL_BREAK) { + return res; + } + } + errString = "keyName ?-timeout milliseconds?"; break; case DeleteIdx: /* delete */ - if (objc == 3) { - return DeleteKey(interp, objv[2]); - } else if (objc == 4) { - return DeleteValue(interp, objv[2], objv[3]); + if (argc == 1) { + return DeleteKey(interp, objv[n], mode); + } else if (argc == 2) { + return DeleteValue(interp, objv[n], objv[n+1], mode); } errString = "keyName ?valueName?"; break; case GetIdx: /* get */ - if (objc == 4) { - return GetValue(interp, objv[2], objv[3]); + if (argc == 2) { + return GetValue(interp, objv[n], objv[n+1], mode); } errString = "keyName valueName"; break; case KeysIdx: /* keys */ - if (objc == 3) { - return GetKeyNames(interp, objv[2], NULL); - } else if (objc == 4) { - return GetKeyNames(interp, objv[2], objv[3]); + if (argc == 1) { + return GetKeyNames(interp, objv[n], NULL, mode); + } else if (argc == 2) { + return GetKeyNames(interp, objv[n], objv[n+1], mode); } errString = "keyName ?pattern?"; break; case SetIdx: /* set */ - if (objc == 3) { + if (argc == 1) { HKEY key; /* * Create the key and then close it immediately. */ - if (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 1, &key) != TCL_OK) { + mode |= KEY_ALL_ACCESS; + if (OpenKey(interp, objv[n], mode, 1, &key) != TCL_OK) { return TCL_ERROR; } RegCloseKey(key); return TCL_OK; - } else if (objc == 5 || objc == 6) { - Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5]; - return SetValue(interp, objv[2], objv[3], objv[4], typeObj); + } else if (argc == 3) { + return SetValue(interp, objv[n], objv[n+1], objv[n+2], NULL, + mode); + } else if (argc == 4) { + return SetValue(interp, objv[n], objv[n+1], objv[n+2], objv[n+3], + mode); } errString = "keyName ?valueName data ?type??"; break; case TypeIdx: /* type */ - if (objc == 4) { - return GetType(interp, objv[2], objv[3]); + if (argc == 2) { + return GetType(interp, objv[n], objv[n+1], mode); } errString = "keyName valueName"; break; case ValuesIdx: /* values */ - if (objc == 3) { - return GetValueNames(interp, objv[2], NULL); - } else if (objc == 4) { - return GetValueNames(interp, objv[2], objv[3]); + if (argc == 1) { + return GetValueNames(interp, objv[n], NULL, mode); + } else if (argc == 2) { + return GetValueNames(interp, objv[n], objv[n+1], mode); } errString = "keyName ?pattern?"; break; } - Tcl_WrongNumArgs(interp, 2, objv, errString); + Tcl_WrongNumArgs(interp, (mode ? 3 : 2), objv, errString); return TCL_ERROR; } @@ -435,33 +392,35 @@ RegistryObjCmd( static int DeleteKey( Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Obj *keyNameObj) /* Name of key to delete. */ + Tcl_Obj *keyNameObj, /* Name of key to delete. */ + REGSAM mode) /* Mode flags to pass. */ { char *tail, *buffer, *hostName, *keyName; - CONST char *nativeTail; + const TCHAR *nativeTail; HKEY rootKey, subkey; DWORD result; - int length; Tcl_DString buf; + REGSAM saveMode = mode; /* * Find the parent of the key being deleted and open it. */ - keyName = Tcl_GetStringFromObj(keyNameObj, &length); - buffer = ckalloc((unsigned int) length + 1); + keyName = Tcl_GetString(keyNameObj); + buffer = Tcl_Alloc(keyNameObj->length + 1); strcpy(buffer, keyName); if (ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName) != TCL_OK) { - ckfree(buffer); + Tcl_Free(buffer); return TCL_ERROR; } if (*keyName == '\0') { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad key: cannot delete root keys", -1)); - ckfree(buffer); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("bad key: cannot delete root keys", -1)); + Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL); + Tcl_Free(buffer); return TCL_ERROR; } @@ -473,15 +432,15 @@ DeleteKey( keyName = NULL; } - result = OpenSubKey(hostName, rootKey, keyName, - KEY_ENUMERATE_SUB_KEYS | DELETE, 0, &subkey); + mode |= KEY_ENUMERATE_SUB_KEYS | DELETE; + result = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey); if (result != ERROR_SUCCESS) { - ckfree(buffer); + Tcl_Free(buffer); if (result == ERROR_FILE_NOT_FOUND) { return TCL_OK; } - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unable to delete key: ", -1)); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("unable to delete key: ", -1)); AppendSystemError(interp, result); return TCL_ERROR; } @@ -491,7 +450,7 @@ DeleteKey( */ nativeTail = Tcl_WinUtfToTChar(tail, -1, &buf); - result = RecursiveDeleteKey(subkey, nativeTail); + result = RecursiveDeleteKey(subkey, nativeTail, saveMode); Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) { @@ -504,7 +463,7 @@ DeleteKey( } RegCloseKey(subkey); - ckfree(buffer); + Tcl_Free(buffer); return result; } @@ -528,11 +487,12 @@ static int DeleteValue( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ - Tcl_Obj *valueNameObj) /* Name of value to delete. */ + Tcl_Obj *valueNameObj, /* Name of value to delete. */ + REGSAM mode) /* Mode flags to pass. */ { HKEY key; char *valueName; - int length; + size_t length; DWORD result; Tcl_DString ds; @@ -540,19 +500,20 @@ DeleteValue( * Attempt to open the key for deletion. */ - if (OpenKey(interp, keyNameObj, KEY_SET_VALUE, 0, &key) - != TCL_OK) { + mode |= KEY_SET_VALUE; + if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } - valueName = Tcl_GetStringFromObj(valueNameObj, &length); + valueName = Tcl_GetString(valueNameObj); + length = valueNameObj->length; Tcl_WinUtfToTChar(valueName, length, &ds); - result = (*regWinProcs->regDeleteValueProc)(key, Tcl_DStringValue(&ds)); + result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); if (result != ERROR_SUCCESS) { - Tcl_AppendResult(interp, "unable to delete value \"", - Tcl_GetString(valueNameObj), "\" from key \"", - Tcl_GetString(keyNameObj), "\": ", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to delete value \"%s\" from key \"%s\": ", + Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); result = TCL_ERROR; } else { @@ -585,11 +546,13 @@ static int GetKeyNames( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Key to enumerate. */ - Tcl_Obj *patternObj) /* Optional match pattern. */ + Tcl_Obj *patternObj, /* Optional match pattern. */ + REGSAM mode) /* Mode flags to pass. */ { - char *pattern; /* Pattern being matched against subkeys */ + const char *pattern; /* Pattern being matched against subkeys */ HKEY key; /* Handle to the key being examined */ - TCHAR buffer[MAX_KEY_LENGTH*2]; /* Buffer to hold the subkey name */ + TCHAR buffer[MAX_KEY_LENGTH]; + /* Buffer to hold the subkey name */ DWORD bufSize; /* Size of the buffer */ DWORD index; /* Position of the current subkey */ char *name; /* Subkey name */ @@ -603,40 +566,37 @@ GetKeyNames( pattern = NULL; } - /* Attempt to open the key for enumeration. */ + /* + * Attempt to open the key for enumeration. + */ - if (OpenKey(interp, keyNameObj, - KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS, - 0, &key) != TCL_OK) { + mode |= KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS; + if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } - /* Enumerate the subkeys */ + /* + * Enumerate the subkeys. + */ resultPtr = Tcl_NewObj(); for (index = 0;; ++index) { bufSize = MAX_KEY_LENGTH; - result = (*regWinProcs->regEnumKeyExProc) - (key, index, buffer, &bufSize, NULL, NULL, NULL, NULL); + result = RegEnumKeyEx(key, index, buffer, &bufSize, + NULL, NULL, NULL, NULL); if (result != ERROR_SUCCESS) { if (result == ERROR_NO_MORE_ITEMS) { result = TCL_OK; } else { - Tcl_SetObjResult(interp, Tcl_NewObj()); - Tcl_AppendResult(interp, - "unable to enumerate subkeys of \"", - Tcl_GetString(keyNameObj), "\": ", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to enumerate subkeys of \"%s\": ", + Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); result = TCL_ERROR; } break; } - if (regWinProcs->useWide) { - Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize * sizeof(WCHAR), &ds); - } else { - Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize, &ds); - } - name = Tcl_DStringValue(&ds); + name = Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds); if (pattern && !Tcl_StringMatch(name, pattern)) { Tcl_DStringFree(&ds); continue; @@ -679,22 +639,22 @@ static int GetType( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ - Tcl_Obj *valueNameObj) /* Name of value to get. */ + Tcl_Obj *valueNameObj, /* Name of value to get. */ + REGSAM mode) /* Mode flags to pass. */ { HKEY key; - DWORD result; - DWORD type; + DWORD result, type; Tcl_DString ds; - char *valueName; - CONST char *nativeValue; - int length; + const char *valueName; + const TCHAR *nativeValue; + size_t length; /* * Attempt to open the key for reading. */ - if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) - != TCL_OK) { + mode |= KEY_QUERY_VALUE; + if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } @@ -702,17 +662,18 @@ GetType( * Get the type of the value. */ - valueName = Tcl_GetStringFromObj(valueNameObj, &length); + valueName = Tcl_GetString(valueNameObj); + length = valueNameObj->length; nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds); - result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type, + result = RegQueryValueEx(key, nativeValue, NULL, &type, NULL, NULL); Tcl_DStringFree(&ds); RegCloseKey(key); if (result != ERROR_SUCCESS) { - Tcl_AppendResult(interp, "unable to get type of value \"", - Tcl_GetString(valueNameObj), "\" from key \"", - Tcl_GetString(keyNameObj), "\": ", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to get type of value \"%s\" from key \"%s\": ", + Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); return TCL_ERROR; } @@ -751,20 +712,22 @@ static int GetValue( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ - Tcl_Obj *valueNameObj) /* Name of value to get. */ + Tcl_Obj *valueNameObj, /* Name of value to get. */ + REGSAM mode) /* Mode flags to pass. */ { HKEY key; - char *valueName; - CONST char *nativeValue; + const char *valueName; + const TCHAR *nativeValue; DWORD result, length, type; Tcl_DString data, buf; - int nameLen; + size_t nameLen; /* * Attempt to open the key for reading. */ - if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) != TCL_OK) { + mode |= KEY_QUERY_VALUE; + if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } @@ -780,12 +743,13 @@ GetValue( Tcl_DStringInit(&data); Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1); - length = TCL_DSTRING_STATIC_SIZE / (regWinProcs->useWide ? 2 : 1) - 1; + length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1; - valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen); + valueName = Tcl_GetString(valueNameObj); + nameLen = valueNameObj->length; nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf); - result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type, + result = RegQueryValueEx(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); while (result == ERROR_MORE_DATA) { /* @@ -794,17 +758,17 @@ GetValue( * HKEY_PERFORMANCE_DATA */ - length = Tcl_DStringLength(&data) * (regWinProcs->useWide ? 1 : 2); - Tcl_DStringSetLength(&data, (int) length * (regWinProcs->useWide ? 2 : 1)); - result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue, + length = Tcl_DStringLength(&data) * (2 / sizeof(TCHAR)); + Tcl_DStringSetLength(&data, (int) length * sizeof(TCHAR)); + result = RegQueryValueEx(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); } Tcl_DStringFree(&buf); RegCloseKey(key); if (result != ERROR_SUCCESS) { - Tcl_AppendResult(interp, "unable to get value \"", - Tcl_GetString(valueNameObj), "\" from key \"", - Tcl_GetString(keyNameObj), "\": ", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to get value \"%s\" from key \"%s\": ", + Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); Tcl_DStringFree(&data); return TCL_ERROR; @@ -819,7 +783,7 @@ GetValue( if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { Tcl_SetObjResult(interp, Tcl_NewIntObj((int) ConvertDWORD(type, - *((DWORD*) Tcl_DStringValue(&data))))); + *((DWORD *) Tcl_DStringValue(&data))))); } else if (type == REG_MULTI_SZ) { char *p = Tcl_DStringValue(&data); char *end = Tcl_DStringValue(&data) + length; @@ -831,19 +795,17 @@ GetValue( * we get bogus data. */ - while (p < end && ((regWinProcs->useWide) - ? *((Tcl_UniChar *)p) : *p) != 0) { + while ((p < end) && *((WCHAR *) p) != 0) { + WCHAR *wp; + Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf); Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(Tcl_DStringValue(&buf), Tcl_DStringLength(&buf))); - if (regWinProcs->useWide) { - Tcl_UniChar* up = (Tcl_UniChar*) p; - while (*up++ != 0) {} - p = (char*) up; - } else { - while (*p++ != '\0') {} - } + wp = (WCHAR *) p; + + while (*wp++ != 0) {/* empty body */} + p = (char *) wp; Tcl_DStringFree(&buf); } Tcl_SetObjResult(interp, resultPtr); @@ -885,27 +847,27 @@ static int GetValueNames( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Key to enumerate. */ - Tcl_Obj *patternObj) /* Optional match pattern. */ + Tcl_Obj *patternObj, /* Optional match pattern. */ + REGSAM mode) /* Mode flags to pass. */ { HKEY key; Tcl_Obj *resultPtr; DWORD index, size, result; Tcl_DString buffer, ds; - char *pattern, *name; + const char *pattern, *name; /* * Attempt to open the key for enumeration. */ - if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) - != TCL_OK) { + mode |= KEY_QUERY_VALUE; + if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } resultPtr = Tcl_NewObj(); Tcl_DStringInit(&buffer); - Tcl_DStringSetLength(&buffer, - (int) ((regWinProcs->useWide) ? MAX_KEY_LENGTH*2 : MAX_KEY_LENGTH)); + Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); index = 0; result = TCL_OK; @@ -922,13 +884,9 @@ GetValueNames( */ size = MAX_KEY_LENGTH; - while ((*regWinProcs->regEnumValueProc)(key, index, - Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL) - == ERROR_SUCCESS) { - - if (regWinProcs->useWide) { - size *= 2; - } + while (RegEnumValue(key,index, (TCHAR *)Tcl_DStringValue(&buffer), + &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) { + size *= sizeof(TCHAR); Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size, &ds); @@ -978,12 +936,13 @@ OpenKey( HKEY *keyPtr) /* Returned HKEY. */ { char *keyName, *buffer, *hostName; - int length; + size_t length; HKEY rootKey; DWORD result; - keyName = Tcl_GetStringFromObj(keyNameObj, &length); - buffer = ckalloc((unsigned int) length + 1); + keyName = Tcl_GetString(keyNameObj); + length = keyNameObj->length; + buffer = Tcl_Alloc(length + 1); strcpy(buffer, keyName); result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName); @@ -999,7 +958,7 @@ OpenKey( } } - ckfree(buffer); + Tcl_Free(buffer); return result; } @@ -1039,7 +998,7 @@ OpenSubKey( if (hostName) { hostName = (char *) Tcl_WinUtfToTChar(hostName, -1, &buf); - result = (*regWinProcs->regConnectRegistryProc)(hostName, rootKey, + result = RegConnectRegistry((TCHAR *)hostName, rootKey, &rootKey); Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS) { @@ -1052,23 +1011,29 @@ OpenSubKey( * this key must be closed by the caller. */ - keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf); + if (keyName) { + keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf); + } if (flags & REG_CREATE) { DWORD create; - result = (*regWinProcs->regCreateKeyExProc)(rootKey, keyName, 0, NULL, + + result = RegCreateKeyEx(rootKey, (TCHAR *)keyName, 0, NULL, REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create); } else if (rootKey == HKEY_PERFORMANCE_DATA) { /* * Here we fudge it for this special root key. See MSDN for more info * on HKEY_PERFORMANCE_DATA and the peculiarities surrounding it. */ + *keyPtr = HKEY_PERFORMANCE_DATA; result = ERROR_SUCCESS; } else { - result = (*regWinProcs->regOpenKeyExProc)(rootKey, keyName, 0, mode, + result = RegOpenKeyEx(rootKey, (TCHAR *)keyName, 0, mode, keyPtr); } - Tcl_DStringFree(&buf); + if (keyName) { + Tcl_DStringFree(&buf); + } /* * Be sure to close the root key since we are done with it now. @@ -1129,8 +1094,9 @@ ParseKeyName( rootName = name; } if (!rootName) { - Tcl_AppendResult(interp, "bad key \"", name, - "\": must start with a valid root", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad key \"%s\": must start with a valid root", name)); + Tcl_SetErrorCode(interp, "WIN_REG", "NO_ROOT_KEY", NULL); return TCL_ERROR; } @@ -1182,12 +1148,16 @@ ParseKeyName( static DWORD RecursiveDeleteKey( HKEY startKey, /* Parent of key to be deleted. */ - CONST char *keyName) /* Name of key to be deleted in external + const TCHAR *keyName, /* Name of key to be deleted in external * encoding, not UTF. */ + REGSAM mode) /* Mode flags to pass. */ { DWORD result, size; Tcl_DString subkey; HKEY hKey; + REGSAM saveMode = mode; + static int checkExProc = 0; + static FARPROC regDeleteKeyExProc = NULL; /* * Do not allow NULL or empty key name. @@ -1197,29 +1167,48 @@ RecursiveDeleteKey( return ERROR_BADKEY; } - result = (*regWinProcs->regOpenKeyExProc)(startKey, keyName, 0, - KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE, &hKey); + mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE; + result = RegOpenKeyEx(startKey, keyName, 0, mode, &hKey); if (result != ERROR_SUCCESS) { return result; } Tcl_DStringInit(&subkey); - Tcl_DStringSetLength(&subkey, - (int) ((regWinProcs->useWide) ? MAX_KEY_LENGTH * 2 : MAX_KEY_LENGTH)); + Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); + mode = saveMode; while (result == ERROR_SUCCESS) { /* * Always get index 0 because key deletion changes ordering. */ size = MAX_KEY_LENGTH; - result=(*regWinProcs->regEnumKeyExProc)(hKey, 0, - Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL); + result = RegEnumKeyEx(hKey, 0, (TCHAR *)Tcl_DStringValue(&subkey), + &size, NULL, NULL, NULL, NULL); if (result == ERROR_NO_MORE_ITEMS) { - result = (*regWinProcs->regDeleteKeyProc)(startKey, keyName); + /* + * RegDeleteKeyEx doesn't exist on non-64bit XP platforms, so we + * can't compile with it in. We need to check for it at runtime + * and use it if we find it. + */ + + if (mode && !checkExProc) { + HMODULE handle; + + checkExProc = 1; + handle = GetModuleHandle(TEXT("ADVAPI32")); + regDeleteKeyExProc = (FARPROC) + GetProcAddress(handle, "RegDeleteKeyExW"); + } + if (mode && regDeleteKeyExProc) { + result = regDeleteKeyExProc(startKey, keyName, mode, 0); + } else { + result = RegDeleteKey(startKey, keyName); + } break; } else if (result == ERROR_SUCCESS) { - result = RecursiveDeleteKey(hKey, Tcl_DStringValue(&subkey)); + result = RecursiveDeleteKey(hKey, + (const TCHAR *) Tcl_DStringValue(&subkey), mode); } } Tcl_DStringFree(&subkey); @@ -1251,29 +1240,32 @@ SetValue( Tcl_Obj *keyNameObj, /* Name of key. */ Tcl_Obj *valueNameObj, /* Name of value to set. */ Tcl_Obj *dataObj, /* Data to be written. */ - Tcl_Obj *typeObj) /* Type of data to be written. */ + Tcl_Obj *typeObj, /* Type of data to be written. */ + REGSAM mode) /* Mode flags to pass. */ { int type; + size_t length; DWORD result; HKEY key; - int length; - char *valueName; + const char *valueName; Tcl_DString nameBuf; if (typeObj == NULL) { type = REG_SZ; } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type", 0, (int *) &type) != TCL_OK) { - if (Tcl_GetIntFromObj(NULL, typeObj, (int*) &type) != TCL_OK) { + if (Tcl_GetIntFromObj(NULL, typeObj, (int *) &type) != TCL_OK) { return TCL_ERROR; } Tcl_ResetResult(interp); } - if (OpenKey(interp, keyNameObj, KEY_ALL_ACCESS, 1, &key) != TCL_OK) { + mode |= KEY_ALL_ACCESS; + if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) { return TCL_ERROR; } - valueName = Tcl_GetStringFromObj(valueNameObj, &length); + valueName = Tcl_GetString(valueNameObj); + length = valueNameObj->length; valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf); if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { @@ -1285,8 +1277,8 @@ SetValue( return TCL_ERROR; } - value = ConvertDWORD((DWORD)type, (DWORD)value); - result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, + value = ConvertDWORD((DWORD) type, (DWORD) value); + result = RegSetValueEx(key, (TCHAR *) valueName, 0, (DWORD) type, (BYTE *) &value, sizeof(DWORD)); } else if (type == REG_MULTI_SZ) { Tcl_DString data, buf; @@ -1307,53 +1299,53 @@ SetValue( Tcl_DStringInit(&data); for (i = 0; i < objc; i++) { - Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1); + const char *bytes = Tcl_GetString(objv[i]); + + length = objv[i]->length; + Tcl_DStringAppend(&data, bytes, length); /* - * Add a null character to separate this value from the next. We - * accomplish this by growing the string by one byte. Since the - * DString always tacks on an extra null byte, the new byte will - * already be set to null. + * Add a null character to separate this value from the next. */ - Tcl_DStringSetLength(&data, Tcl_DStringLength(&data)+1); + Tcl_DStringAppend(&data, "", 1); /* NUL-terminated string */ } Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, &buf); - result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, - (DWORD) type, (BYTE *) Tcl_DStringValue(&buf), + result = RegSetValueEx(key, (TCHAR *) valueName, 0, + (DWORD) type, (BYTE *) Tcl_DStringValue(&buf), (DWORD) Tcl_DStringLength(&buf)); Tcl_DStringFree(&data); Tcl_DStringFree(&buf); } else if (type == REG_SZ || type == REG_EXPAND_SZ) { Tcl_DString buf; - CONST char *data = Tcl_GetStringFromObj(dataObj, &length); + const char *data = Tcl_GetString(dataObj); - data = Tcl_WinUtfToTChar(data, length, &buf); + length = dataObj->length; + data = (char *) Tcl_WinUtfToTChar(data, length, &buf); /* - * Include the null in the length, padding if needed for Unicode. + * Include the null in the length, padding if needed for WCHAR. */ - if (regWinProcs->useWide) { - Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); - } + Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); length = Tcl_DStringLength(&buf) + 1; - result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, - (DWORD) type, (BYTE *) data, (DWORD) length); + result = RegSetValueEx(key, (TCHAR *) valueName, 0, + (DWORD) type, (BYTE *) data, (DWORD) length); Tcl_DStringFree(&buf); } else { BYTE *data; + int bytelength; /* * Store binary data in the registry. */ - data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length); - result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, - (DWORD) type, data, (DWORD) length); + data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &bytelength); + result = RegSetValueEx(key, (TCHAR *) valueName, 0, + (DWORD) type, data, (DWORD) bytelength); } Tcl_DStringFree(&nameBuf); @@ -1389,35 +1381,33 @@ static int BroadcastValue( Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument values. */ + Tcl_Obj *const objv[]) /* Argument values. */ { LRESULT result; DWORD_PTR sendResult; - UINT timeout = 3000; - int len; - CONST char *str; + int timeout = 3000; + size_t len; + const char *str; Tcl_Obj *objPtr; + WCHAR *wstr; + Tcl_DString ds; - if ((objc != 3) && (objc != 5)) { - Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?"); - return TCL_ERROR; - } - - if (objc > 3) { - str = Tcl_GetStringFromObj(objv[3], &len); - if ((len < 2) || (*str != '-') - || strncmp(str, "-timeout", (size_t) len)) { - Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?"); - return TCL_ERROR; + if (objc == 3) { + str = Tcl_GetString(objv[1]); + len = objv[1]->length; + if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", len)) { + return TCL_BREAK; } - if (Tcl_GetIntFromObj(interp, objv[4], (int *) &timeout) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[2], &timeout) != TCL_OK) { return TCL_ERROR; } } - str = Tcl_GetStringFromObj(objv[2], &len); - if (len == 0) { - str = NULL; + str = Tcl_GetString(objv[0]); + len = objv[0]->length; + wstr = (WCHAR *) Tcl_WinUtfToTChar(str, len, &ds); + if (Tcl_DStringLength(&ds) == 0) { + wstr = NULL; } /* @@ -1425,11 +1415,12 @@ BroadcastValue( */ result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, - (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult); + (WPARAM) 0, (LPARAM) wstr, SMTO_ABORTIFHUNG, (UINT) timeout, &sendResult); + Tcl_DStringFree(&ds); objPtr = Tcl_NewObj(); - Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) result)); - Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) sendResult)); + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) result)); + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) sendResult)); Tcl_SetObjResult(interp, objPtr); return TCL_OK; @@ -1458,8 +1449,8 @@ AppendSystemError( DWORD error) /* Result code from error. */ { int length; - WCHAR *wMsgPtr, **wMsgPtrPtr = &wMsgPtr; - char *msg; + TCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr; + const char *msg; char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE]; Tcl_DString ds; Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); @@ -1467,52 +1458,34 @@ AppendSystemError( if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); } - length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM + length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) wMsgPtrPtr, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (TCHAR *) tMsgPtrPtr, 0, NULL); if (length == 0) { - char *msgPtr; - - length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM - | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr, - 0, NULL); - if (length > 0) { - wMsgPtr = (WCHAR *) LocalAlloc(LPTR, (length + 1) * sizeof(WCHAR)); - MultiByteToWideChar(CP_ACP, 0, msgPtr, length + 1, wMsgPtr, - length + 1); - LocalFree(msgPtr); - } - } - if (length == 0) { - if (error == ERROR_CALL_NOT_IMPLEMENTED) { - msg = "function not supported under Win32s"; - } else { - sprintf(msgBuf, "unknown error: %ld", error); - msg = msgBuf; - } + sprintf(msgBuf, "unknown error: %ld", error); + msg = msgBuf; } else { - Tcl_Encoding encoding; + char *msgPtr; - encoding = Tcl_GetEncoding(NULL, "unicode"); - Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds); - Tcl_FreeEncoding(encoding); - LocalFree(wMsgPtr); + Tcl_WinTCharToUtf(tMsgPtr, -1, &ds); + LocalFree(tMsgPtr); - msg = Tcl_DStringValue(&ds); + msgPtr = Tcl_DStringValue(&ds); length = Tcl_DStringLength(&ds); /* * Trim the trailing CR/LF from the system message. */ - if (msg[length-1] == '\n') { - msg[--length] = 0; + if (msgPtr[length-1] == '\n') { + --length; } - if (msg[length-1] == '\r') { - msg[--length] = 0; + if (msgPtr[length-1] == '\r') { + --length; } + msgPtr[length] = 0; + msg = msgPtr; } sprintf(id, "%ld", error); @@ -1547,14 +1520,15 @@ ConvertDWORD( DWORD type, /* Either REG_DWORD or REG_DWORD_BIG_ENDIAN */ DWORD value) /* The value to be converted. */ { - DWORD order = 1; + const DWORD order = 1; DWORD localType; /* * Check to see if the low bit is in the first byte. */ - localType = (*((char*) &order) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN; + localType = (*((const char *) &order) == 1) + ? REG_DWORD : REG_DWORD_BIG_ENDIAN; return (type != localType) ? (DWORD) SWAPLONG(value) : value; } -- cgit v0.12 From 9654f8c692e08a81dc7e45dd3a5a9e1c8f949596 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 27 Oct 2018 07:53:45 +0000 Subject: tclWinDde.c: Backport version 1.4.1 from Tcl 8.6. --- library/dde/pkgIndex.tcl | 4 +- tests/winDde.test | 290 +++++++++++++---------- win/Makefile.in | 6 +- win/configure | 8 +- win/configure.in | 4 +- win/makefile.bc | 4 +- win/makefile.vc | 4 +- win/tclWinDde.c | 583 +++++++++++++++++++++++++++++++---------------- win/tclWinReg.c | 32 +-- 9 files changed, 580 insertions(+), 355 deletions(-) diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl index 114dee6..065dc83 100644 --- a/library/dde/pkgIndex.tcl +++ b/library/dde/pkgIndex.tcl @@ -1,7 +1,7 @@ if {![package vsatisfies [package provide Tcl] 8]} return if {[info sharedlibextension] != ".dll"} return if {[info exists ::tcl_platform(debug)]} { - package ifneeded dde 1.3.3 [list load [file join $dir tcldde13g.dll] dde] + package ifneeded dde 1.4.1 [list load [file join $dir tcldde14g.dll] dde] } else { - package ifneeded dde 1.3.3 [list load [file join $dir tcldde13.dll] dde] + package ifneeded dde 1.4.1 [list load [file join $dir tcldde14.dll] dde] } diff --git a/tests/winDde.test b/tests/winDde.test index f0ef56c..1fa7e86 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -9,18 +9,19 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { package require tcltest 2 #tcltest::configure -verbose {pass start} namespace import -force ::tcltest::* } +testConstraint debug [::tcl::pkgconfig get debug] testConstraint dde 0 if {[testConstraint win]} { if {![catch { ::tcltest::loadTestedCommands - package require dde - set ::ddelib [lindex [package ifneeded dde 1.3.3] 1]}]} { + set ::ddever [package require dde 1.4.1] + set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} { testConstraint dde 1 } } @@ -32,7 +33,7 @@ if {[testConstraint win]} { set scriptName [makeFile {} script1.tcl] -proc createChildProcess {ddeServerName {handler {}}} { +proc createChildProcess {ddeServerName args} { file delete -force $::scriptName set f [open $::scriptName w+] @@ -41,11 +42,11 @@ proc createChildProcess {ddeServerName {handler {}}} { puts $f { # DDE child server - # - if {[lsearch [namespace children] ::tcltest] == -1} { + if {"::tcltest" ni [namespace children]} { package require tcltest namespace import -force ::tcltest::* } - + # If an error occurs during the tests, this process may end up not # being closed down. To deal with this we create a 30s timeout. proc ::DoTimeout {} { @@ -55,16 +56,19 @@ proc createChildProcess {ddeServerName {handler {}}} { flush stdout } set timeout [after 30000 ::DoTimeout] - + # Define a restricted handler. proc Handler1 {cmd} { if {$cmd eq "stop"} {set ::done 1} - puts $cmd ; flush stdout + if {$cmd == ""} { + set cmd "null data" + } + puts $cmd ; flush stdout return } proc Handler2 {cmd} { if {$cmd eq "stop"} {set ::done 1} - puts [uplevel \#0 $cmd] ; flush stdout + puts [uplevel \#0 $cmd] ; flush stdout return } proc Handler3 {prefix cmd} { @@ -74,11 +78,7 @@ proc createChildProcess {ddeServerName {handler {}}} { } } # set the dde server name to the supplied argument. - if {$handler == {}} { - puts $f [list dde servername $ddeServerName] - } else { - puts $f [list dde servername -handler $handler -- $ddeServerName] - } + puts $f [list dde servername {*}$args -- $ddeServerName] puts $f { # run the server and handle final cleanup. after 200;# give dde a chance to get going. @@ -88,12 +88,12 @@ proc createChildProcess {ddeServerName {handler {}}} { # allow enough time for the calling process to # claim all results, to avoid spurious "server did # not respond" - after 200 { set reallyDone 1 } + after 200 {set reallyDone 1} vwait reallyDone exit } close $f - + # run the child server script. set f [open |[list [interpreter] $::scriptName] r] fconfigure $f -buffering line @@ -102,147 +102,184 @@ proc createChildProcess {ddeServerName {handler {}}} { } # ------------------------------------------------------------------------- +test winDde-1.0 {check if we are testing the right dll} {win dde} { + set ::ddever +} {1.4.1} -test winDde-1.1 {Settings the server's topic name} {win dde} { +test winDde-1.1 {Settings the server's topic name} -constraints dde -body { list [dde servername foobar] [dde servername] [dde servername self] -} {foobar foobar self} +} -result {foobar foobar self} -test winDde-2.1 {Checking for other services} {win dde} { +test winDde-2.1 {Checking for other services} -constraints dde -body { expr [llength [dde services {} {}]] >= 0 -} 1 +} -result 1 test winDde-2.2 {Checking for existence, with service and topic specified} \ - {win dde} { + -constraints dde -body { llength [dde services TclEval self] -} 1 +} -result 1 test winDde-2.3 {Checking for existence, with only the service specified} \ - {win dde} { + -constraints dde -body { expr [llength [dde services TclEval {}]] >= 1 -} 1 +} -result 1 test winDde-2.4 {Checking for existence, with only the topic specified} \ - {win dde} { + -constraints dde -body { expr [llength [dde services {} self]] >= 1 -} 1 +} -result 1 # ------------------------------------------------------------------------- -test winDde-3.1 {DDE execute locally} {win dde} { - set a "" - dde execute TclEval self {set a "foo"} - set a -} foo -test winDde-3.2 {DDE execute -async locally} {win dde} { - set a "" - dde execute -async TclEval self {set a "foo"} +test winDde-3.1 {DDE execute locally} -constraints dde -body { + set \xe1 "" + dde execute TclEval self [list set \xe1 foo] + set \xe1 +} -result foo +test winDde-3.2 {DDE execute -async locally} -constraints dde -body { + set \xe1 "" + dde execute -async TclEval self [list set \xe1 foo] update - set a -} foo -test winDde-3.3 {DDE request locally} {win dde} { - set a "" - dde execute TclEval self {set a "foo"} - dde request TclEval self a -} foo -test winDde-3.4 {DDE eval locally} {win dde} { - set a "" - dde eval self set a "foo" -} foo -test winDde-3.5 {DDE request locally} {win dde} { - set a "" - dde execute TclEval self {set a "foo"} - dde request -binary TclEval self a -} "foo\x00" + set \xe1 +} -result foo +test winDde-3.3 {DDE request locally} -constraints dde -body { + set \xe1 "" + dde execute TclEval self [list set \xe1 foo] + dde request TclEval self \xe1 +} -result foo +test winDde-3.4 {DDE eval locally} -constraints dde -body { + set \xe1 "" + dde eval self set \xe1 foo +} -result foo +test winDde-3.5 {DDE request locally} -constraints dde -body { + set \xe1 "" + dde execute TclEval self [list set \xe1 foo] + dde request -binary TclEval self \xe1 +} -result "foo\x00" +# Set variable a to A with diaeresis (unicode C4) by relying on the fact +# that utf8 is sent (e.g. "c3 84" on the wire) +test winDde-3.6 {DDE request utf8} -constraints dde -body { + set \xe1 "not set" + dde execute TclEval self "set \xe1 \xc4" + scan [set \xe1] %c +} -result 196 +# Set variable a to A with diaeresis (unicode C4) using binary execute +# and compose utf-8 (e.g. "c3 84" ) manualy +test winDde-3.7 {DDE request binary} -constraints dde -body { + set \xe1 "not set" + dde execute -binary TclEval self [list set \xc3\xa1 \xc3\x84\x00] + scan [set \xe1] %c +} -result 196 +test winDde-3.8 {DDE poke locally} -constraints {dde debug} -body { + set \xe1 "" + dde poke TclEval self \xe1 \xc4 + dde request TclEval self \xe1 +} -result \xc4 +test winDde-3.9 {DDE poke -binary locally} -constraints {dde debug} -body { + set \xe1 "" + dde poke -binary TclEval self \xe1 \xc3\x84\x00 + dde request TclEval self \xe1 +} -result \xc4 # ------------------------------------------------------------------------- -test winDde-4.1 {DDE execute remotely} {stdio win dde} { - set a "" - set name child-4.1 +test winDde-4.1 {DDE execute remotely} -constraints {dde stdio} -body { + set \xe1 "" + set name ch\xEDld-4.1 set child [createChildProcess $name] - dde execute TclEval $name {set a "foo"} + dde execute TclEval $name [list set \xe1 foo] dde execute TclEval $name {set done 1} update - set a -} "" -test winDde-4.2 {DDE execute async remotely} {stdio win dde} { - set a "" - set name child-4.2 + set \xe1 +} -result "" +test winDde-4.2 {DDE execute async remotely} -constraints {dde stdio} -body { + set \xe1 "" + set name ch\xEDld-4.2 set child [createChildProcess $name] - dde execute -async TclEval $name {set a "foo"} + dde execute -async TclEval $name [list set \xe1 foo] update dde execute TclEval $name {set done 1} update - set a -} "" -test winDde-4.3 {DDE request remotely} {stdio win dde} { - set a "" - set name chile-4.3 + set \xe1 +} -result "" +test winDde-4.3 {DDE request remotely} -constraints {dde stdio} -body { + set \xe1 "" + set name ch\xEDld-4.3 + set child [createChildProcess $name] + dde execute TclEval $name [list set \xe1 foo] + set \xe1 [dde request TclEval $name \xe1] + dde execute TclEval $name {set done 1} + update + set \xe1 +} -result foo +test winDde-4.4 {DDE eval remotely} -constraints {dde stdio} -body { + set \xe1 "" + set name ch\xEDld-4.4 set child [createChildProcess $name] - dde execute TclEval $name {set a "foo"} - set a [dde request TclEval $name a] + set \xe1 [dde eval $name set \xe1 foo] dde execute TclEval $name {set done 1} update - set a -} foo -test winDde-4.4 {DDE eval remotely} {stdio win dde} { - set a "" - set name child-4.4 + set \xe1 +} -result foo +test winDde-4.5 {DDE poke remotely} -constraints {dde debug stdio} -body { + set \xe1 "" + set name ch\xEDld-4.5 set child [createChildProcess $name] - set a [dde eval $name set a "foo"] + dde poke TclEval $name \xe1 foo + set \xe1 [dde request TclEval $name \xe1] dde execute TclEval $name {set done 1} update - set a -} foo + set \xe1 +} -result foo # ------------------------------------------------------------------------- -test winDde-5.1 {check for bad arguments} -constraints {win dde} -body { +test winDde-5.1 {check for bad arguments} -constraints dde -body { dde execute "" "" "" "" -} -returnCodes error -result {wrong # args: should be "dde execute ?-async? serviceName topicName value"} -test winDde-5.2 {check for bad arguments} -constraints {win dde} -body { - dde execute "" "" "" +} -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"} +test winDde-5.2 {check for bad arguments} -constraints dde -body { + dde execute -binary "" "" "" } -returnCodes error -result {cannot execute null data} -test winDde-5.3 {check for bad arguments} -constraints {win dde} -body { +test winDde-5.3 {check for bad arguments} -constraints dde -body { dde execute -foo "" "" "" -} -returnCodes error -result {wrong # args: should be "dde execute ?-async? serviceName topicName value"} -test winDde-5.4 {DDE eval bad arguments} -constraints {win dde} -body { +} -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"} +test winDde-5.4 {DDE eval bad arguments} -constraints dde -body { dde eval "" "foo" } -returnCodes error -result {invalid service name ""} # ------------------------------------------------------------------------- -test winDde-6.1 {DDE servername bad arguments} -constraints {win dde} -body { +test winDde-6.1 {DDE servername bad arguments} -constraints dde -body { dde servername -z -z -z } -returnCodes error -result {bad option "-z": must be -force, -handler, or --} -test winDde-6.2 {DDE servername set name} -constraints {win dde} -body { +test winDde-6.2 {DDE servername set name} -constraints dde -body { dde servername -- winDde-6.2 } -result {winDde-6.2} -test winDde-6.3 {DDE servername set exact name} -constraints {win dde} -body { +test winDde-6.3 {DDE servername set exact name} -constraints dde -body { dde servername -force winDde-6.3 } -result {winDde-6.3} -test winDde-6.4 {DDE servername set exact name} -constraints {win dde} -body { +test winDde-6.4 {DDE servername set exact name} -constraints dde -body { dde servername -force -- winDde-6.4 } -result {winDde-6.4} -test winDde-6.5 {DDE remote servername collision} -constraints {stdio win dde} -setup { - set name child-6.5 +test winDde-6.5 {DDE remote servername collision} -constraints {dde stdio} -setup { + set name ch\xEDld-6.5 set child [createChildProcess $name] } -body { dde servername -- $name } -cleanup { dde execute TclEval $name {set done 1} update -} -result "child-6.5 #2" -test winDde-6.6 {DDE remote servername collision force} -constraints {stdio win dde} -setup { - set name child-6.6 +} -result "ch\xEDld-6.5 #2" +test winDde-6.6 {DDE remote servername collision force} -constraints {dde stdio} -setup { + set name ch\xEDld-6.6 set child [createChildProcess $name] } -body { dde servername -force -- $name } -cleanup { dde execute TclEval $name {set done 1} update -} -result {child-6.6} +} -result "ch\xEDld-6.6" # ------------------------------------------------------------------------- -test winDde-7.1 {Load DDE in slave interpreter } -constraints {win dde} -setup { +test winDde-7.1 {Load DDE in slave interpreter} -constraints dde -setup { interp create slave } -body { slave eval [list load $::ddelib Dde] @@ -250,7 +287,7 @@ test winDde-7.1 {Load DDE in slave interpreter } -constraints {win dde} -setup { } -cleanup { interp delete slave } -result {dde-interp-7.1} -test winDde-7.2 {DDE slave cleanup} -constraints {win dde} -setup { +test winDde-7.2 {DDE slave cleanup} -constraints dde -setup { interp create slave slave eval [list load $::ddelib Dde] slave eval [list dde servername -- dde-interp-7.5] @@ -259,11 +296,11 @@ test winDde-7.2 {DDE slave cleanup} -constraints {win dde} -setup { dde services TclEval {} set s [dde services TclEval {}] set m [list [list TclEval dde-interp-7.5]] - if {[lsearch -exact $s $m] != -1} { + if {$m in $s} { set s } } -result {} -test winDde-7.3 {DDE present in slave interp} -constraints {win dde} -setup { +test winDde-7.3 {DDE present in slave interp} -constraints dde -setup { interp create slave slave eval [list load $::ddelib Dde] slave eval [list dde servername -- dde-interp-7.3] @@ -272,7 +309,7 @@ test winDde-7.3 {DDE present in slave interp} -constraints {win dde} -setup { } -cleanup { interp delete slave } -result {{TclEval dde-interp-7.3}} -test winDde-7.4 {interp name collision with -force} -constraints {win dde} -setup { +test winDde-7.4 {interp name collision with -force} -constraints dde -setup { interp create slave slave eval [list load $::ddelib Dde] slave eval [list dde servername -- dde-interp-7.4] @@ -281,7 +318,7 @@ test winDde-7.4 {interp name collision with -force} -constraints {win dde} -setu } -cleanup { interp delete slave } -result {dde-interp-7.4} -test winDde-7.5 {interp name collision without -force} -constraints {win dde} -setup { +test winDde-7.5 {interp name collision without -force} -constraints dde -setup { interp create slave slave eval [list load $::ddelib Dde] slave eval [list dde servername -- dde-interp-7.5] @@ -293,7 +330,7 @@ test winDde-7.5 {interp name collision without -force} -constraints {win dde} -s # ------------------------------------------------------------------------- -test winDde-8.1 {Safe DDE load} -constraints {win dde} -setup { +test winDde-8.1 {Safe DDE load} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde } -body { @@ -301,20 +338,20 @@ test winDde-8.1 {Safe DDE load} -constraints {win dde} -setup { } -cleanup { interp delete slave } -returnCodes error -result {invalid command name "dde"} -test winDde-8.2 {Safe DDE set servername} -constraints {win dde} -setup { +test winDde-8.2 {Safe DDE set servername} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde } -body { slave invokehidden dde servername slave } -cleanup {interp delete slave} -result {slave} -test winDde-8.3 {Safe DDE check handler required for eval} -constraints {win dde} -setup { +test winDde-8.3 {Safe DDE check handler required for eval} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde slave invokehidden dde servername slave } -body { catch {dde eval slave set a 1} msg } -cleanup {interp delete slave} -result {1} -test winDde-8.4 {Safe DDE check that execute is denied} -constraints {win dde} -setup { +test winDde-8.4 {Safe DDE check that execute is denied} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde slave invokehidden dde servername slave @@ -323,7 +360,7 @@ test winDde-8.4 {Safe DDE check that execute is denied} -constraints {win dde} - dde execute TclEval slave {set a 2} slave eval set a } -cleanup {interp delete slave} -result 1 -test winDde-8.5 {Safe DDE check that request is denied} -constraints {win dde} -setup { +test winDde-8.5 {Safe DDE check that request is denied} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde slave invokehidden dde servername slave @@ -333,14 +370,14 @@ test winDde-8.5 {Safe DDE check that request is denied} -constraints {win dde} - } -cleanup { interp delete slave } -returnCodes error -result {remote server cannot handle this command} -test winDde-8.6 {Safe DDE assign handler procedure} -constraints {win dde} -setup { +test winDde-8.6 {Safe DDE assign handler procedure} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}} } -body { slave invokehidden dde servername -handler DDEACCEPT slave } -cleanup {interp delete slave} -result slave -test winDde-8.7 {Safe DDE check simple command} -constraints {win dde} -setup { +test winDde-8.7 {Safe DDE check simple command} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}} @@ -348,7 +385,7 @@ test winDde-8.7 {Safe DDE check simple command} -constraints {win dde} -setup { } -body { dde eval slave set x 1 } -cleanup {interp delete slave} -result {set x 1} -test winDde-8.8 {Safe DDE check non-list command} -constraints {win dde} -setup { +test winDde-8.8 {Safe DDE check non-list command} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}} @@ -358,16 +395,16 @@ test winDde-8.8 {Safe DDE check non-list command} -constraints {win dde} -setup dde eval slave $s string equal [slave eval set DDECMD] $s } -cleanup {interp delete slave} -result 1 -test winDde-8.9 {Safe DDE check command evaluation} -constraints {win dde} -setup { +test winDde-8.9 {Safe DDE check command evaluation} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}} slave invokehidden dde servername -handler DDEACCEPT slave } -body { - dde eval slave set x 1 - slave eval set x + dde eval slave set \xe1 1 + slave eval set \xe1 } -cleanup {interp delete slave} -result 1 -test winDde-8.10 {Safe DDE check command evaluation (2)} -constraints {win dde} -setup { +test winDde-8.10 {Safe DDE check command evaluation (2)} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}} @@ -376,7 +413,7 @@ test winDde-8.10 {Safe DDE check command evaluation (2)} -constraints {win dde} dde eval slave [list set x 1] slave eval set x } -cleanup {interp delete slave} -result 1 -test winDde-8.11 {Safe DDE check command evaluation (3)} -constraints {win dde} -setup { +test winDde-8.11 {Safe DDE check command evaluation (3)} -constraints dde -setup { interp create -safe slave slave invokehidden load $::ddelib Dde slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}} @@ -388,9 +425,9 @@ test winDde-8.11 {Safe DDE check command evaluation (3)} -constraints {win dde} # ------------------------------------------------------------------------- -test winDde-9.1 {External safe DDE check string passing} -constraints {win dde stdio} -setup { - set name child-9.1 - set child [createChildProcess $name Handler1] +test winDde-9.1 {External safe DDE check string passing} -constraints {dde stdio} -setup { + set name ch\xEDld-9.1 + set child [createChildProcess $name -handler Handler1] file copy -force script1.tcl dde-script.tcl } -body { dde eval $name set x 1 @@ -401,9 +438,9 @@ test winDde-9.1 {External safe DDE check string passing} -constraints {win dde s update file delete -force -- dde-script.tcl } -result {set x 1} -test winDde-9.2 {External safe DDE check command evaluation} -constraints {win dde stdio} -setup { - set name child-9.2 - set child [createChildProcess $name Handler2] +test winDde-9.2 {External safe DDE check command evaluation} -constraints {dde stdio} -setup { + set name ch\xEDld-9.2 + set child [createChildProcess $name -handler Handler2] file copy -force script1.tcl dde-script.tcl } -body { dde eval $name set x 1 @@ -414,9 +451,9 @@ test winDde-9.2 {External safe DDE check command evaluation} -constraints {win d update file delete -force -- dde-script.tcl } -result 1 -test winDde-9.3 {External safe DDE check prefixed arguments} -constraints {win dde stdio} -setup { - set name child-9.3 - set child [createChildProcess $name [list Handler3 ARG]] +test winDde-9.3 {External safe DDE check prefixed arguments} -constraints {dde stdio} -setup { + set name ch\xEDld-9.3 + set child [createChildProcess $name -handler [list Handler3 ARG]] file copy -force script1.tcl dde-script.tcl } -body { dde eval $name set x 1 @@ -427,6 +464,19 @@ test winDde-9.3 {External safe DDE check prefixed arguments} -constraints {win d update file delete -force -- dde-script.tcl } -result {ARG {set x 1}} +test winDde-9.4 {External safe DDE check null data passing} -constraints {dde stdio} -setup { + set name ch\xEDld-9.4 + set child [createChildProcess $name -handler Handler1] + file copy -force script1.tcl dde-script.tcl +} -body { + dde execute TclEval $name "" + gets $child line + set line +} -cleanup { + dde execute TclEval $name stop + update + file delete -force -- dde-script.tcl +} -result {null data} # ------------------------------------------------------------------------- diff --git a/win/Makefile.in b/win/Makefile.in index 6d1ce95..7fc415d 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -498,7 +498,7 @@ tclWinReg.${OBJEXT} : tclWinReg.c $(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME) tclWinDde.${OBJEXT} : tclWinDde.c - $(CC) -c $(CC_SWITCHES) -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME) + $(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE -DUSE_TCL_STUBS @DEPARG@ $(CC_OBJNAME) # TIP #59, embedding of configuration information into the binary library. # @@ -709,13 +709,13 @@ install-private-headers: libraries test: binaries $(TCLTEST) TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ - -load "package ifneeded dde 1.3.3 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ + -load "package ifneeded dde 1.4.1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32) # Useful target to launch a built tcltest with the proper path,... runtest: binaries $(TCLTEST) @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - ./$(TCLTEST) $(TESTFLAGS) -load "package ifneeded dde 1.3.3 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ + ./$(TCLTEST) $(TESTFLAGS) -load "package ifneeded dde 1.4.1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT) # This target can be used to run tclsh from the build directory via diff --git a/win/configure b/win/configure index 3fe89bf..3a77f00 100755 --- a/win/configure +++ b/win/configure @@ -1314,14 +1314,14 @@ TCL_MINOR_VERSION=5 TCL_PATCH_LEVEL=".19" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION -TCL_DDE_VERSION=1.3 +TCL_DDE_VERSION=1.4 TCL_DDE_MAJOR_VERSION=1 -TCL_DDE_MINOR_VERSION=3 +TCL_DDE_MINOR_VERSION=4 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION -TCL_REG_VERSION=1.2 +TCL_REG_VERSION=1.3 TCL_REG_MAJOR_VERSION=1 -TCL_REG_MINOR_VERSION=2 +TCL_REG_MINOR_VERSION=3 REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION #------------------------------------------------------------------------ diff --git a/win/configure.in b/win/configure.in index fa75e5b..12c81ed 100644 --- a/win/configure.in +++ b/win/configure.in @@ -17,9 +17,9 @@ TCL_MINOR_VERSION=5 TCL_PATCH_LEVEL=".19" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION -TCL_DDE_VERSION=1.3 +TCL_DDE_VERSION=1.4 TCL_DDE_MAJOR_VERSION=1 -TCL_DDE_MINOR_VERSION=3 +TCL_DDE_MINOR_VERSION=4 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION TCL_REG_VERSION=1.3 diff --git a/win/makefile.bc b/win/makefile.bc index 20d89bc..577c865 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -127,8 +127,8 @@ STUBPREFIX = $(NAMEPREFIX)stub DOTVERSION = 8.5 VERSION = 85 -DDEVERSION = 13 -DDEDOTVERSION = 1.3 +DDEVERSION = 14 +DDEDOTVERSION = 1.4 REGVERSION = 13 REGDOTVERSION = 1.3 diff --git a/win/makefile.vc b/win/makefile.vc index c330fcd..62a4d67 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -538,13 +538,13 @@ test-core: setup $(TCLTEST) dlls $(CAT32) set TCL_LIBRARY=$(ROOT:\=/)/library !if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE" $(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << - package ifneeded dde 1.3.3 [list load "$(TCLDDELIB:\=/)" dde] + package ifneeded dde 1.4.1 [list load "$(TCLDDELIB:\=/)" dde] package ifneeded registry 1.3.3 [list load "$(TCLREGLIB:\=/)" registry] << !else @echo Please wait while the tests are collected... $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log - package ifneeded dde 1.3.3 "$(TCLDDELIB:\=/)" dde] + package ifneeded dde 1.4.1 "$(TCLDDELIB:\=/)" dde] package ifneeded registry 1.3.3 "$(TCLREGLIB:\=/)" registry] << type tests.log | more diff --git a/win/tclWinDde.c b/win/tclWinDde.c index eef5caa..38f1d88 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -10,20 +10,20 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#undef STATIC_BUILD +#ifndef USE_TCL_STUBS +# define USE_TCL_STUBS +#endif #include "tclInt.h" -#include "tclPort.h" #include #include +#include -/* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init - * declaration is in the source file itself, which is only accessed when we - * are building a library. DO NOT MOVE BEFORE ANY #include LINES. ONLY USE - * EXTERN TO INDICATE EXPORTED FUNCTIONS FROM NOW ON. - */ - -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT +#if !defined(NDEBUG) + /* test POKE server Implemented for debug mode only */ +# undef CBF_FAIL_POKES +# define CBF_FAIL_POKES 0 +#endif /* * The following structure is used to keep track of the interpreters @@ -34,7 +34,7 @@ typedef struct RegisteredInterp { struct RegisteredInterp *nextPtr; /* The next interp this application knows * about. */ - char *name; /* Interpreter's name (malloc-ed). */ + TCHAR *name; /* Interpreter's name (malloc-ed). */ Tcl_Obj *handlerPtr; /* The server handler command */ Tcl_Interp *interp; /* The interpreter attached to this name. */ } RegisteredInterp; @@ -51,7 +51,7 @@ typedef struct Conversation { Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */ } Conversation; -typedef struct DdeEnumServices { +typedef struct { Tcl_Interp *interp; int result; ATOM service; @@ -59,7 +59,7 @@ typedef struct DdeEnumServices { HWND hwnd; } DdeEnumServices; -typedef struct ThreadSpecificData { +typedef struct { Conversation *currentConversations; /* A list of conversations currently being * processed. */ @@ -79,9 +79,10 @@ static DWORD ddeInstance; /* The application instance handle given to us * by DdeInitialize. */ static int ddeIsServer = 0; +#define TCL_DDE_VERSION "1.4.1" #define TCL_DDE_PACKAGE_NAME "dde" -#define TCL_DDE_SERVICE_NAME "TclEval" -#define TCL_DDE_EXECUTE_RESULT "$TCLEVAL$EXECUTE$RESULT" +#define TCL_DDE_SERVICE_NAME TEXT("TclEval") +#define TCL_DDE_EXECUTE_RESULT TEXT("$TCLEVAL$EXECUTE$RESULT") #define DDE_FLAG_ASYNC 1 #define DDE_FLAG_BINARY 2 @@ -95,12 +96,12 @@ TCL_DECLARE_MUTEX(ddeMutex) static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam); -static int DdeCreateClient(struct DdeEnumServices *es); +static int DdeCreateClient(DdeEnumServices *es); static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam); static void DdeExitProc(ClientData clientData); static int DdeGetServicesList(Tcl_Interp *interp, - const char *serviceName, const char *topicName); + const TCHAR *serviceName, const TCHAR *topicName); static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData, DWORD dwData1, DWORD dwData2); @@ -110,14 +111,15 @@ static void DeleteProc(ClientData clientData); static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr, Tcl_Obj *ddeObjectPtr); static int MakeDdeConnection(Tcl_Interp *interp, - const char *name, HCONV *ddeConvPtr); + const TCHAR *name, HCONV *ddeConvPtr); static void SetDdeError(Tcl_Interp *interp); static int DdeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -EXTERN int Dde_Init(Tcl_Interp *interp); -EXTERN int Dde_SafeInit(Tcl_Interp *interp); + +DLLEXPORT int Dde_Init(Tcl_Interp *interp); +DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp); /* *---------------------------------------------------------------------- @@ -145,7 +147,7 @@ Dde_Init( Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL); Tcl_CreateExitHandler(DdeExitProc, NULL); - return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, "1.3.3"); + return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION); } /* @@ -229,7 +231,7 @@ Initialize(void) ddeIsServer = 1; Tcl_CreateExitHandler(DdeExitProc, NULL); ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, - TCL_DDE_SERVICE_NAME, 0); + TCL_DDE_SERVICE_NAME, CP_WINUNICODE); DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER); } else { ddeIsServer = 0; @@ -263,10 +265,10 @@ Initialize(void) *---------------------------------------------------------------------- */ -static const char * +static const TCHAR * DdeSetServerName( Tcl_Interp *interp, - const char *name, /* The name that will be used to refer to the + const TCHAR *name, /* The name that will be used to refer to the * interpreter in later "send" commands. Must * be globally unique. */ int flags, /* DDE_FLAG_FORCE or 0 */ @@ -276,7 +278,7 @@ DdeSetServerName( int suffix, offset; RegisteredInterp *riPtr, *prevPtr; Tcl_DString dString; - const char *actualName; + const TCHAR *actualName; Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL; int n, srvCount = 0, lastSuffix, r = TCL_OK; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -314,7 +316,7 @@ DdeSetServerName( * current interp, but it doesn't have a name. */ - return ""; + return TEXT(""); } /* @@ -335,7 +337,9 @@ DdeSetServerName( &srvPtrPtr); } if (r != TCL_OK) { - OutputDebugString(Tcl_GetStringResult(interp)); + Tcl_WinUtfToTChar(Tcl_GetStringResult(interp), -1, &dString); + OutputDebugString((TCHAR *) Tcl_DStringValue(&dString)); + Tcl_DStringFree(&dString); return NULL; } @@ -352,13 +356,14 @@ DdeSetServerName( lastSuffix = suffix; if (suffix > 1) { if (suffix == 2) { - Tcl_DStringAppend(&dString, name, -1); - Tcl_DStringAppend(&dString, " #", 2); + Tcl_DStringAppend(&dString, (char *)name, _tcslen(name) * sizeof(TCHAR)); + Tcl_DStringAppend(&dString, (char *)TEXT(" #"), 2 * sizeof(TCHAR)); offset = Tcl_DStringLength(&dString); - Tcl_DStringSetLength(&dString, offset + TCL_INTEGER_SPACE); - actualName = Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, offset + sizeof(TCHAR) * TCL_INTEGER_SPACE); + actualName = (TCHAR *) Tcl_DStringValue(&dString); } - sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix); + _sntprintf((TCHAR *) (Tcl_DStringValue(&dString) + offset), + TCL_INTEGER_SPACE, TEXT("%d"), suffix); } /* @@ -367,39 +372,41 @@ DdeSetServerName( for (n = 0; n < srvCount; ++n) { Tcl_Obj* namePtr; + Tcl_DString ds; Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); - if (strcmp(actualName, Tcl_GetString(namePtr)) == 0) { + Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds); + if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) { suffix++; + Tcl_DStringFree(&ds); break; } + Tcl_DStringFree(&ds); } } - Tcl_DStringSetLength(&dString, - offset + (int)strlen(Tcl_DStringValue(&dString)+offset)); } /* * We have found a unique name. Now add it to the registry. */ - riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp)); + riPtr = (RegisteredInterp *) Tcl_Alloc(sizeof(RegisteredInterp)); riPtr->interp = interp; - riPtr->name = ckalloc((unsigned int) strlen(actualName) + 1); + riPtr->name = (TCHAR *) Tcl_Alloc((_tcslen(actualName) + 1) * sizeof(TCHAR)); riPtr->nextPtr = tsdPtr->interpListPtr; riPtr->handlerPtr = handlerPtr; if (riPtr->handlerPtr != NULL) { Tcl_IncrRefCount(riPtr->handlerPtr); } tsdPtr->interpListPtr = riPtr; - strcpy(riPtr->name, actualName); + _tcscpy(riPtr->name, actualName); if (Tcl_IsSafe(interp)) { Tcl_ExposeCommand(interp, "dde", "dde"); } Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, - (ClientData) riPtr, DeleteProc); + riPtr, DeleteProc); if (Tcl_IsSafe(interp)) { Tcl_HideCommand(interp, "dde", "dde"); } @@ -486,7 +493,7 @@ DeleteProc( prevPtr->nextPtr = searchPtr->nextPtr; } } - ckfree(riPtr->name); + Tcl_Free((char *) riPtr->name); if (riPtr->handlerPtr) { Tcl_DecrRefCount(riPtr->handlerPtr); } @@ -524,10 +531,11 @@ ExecuteRemoteObject( Tcl_Obj *returnPackagePtr; int result = TCL_OK; - if (riPtr->handlerPtr == NULL && Tcl_IsSafe(riPtr->interp)) { + if ((riPtr->handlerPtr == NULL) && Tcl_IsSafe(riPtr->interp)) { Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: " "a handler procedure must be defined for use in a safe " "interp", -1)); + Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", NULL); result = TCL_ERROR; } @@ -605,9 +613,9 @@ DdeServerProc( /* Transaction-dependent data. */ { Tcl_DString dString; - int len; + size_t len; DWORD dlen; - char *utilString; + TCHAR *utilString; Tcl_Obj *ddeObjectPtr; HDDEDATA ddeReturn = NULL; RegisteredInterp *riPtr; @@ -621,16 +629,16 @@ DdeServerProc( * sure we have a valid topic. */ - len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); + len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, len); - utilString = Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); + utilString = (TCHAR *) Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, - CP_WINANSI); + CP_WINUNICODE); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (stricmp(utilString, riPtr->name) == 0) { + if (_tcsicmp(utilString, riPtr->name) == 0) { Tcl_DStringFree(&dString); return (HDDEDATA) TRUE; } @@ -646,16 +654,16 @@ DdeServerProc( * result to return in an XTYP_REQUEST. */ - len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); + len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, len); - utilString = Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); + utilString = (TCHAR *) Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, - CP_WINANSI); + CP_WINUNICODE); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (stricmp(riPtr->name, utilString) == 0) { - convPtr = (Conversation *) ckalloc(sizeof(Conversation)); + if (_tcsicmp(riPtr->name, utilString) == 0) { + convPtr = (Conversation *) Tcl_Alloc(sizeof(Conversation)); convPtr->nextPtr = tsdPtr->currentConversations; convPtr->returnPackagePtr = NULL; convPtr->hConv = hConv; @@ -685,7 +693,7 @@ DdeServerProc( if (convPtr->returnPackagePtr != NULL) { Tcl_DecrRefCount(convPtr->returnPackagePtr); } - ckfree((char *) convPtr); + Tcl_Free((char *) convPtr); break; } } @@ -711,22 +719,24 @@ DdeServerProc( } if (convPtr != NULL) { + Tcl_DString dsBuf; char *returnString; - len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINANSI); + len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, len); - utilString = Tcl_DStringValue(&dString); + Tcl_DStringInit(&dsBuf); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); + utilString = (TCHAR *) Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, - CP_WINANSI); - if (stricmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { - if (uFmt == CF_TEXT) { - returnString = - Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); - } else { - returnString = (char *) - Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len); - len = 2 * len + 1; + CP_WINUNICODE); + if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { + returnString = + Tcl_GetString(convPtr->returnPackagePtr); + len = convPtr->returnPackagePtr->length; + if (uFmt != CF_TEXT) { + Tcl_WinUtfToTChar(returnString, len, &dsBuf); + returnString = Tcl_DStringValue(&dsBuf); + len = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR) - 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0); @@ -734,17 +744,20 @@ DdeServerProc( if (Tcl_IsSafe(convPtr->riPtr->interp)) { ddeReturn = NULL; } else { - Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex( - convPtr->riPtr->interp, utilString, NULL, + Tcl_DString ds; + Tcl_Obj *variableObjPtr; + + Tcl_WinTCharToUtf(utilString, -1, &ds); + variableObjPtr = Tcl_GetVar2Ex( + convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, TCL_GLOBAL_ONLY); if (variableObjPtr != NULL) { - if (uFmt == CF_TEXT) { - returnString = Tcl_GetStringFromObj( - variableObjPtr, &len); - } else { - returnString = (char *) Tcl_GetUnicodeFromObj( - variableObjPtr, &len); - len = 2 * len + 1; + returnString = Tcl_GetString(variableObjPtr); + len = variableObjPtr->length; + if (uFmt != CF_TEXT) { + Tcl_WinUtfToTChar(returnString, len, &dsBuf); + returnString = Tcl_DStringValue(&dsBuf); + len = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR) - 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, @@ -752,12 +765,65 @@ DdeServerProc( } else { ddeReturn = NULL; } + Tcl_DStringFree(&ds); } } + Tcl_DStringFree(&dsBuf); + Tcl_DStringFree(&dString); + } + return ddeReturn; + +#if !CBF_FAIL_POKES + case XTYP_POKE: + /* + * This is a poke for a Tcl variable, only implemented in + * debug/UNICODE mode. + */ + ddeReturn = DDE_FNOTPROCESSED; + + if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) { + return ddeReturn; + } + + for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) + && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { + /* + * Empty loop body. + */ + } + + if (convPtr && !Tcl_IsSafe(convPtr->riPtr->interp)) { + Tcl_DString ds, ds2; + Tcl_Obj *variableObjPtr; + DWORD len2; + + Tcl_DStringInit(&dString); + Tcl_DStringInit(&ds2); + len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); + utilString = (TCHAR *) Tcl_DStringValue(&dString); + DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, + CP_WINUNICODE); + Tcl_WinTCharToUtf(utilString, -1, &ds); + utilString = (TCHAR *) DdeAccessData(hData, &len2); + len = len2; + if (uFmt != CF_TEXT) { + Tcl_WinTCharToUtf(utilString, -1, &ds2); + utilString = (TCHAR *) Tcl_DStringValue(&ds2); + } + variableObjPtr = Tcl_NewStringObj((char *)utilString, -1); + + Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, + variableObjPtr, TCL_GLOBAL_ONLY); + + Tcl_DStringFree(&ds2); + Tcl_DStringFree(&ds); Tcl_DStringFree(&dString); + ddeReturn = (HDDEDATA) DDE_FACK; } return ddeReturn; +#endif case XTYP_EXECUTE: { /* * Execute this script. The results will be saved into a list object @@ -765,7 +831,7 @@ DdeServerProc( */ Tcl_Obj *returnPackagePtr; - Tcl_UniChar *uniStr; + char *string; for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { @@ -778,21 +844,25 @@ DdeServerProc( return (HDDEDATA) DDE_FNOTPROCESSED; } - utilString = (char *) DdeAccessData(hData, &dlen); - uniStr = (Tcl_UniChar *) utilString; + utilString = (TCHAR *) DdeAccessData(hData, &dlen); + string = (char *) utilString; if (!dlen) { /* Empty binary array. */ ddeObjectPtr = Tcl_NewObj(); - } else if ((dlen & 1) || uniStr[(dlen>>1)-1]) { + } else if ((dlen & 1) || utilString[(dlen>>1)-1]) { /* Cannot be unicode, so assume utf-8 */ - if (!utilString[dlen-1]) { + if (!string[dlen-1]) { dlen--; } - ddeObjectPtr = Tcl_NewStringObj(utilString, dlen); + ddeObjectPtr = Tcl_NewStringObj(string, dlen); } else { /* unicode */ - dlen >>= 1; - ddeObjectPtr = Tcl_NewUnicodeObj(uniStr, dlen - 1); + Tcl_DString dsBuf; + + Tcl_WinTCharToUtf(utilString, dlen - sizeof(TCHAR), &dsBuf); + ddeObjectPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), + Tcl_DStringLength(&dsBuf)); + Tcl_DStringFree(&dsBuf); } Tcl_IncrRefCount(ddeObjectPtr); DdeUnaccessData(hData); @@ -845,9 +915,9 @@ DdeServerProc( for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems; i++, riPtr = riPtr->nextPtr) { returnPtr[i].hszSvc = DdeCreateStringHandle(ddeInstance, - TCL_DDE_SERVICE_NAME, CP_WINANSI); + TCL_DDE_SERVICE_NAME, CP_WINUNICODE); returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance, - riPtr->name, CP_WINANSI); + riPtr->name, CP_WINUNICODE); } returnPtr[i].hszSvc = NULL; returnPtr[i].hszTopic = NULL; @@ -905,14 +975,14 @@ DdeExitProc( static int MakeDdeConnection( Tcl_Interp *interp, /* Used to report errors. */ - const char *name, /* The connection to use. */ + const TCHAR *name, /* The connection to use. */ HCONV *ddeConvPtr) { HSZ ddeTopic, ddeService; HCONV ddeConv; - ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0); - ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0); + ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); + ddeTopic = DdeCreateStringHandle(ddeInstance, name, CP_WINUNICODE); ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); @@ -920,8 +990,13 @@ MakeDdeConnection( if (ddeConv == (HCONV) NULL) { if (interp != NULL) { - Tcl_AppendResult(interp, "no registered server named \"", - name, "\"", NULL); + Tcl_DString dString; + + Tcl_WinTCharToUtf(name, -1, &dString); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no registered server named \"%s\"", Tcl_DStringValue(&dString))); + Tcl_DStringFree(&dString); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL); } return TCL_ERROR; } @@ -952,17 +1027,17 @@ MakeDdeConnection( static int DdeCreateClient( - struct DdeEnumServices *es) + DdeEnumServices *es) { WNDCLASSEX wc; - static const char *szDdeClientClassName = "TclEval client class"; - static const char *szDdeClientWindowName = "TclEval client window"; + static const TCHAR *szDdeClientClassName = TEXT("TclEval client class"); + static const TCHAR *szDdeClientWindowName = TEXT("TclEval client window"); memset(&wc, 0, sizeof(wc)); wc.cbSize = sizeof(wc); wc.lpfnWndProc = DdeClientWindowProc; wc.lpszClassName = szDdeClientClassName; - wc.cbWndExtra = sizeof(struct DdeEnumServices *); + wc.cbWndExtra = sizeof(DdeEnumServices *); /* * Register and create the callback window. @@ -984,8 +1059,8 @@ DdeClientWindowProc( switch (uMsg) { case WM_CREATE: { LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam; - struct DdeEnumServices *es = - (struct DdeEnumServices *) lpcs->lpCreateParams; + DdeEnumServices *es = + (DdeEnumServices *) lpcs->lpCreateParams; #ifdef _WIN64 SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es); @@ -1010,24 +1085,29 @@ DdeServicesOnAck( HWND hwndRemote = (HWND)wParam; ATOM service = (ATOM)LOWORD(lParam); ATOM topic = (ATOM)HIWORD(lParam); - struct DdeEnumServices *es; - char sz[255]; + DdeEnumServices *es; + TCHAR sz[255]; + Tcl_DString dString; #ifdef _WIN64 - es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA); + es = (DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA); #else - es = (struct DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA); + es = (DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA); #endif - if ((es->service == (ATOM)0 || es->service == service) - && (es->topic == (ATOM)0 || es->topic == topic)) { + if (((es->service == (ATOM)0) || (es->service == service)) + && ((es->topic == (ATOM)0) || (es->topic == topic))) { Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL); Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp); GlobalGetAtomName(service, sz, 255); - Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); + Tcl_WinTCharToUtf(sz, -1, &dString); + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); + Tcl_DStringFree(&dString); GlobalGetAtomName(topic, sz, 255); - Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); + Tcl_WinTCharToUtf(sz, -1, &dString); + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); + Tcl_DStringFree(&dString); /* * Adding the hwnd as a third list element provides a unique @@ -1063,7 +1143,7 @@ DdeEnumWindowsCallback( LPARAM lParam) { DWORD_PTR dwResult = 0; - struct DdeEnumServices *es = (struct DdeEnumServices *) lParam; + DdeEnumServices *es = (DdeEnumServices *) lParam; SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd, MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000, @@ -1074,10 +1154,10 @@ DdeEnumWindowsCallback( static int DdeGetServicesList( Tcl_Interp *interp, - const char *serviceName, - const char *topicName) + const TCHAR *serviceName, + const TCHAR *topicName) { - struct DdeEnumServices es; + DdeEnumServices es; es.interp = interp; es.result = TCL_OK; @@ -1122,25 +1202,30 @@ static void SetDdeError( Tcl_Interp *interp) /* The interp to put the message in. */ { - const char *errorMessage; + const char *errorMessage, *errorCode; switch (DdeGetLastError(ddeInstance)) { case DMLERR_DATAACKTIMEOUT: case DMLERR_EXECACKTIMEOUT: case DMLERR_POKEACKTIMEOUT: errorMessage = "remote interpreter did not respond"; + errorCode = "TIMEOUT"; break; case DMLERR_BUSY: errorMessage = "remote server is busy"; + errorCode = "BUSY"; break; case DMLERR_NOTPROCESSED: errorMessage = "remote server cannot handle this command"; + errorCode = "NOCANDO"; break; default: errorMessage = "dde command failed"; + errorCode = "FAILED"; } Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1)); + Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, NULL); } /* @@ -1167,34 +1252,43 @@ DdeObjCmd( int objc, /* Number of arguments */ Tcl_Obj *const *objv) /* The arguments */ { - static const char *ddeCommands[] = { + static const char *const ddeCommands[] = { "servername", "execute", "poke", "request", "services", "eval", (char *) NULL}; enum DdeSubcommands { DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES, DDE_EVAL }; - static const char *ddeSrvOptions[] = { + static const char *const ddeSrvOptions[] = { "-force", "-handler", "--", NULL }; enum DdeSrvOptions { DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST, }; - static const char *ddeExecOptions[] = { + static const char *const ddeExecOptions[] = { + "-async", "-binary", NULL + }; + enum DdeExecOptions { + DDE_EXEC_ASYNC, DDE_EXEC_BINARY + }; + static const char *const ddeEvalOptions[] = { "-async", NULL }; - static const char *ddeReqOptions[] = { + static const char *const ddeReqOptions[] = { "-binary", NULL }; - int index, i, length, argIndex; + int index, i, argIndex; + int length; int flags = 0, result = TCL_OK, firstArg = 0; HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn; HCONV hConv = NULL; - const char *serviceName = NULL, *topicName = NULL, *string; + const TCHAR *serviceName = NULL, *topicName = NULL; + const char *string; DWORD ddeResult; Tcl_Obj *objPtr, *handlerPtr = NULL; + Tcl_DString serviceBuf, topicBuf, itemBuf; /* * Initialize DDE server/client @@ -1210,6 +1304,9 @@ DdeObjCmd( return TCL_ERROR; } + Tcl_DStringInit(&serviceBuf); + Tcl_DStringInit(&topicBuf); + Tcl_DStringInit(&itemBuf); switch ((enum DdeSubcommands) index) { case DDE_SERVERNAME: for (i = 2; i < objc; i++) { @@ -1259,38 +1356,53 @@ DdeObjCmd( if (objc == 5) { firstArg = 2; break; - } else if (objc == 6) { - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0, - &argIndex) == TCL_OK) { - flags |= DDE_FLAG_ASYNC; - firstArg = 3; - break; + } else if ((objc >= 6) && (objc <= 7)) { + firstArg = objc - 3; + for (i = 2; i < firstArg; i++) { + if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions, + "option", 0, &argIndex) != TCL_OK) { + goto wrongDdeExecuteArgs; + } + if (argIndex == DDE_EXEC_ASYNC) { + flags |= DDE_FLAG_ASYNC; + } else { + flags |= DDE_FLAG_BINARY; + } } + break; } /* otherwise... */ + wrongDdeExecuteArgs: Tcl_WrongNumArgs(interp, 2, objv, - "?-async? serviceName topicName value"); + "?-async? ?-binary? serviceName topicName value"); return TCL_ERROR; case DDE_POKE: - if (objc != 6) { - Tcl_WrongNumArgs(interp, 2, objv, - "serviceName topicName item value"); - return TCL_ERROR; + if (objc == 6) { + firstArg = 2; + break; + } else if ((objc == 7) && (Tcl_GetIndexFromObj(NULL, objv[2], + ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) { + flags |= DDE_FLAG_BINARY; + firstArg = 3; + break; } - firstArg = 2; - break; + + /* + * Otherwise... + */ + + Tcl_WrongNumArgs(interp, 2, objv, + "?-binary? serviceName topicName item value"); + return TCL_ERROR; case DDE_REQUEST: if (objc == 5) { firstArg = 2; break; - } else if (objc == 6) { - int dummy; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0, - &dummy) == TCL_OK) { - flags |= DDE_FLAG_BINARY; - firstArg = 3; - break; - } + } else if ((objc == 6) && (Tcl_GetIndexFromObj(NULL, objv[2], + ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) { + flags |= DDE_FLAG_BINARY; + firstArg = 3; + break; } /* @@ -1314,7 +1426,7 @@ DdeObjCmd( return TCL_ERROR; } else { firstArg = 2; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", + if (Tcl_GetIndexFromObj(NULL, objv[2], ddeEvalOptions, "option", 0, &argIndex) == TCL_OK) { if (objc < 5) { goto wrongDdeEvalArgs; @@ -1329,7 +1441,12 @@ DdeObjCmd( Initialize(); if (firstArg != 1) { - serviceName = Tcl_GetStringFromObj(objv[firstArg], &length); + const char *src = Tcl_GetString(objv[firstArg]); + + length = objv[firstArg]->length; + Tcl_WinUtfToTChar(src, length, &serviceBuf); + serviceName = (TCHAR *) Tcl_DStringValue(&serviceBuf); + length = Tcl_DStringLength(&serviceBuf) / sizeof(TCHAR); } else { length = 0; } @@ -1338,16 +1455,20 @@ DdeObjCmd( serviceName = NULL; } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName, - CP_WINANSI); + CP_WINUNICODE); } if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { - topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length); + const char *src = Tcl_GetString(objv[firstArg + 1]); + + length = objv[firstArg + 1]->length; + topicName = Tcl_WinUtfToTChar(src, length, &topicBuf); + length = Tcl_DStringLength(&topicBuf) / sizeof(TCHAR); if (length == 0) { topicName = NULL; } else { ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) topicName, - CP_WINANSI); + CP_WINUNICODE); } } @@ -1356,7 +1477,12 @@ DdeObjCmd( serviceName = DdeSetServerName(interp, serviceName, flags, handlerPtr); if (serviceName != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1)); + Tcl_DString dsBuf; + + Tcl_WinTCharToUtf(serviceName, -1, &dsBuf); + Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), + Tcl_DStringLength(&dsBuf))); + Tcl_DStringFree(&dsBuf); } else { Tcl_ResetResult(interp); } @@ -1364,12 +1490,28 @@ DdeObjCmd( case DDE_EXECUTE: { int dataLength; - BYTE *dataString = (BYTE *) Tcl_GetStringFromObj( - objv[firstArg + 2], &dataLength); + const void *dataString; + Tcl_DString dsBuf; + + Tcl_DStringInit(&dsBuf); + if (flags & DDE_FLAG_BINARY) { + dataString = + Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength); + } else { + const char *src; + + src = Tcl_GetString(objv[firstArg + 2]); + dataLength = objv[firstArg + 2]->length; + dataString = (const TCHAR *) + Tcl_WinUtfToTChar(src, dataLength, &dsBuf); + dataLength = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR); + } - if (dataLength == 0) { + if (dataLength + 1 < 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot execute null data", -1)); + Tcl_DStringFree(&dsBuf); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); result = TCL_ERROR; break; } @@ -1378,21 +1520,22 @@ DdeObjCmd( DdeFreeStringHandle(ddeInstance, ddeTopic); if (hConv == NULL) { + Tcl_DStringFree(&dsBuf); SetDdeError(interp); result = TCL_ERROR; break; } - ddeData = DdeCreateDataHandle(ddeInstance, dataString, - (DWORD) dataLength+1, 0, 0, CF_TEXT, 0); + ddeData = DdeCreateDataHandle(ddeInstance, (BYTE *) dataString, + (DWORD) dataLength, 0, 0, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, 0); if (ddeData != NULL) { if (flags & DDE_FLAG_ASYNC) { DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0, - CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); + (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); DdeAbandonTransaction(ddeInstance, hConv, ddeResult); } else { ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, - hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL); + hConv, 0, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL); if (ddeReturn == 0) { SetDdeError(interp); result = TCL_ERROR; @@ -1403,15 +1546,22 @@ DdeObjCmd( SetDdeError(interp); result = TCL_ERROR; } + Tcl_DStringFree(&dsBuf); break; } case DDE_REQUEST: { - const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], - &length); + const TCHAR *itemString; + const char *src; + + src = Tcl_GetString(objv[firstArg + 2]); + length = objv[firstArg + 2]->length; + itemString = Tcl_WinUtfToTChar(src, length, &itemBuf); + length = Tcl_DStringLength(&itemBuf) / sizeof(TCHAR); if (length == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot request value of null data", -1)); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); result = TCL_ERROR; goto cleanup; } @@ -1424,27 +1574,33 @@ DdeObjCmd( result = TCL_ERROR; } else { Tcl_Obj *returnObjPtr; - ddeItem = DdeCreateStringHandle(ddeInstance, (void *)itemString, - CP_WINANSI); + ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, + CP_WINUNICODE); if (ddeItem != NULL) { ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem, - CF_TEXT, XTYP_REQUEST, 5000, NULL); + (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_REQUEST, 5000, NULL); if (ddeData == NULL) { SetDdeError(interp); result = TCL_ERROR; } else { DWORD tmp; - const char *dataString = (const char *) DdeAccessData(ddeData, &tmp); + TCHAR *dataString = (TCHAR *) DdeAccessData(ddeData, &tmp); if (flags & DDE_FLAG_BINARY) { returnObjPtr = - Tcl_NewByteArrayObj((BYTE *) dataString, (int) tmp); + Tcl_NewByteArrayObj((BYTE *) dataString, tmp); } else { - if (tmp && !dataString[tmp-1]) { - --tmp; + Tcl_DString dsBuf; + + if ((tmp >= sizeof(TCHAR)) + && !dataString[tmp / sizeof(TCHAR) - 1]) { + tmp -= sizeof(TCHAR); } - returnObjPtr = Tcl_NewStringObj(dataString, - (int) tmp); + Tcl_WinTCharToUtf(dataString, tmp, &dsBuf); + returnObjPtr = + Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), + Tcl_DStringLength(&dsBuf)); + Tcl_DStringFree(&dsBuf); } DdeUnaccessData(ddeData); DdeFreeDataHandle(ddeData); @@ -1455,22 +1611,37 @@ DdeObjCmd( result = TCL_ERROR; } } - break; } case DDE_POKE: { - const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], - &length); + Tcl_DString dsBuf; + const TCHAR *itemString; BYTE *dataString; + const char *src; + src = Tcl_GetString(objv[firstArg + 2]); + length = objv[firstArg + 2]->length; + itemString = Tcl_WinUtfToTChar(src, length, &itemBuf); + length = Tcl_DStringLength(&itemBuf) / sizeof(TCHAR); if (length == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot have a null item", -1)); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); result = TCL_ERROR; goto cleanup; } - dataString = (BYTE *) Tcl_GetStringFromObj(objv[firstArg + 3], - &length); + Tcl_DStringInit(&dsBuf); + if (flags & DDE_FLAG_BINARY) { + dataString = (BYTE *) + Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length); + } else { + const char *data = + Tcl_GetString(objv[firstArg + 3]); + length = objv[firstArg + 3]->length; + dataString = (BYTE *) + Tcl_WinUtfToTChar(data, length, &dsBuf); + length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR); + } hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); @@ -1481,10 +1652,10 @@ DdeObjCmd( result = TCL_ERROR; } else { ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, - CP_WINANSI); + CP_WINUNICODE); if (ddeItem != NULL) { - ddeData = DdeClientTransaction(dataString, (DWORD) length+1, - hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL); + ddeData = DdeClientTransaction(dataString, (DWORD) length, + hConv, ddeItem, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_POKE, 5000, NULL); if (ddeData == NULL) { SetDdeError(interp); result = TCL_ERROR; @@ -1494,6 +1665,7 @@ DdeObjCmd( result = TCL_ERROR; } } + Tcl_DStringFree(&dsBuf); break; } @@ -1508,6 +1680,7 @@ DdeObjCmd( if (serviceName == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid service name \"\"", -1)); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL); result = TCL_ERROR; goto cleanup; } @@ -1526,7 +1699,7 @@ DdeObjCmd( for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (stricmp(serviceName, riPtr->name) == 0) { + if (_tcsicmp(serviceName, riPtr->name) == 0) { break; } } @@ -1539,9 +1712,9 @@ DdeObjCmd( * server. */ - Tcl_Preserve((ClientData) riPtr); + Tcl_Preserve(riPtr); sendInterp = riPtr->interp; - Tcl_Preserve((ClientData) sendInterp); + Tcl_Preserve(sendInterp); /* * Don't exchange objects between interps. The target interp would @@ -1551,10 +1724,12 @@ DdeObjCmd( * referring to deallocated objects. */ - if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) { - Tcl_SetResult(riPtr->interp, "permission denied: " - "a handler procedure must be defined for use in " - "a safe interp", TCL_STATIC); + if (Tcl_IsSafe(riPtr->interp) && (riPtr->handlerPtr == NULL)) { + Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj( + "permission denied: a handler procedure must be" + " defined for use in a safe interp", -1)); + Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK", + NULL); result = TCL_ERROR; } @@ -1594,8 +1769,7 @@ DdeObjCmd( objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL, TCL_GLOBAL_ONLY); if (objPtr) { - string = Tcl_GetStringFromObj(objPtr, &length); - Tcl_AddObjErrorInfo(interp, string, length); + Tcl_AppendObjToErrorInfo(interp, objPtr); } objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL, @@ -1606,9 +1780,11 @@ DdeObjCmd( } Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp)); } - Tcl_Release((ClientData) riPtr); - Tcl_Release((ClientData) sendInterp); + Tcl_Release(riPtr); + Tcl_Release(sendInterp); } else { + Tcl_DString dsBuf; + /* * This is a non-local request. Send the script to the server and * poll it for a result. @@ -1617,31 +1793,36 @@ DdeObjCmd( if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) { invalidServerResponse: Tcl_SetObjResult(interp, - Tcl_NewStringObj("invalid data returned from server", - -1)); + Tcl_NewStringObj("invalid data returned from server", -1)); + Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL); result = TCL_ERROR; goto cleanup; } objPtr = Tcl_ConcatObj(objc, objv); - string = Tcl_GetStringFromObj(objPtr, &length); - ddeItemData = DdeCreateDataHandle(ddeInstance, - (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0); + string = Tcl_GetString(objPtr); + length = objPtr->length; + Tcl_WinUtfToTChar(string, length, &dsBuf); + string = Tcl_DStringValue(&dsBuf); + length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR); + ddeItemData = DdeCreateDataHandle(ddeInstance, (BYTE *) string, + (DWORD) length, 0, 0, CF_UNICODETEXT, 0); + Tcl_DStringFree(&dsBuf); if (flags & DDE_FLAG_ASYNC) { ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0, - CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); + CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); DdeAbandonTransaction(ddeInstance, hConv, ddeResult); } else { ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0, - CF_TEXT, XTYP_EXECUTE, 30000, NULL); + CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL); if (ddeData != 0) { ddeCookie = DdeCreateStringHandle(ddeInstance, - TCL_DDE_EXECUTE_RESULT, CP_WINANSI); + TCL_DDE_EXECUTE_RESULT, CP_WINUNICODE); ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie, - CF_TEXT, XTYP_REQUEST, 30000, NULL); + CF_UNICODETEXT, XTYP_REQUEST, 30000, NULL); } } @@ -1650,10 +1831,12 @@ DdeObjCmd( if (ddeData == 0) { SetDdeError(interp); result = TCL_ERROR; + goto cleanup; } if (!(flags & DDE_FLAG_ASYNC)) { Tcl_Obj *resultPtr; + TCHAR *ddeDataString; /* * The return handle has a two or four element list in it. The @@ -1664,12 +1847,17 @@ DdeObjCmd( * variable "errorInfo". */ - resultPtr = Tcl_NewObj(); length = DdeGetData(ddeData, NULL, 0, 0); - Tcl_SetObjLength(resultPtr, length); - string = Tcl_GetString(resultPtr); - DdeGetData(ddeData, (BYTE *) string, (DWORD) length, 0); - Tcl_SetObjLength(resultPtr, (int) strlen(string)); + ddeDataString = (TCHAR *) Tcl_Alloc(length); + DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0); + if (length > sizeof(TCHAR)) { + length -= sizeof(TCHAR); + } + Tcl_WinTCharToUtf(ddeDataString, length, &dsBuf); + resultPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf), + Tcl_DStringLength(&dsBuf)); + Tcl_DStringFree(&dsBuf); + Tcl_Free((char *) ddeDataString); if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) { Tcl_DecrRefCount(resultPtr); @@ -1687,9 +1875,7 @@ DdeObjCmd( Tcl_DecrRefCount(resultPtr); goto invalidServerResponse; } - length = -1; - string = Tcl_GetStringFromObj(objPtr, &length); - Tcl_AddObjErrorInfo(interp, string, length); + Tcl_AppendObjToErrorInfo(interp, objPtr); Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr); Tcl_SetObjErrorCode(interp, objPtr); @@ -1721,6 +1907,9 @@ DdeObjCmd( if (hConv != NULL) { DdeDisconnect(hConv); } + Tcl_DStringFree(&itemBuf); + Tcl_DStringFree(&topicBuf); + Tcl_DStringFree(&serviceBuf); return result; } diff --git a/win/tclWinReg.c b/win/tclWinReg.c index f3d7a07..0d2cd94 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -492,7 +492,6 @@ DeleteValue( { HKEY key; char *valueName; - size_t length; DWORD result; Tcl_DString ds; @@ -506,8 +505,7 @@ DeleteValue( } valueName = Tcl_GetString(valueNameObj); - length = valueNameObj->length; - Tcl_WinUtfToTChar(valueName, length, &ds); + Tcl_WinUtfToTChar(valueName, valueNameObj->length, &ds); result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); if (result != ERROR_SUCCESS) { @@ -647,7 +645,6 @@ GetType( Tcl_DString ds; const char *valueName; const TCHAR *nativeValue; - size_t length; /* * Attempt to open the key for reading. @@ -663,8 +660,7 @@ GetType( */ valueName = Tcl_GetString(valueNameObj); - length = valueNameObj->length; - nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds); + nativeValue = Tcl_WinUtfToTChar(valueName, valueNameObj->length, &ds); result = RegQueryValueEx(key, nativeValue, NULL, &type, NULL, NULL); Tcl_DStringFree(&ds); @@ -720,7 +716,6 @@ GetValue( const TCHAR *nativeValue; DWORD result, length, type; Tcl_DString data, buf; - size_t nameLen; /* * Attempt to open the key for reading. @@ -746,8 +741,7 @@ GetValue( length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1; valueName = Tcl_GetString(valueNameObj); - nameLen = valueNameObj->length; - nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf); + nativeValue = Tcl_WinUtfToTChar(valueName, valueNameObj->length, &buf); result = RegQueryValueEx(key, nativeValue, NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); @@ -936,13 +930,11 @@ OpenKey( HKEY *keyPtr) /* Returned HKEY. */ { char *keyName, *buffer, *hostName; - size_t length; HKEY rootKey; DWORD result; keyName = Tcl_GetString(keyNameObj); - length = keyNameObj->length; - buffer = Tcl_Alloc(length + 1); + buffer = Tcl_Alloc(keyNameObj->length + 1); strcpy(buffer, keyName); result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName); @@ -1244,7 +1236,6 @@ SetValue( REGSAM mode) /* Mode flags to pass. */ { int type; - size_t length; DWORD result; HKEY key; const char *valueName; @@ -1265,8 +1256,7 @@ SetValue( } valueName = Tcl_GetString(valueNameObj); - length = valueNameObj->length; - valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf); + valueName = (char *) Tcl_WinUtfToTChar(valueName, valueNameObj->length, &nameBuf); if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { int value; @@ -1301,8 +1291,7 @@ SetValue( for (i = 0; i < objc; i++) { const char *bytes = Tcl_GetString(objv[i]); - length = objv[i]->length; - Tcl_DStringAppend(&data, bytes, length); + Tcl_DStringAppend(&data, bytes, objv[i]->length); /* * Add a null character to separate this value from the next. @@ -1322,18 +1311,16 @@ SetValue( Tcl_DString buf; const char *data = Tcl_GetString(dataObj); - length = dataObj->length; - data = (char *) Tcl_WinUtfToTChar(data, length, &buf); + data = (char *) Tcl_WinUtfToTChar(data, dataObj->length, &buf); /* * Include the null in the length, padding if needed for WCHAR. */ Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); - length = Tcl_DStringLength(&buf) + 1; result = RegSetValueEx(key, (TCHAR *) valueName, 0, - (DWORD) type, (BYTE *) data, (DWORD) length); + (DWORD) type, (BYTE *) data, (DWORD) Tcl_DStringLength(&buf) + 1); Tcl_DStringFree(&buf); } else { BYTE *data; @@ -1404,8 +1391,7 @@ BroadcastValue( } str = Tcl_GetString(objv[0]); - len = objv[0]->length; - wstr = (WCHAR *) Tcl_WinUtfToTChar(str, len, &ds); + wstr = (WCHAR *) Tcl_WinUtfToTChar(str, objv[0]->length, &ds); if (Tcl_DStringLength(&ds) == 0) { wstr = NULL; } -- cgit v0.12 From d7a697aa505f57e3135239964c90863202c4f815 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 27 Oct 2018 08:03:56 +0000 Subject: Missed some version bumps in previous commit --- win/makefile.vc | 2 +- win/rules.vc | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/win/makefile.vc b/win/makefile.vc index 62a4d67..95a34d7 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -182,7 +182,7 @@ STUBPREFIX = $(PROJECT)stub DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION) VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) -DDEDOTVERSION = 1.3 +DDEDOTVERSION = 1.4 DDEVERSION = $(DDEDOTVERSION:.=) REGDOTVERSION = 1.3 diff --git a/win/rules.vc b/win/rules.vc index 0ae0e8e..33ebfe2 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -591,7 +591,7 @@ TCLSTUBLIB = "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib" TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib" TCL_LIBRARY = $(_TCLDIR)\lib TCLREGLIB = "$(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib" -TCLDDELIB = "$(_TCLDIR)\lib\tcldde13$(SUFX:t=).lib" +TCLDDELIB = "$(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib" COFFBASE = \must\have\tcl\sources\to\build\this\target TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target TCL_INCLUDES = -I"$(_TCLDIR)\include" @@ -604,7 +604,7 @@ TCLSTUBLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib" TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib" TCL_LIBRARY = $(_TCLDIR)\library TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib" -TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde13$(SUFX:t=).lib" +TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib" COFFBASE = "$(_TCLDIR)\win\coffbase.txt" TCLTOOLSDIR = $(_TCLDIR)\tools TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win" -- cgit v0.12 From fef802ea7a250bb158b599340431c49d115184c6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 27 Oct 2018 08:06:42 +0000 Subject: Update to latest tzdata (backported from 8.6) --- library/tzdata/Africa/Ceuta | 1 + library/tzdata/America/Santiago | 324 ++++++++++++++++++++-------------------- library/tzdata/Asia/Macau | 68 ++++++--- library/tzdata/Asia/Manila | 18 +-- library/tzdata/Asia/Pyongyang | 2 +- library/tzdata/Asia/Shanghai | 43 +++--- library/tzdata/Asia/Tokyo | 8 +- library/tzdata/Europe/Volgograd | 1 + library/tzdata/Pacific/Easter | 324 ++++++++++++++++++++-------------------- library/tzdata/Pacific/Fiji | 24 +-- 10 files changed, 427 insertions(+), 386 deletions(-) diff --git a/library/tzdata/Africa/Ceuta b/library/tzdata/Africa/Ceuta index 057ca22..18af8c1 100644 --- a/library/tzdata/Africa/Ceuta +++ b/library/tzdata/Africa/Ceuta @@ -15,6 +15,7 @@ set TZData(:Africa/Ceuta) { {-1316390400 3600 1 WEST} {-1301270400 0 0 WET} {-1293840000 0 0 WET} + {-94694400 0 0 WET} {-81432000 3600 1 WEST} {-71110800 0 0 WET} {141264000 3600 1 WEST} diff --git a/library/tzdata/America/Santiago b/library/tzdata/America/Santiago index 67d5b5c..55212b9 100644 --- a/library/tzdata/America/Santiago +++ b/library/tzdata/America/Santiago @@ -124,166 +124,166 @@ set TZData(:America/Santiago) { {1502596800 -10800 1 -04} {1526180400 -14400 0 -04} {1534046400 -10800 1 -04} - {1557630000 -14400 0 -04} - {1565496000 -10800 1 -04} - {1589079600 -14400 0 -04} - {1596945600 -10800 1 -04} - {1620529200 -14400 0 -04} - {1629000000 -10800 1 -04} - {1652583600 -14400 0 -04} - {1660449600 -10800 1 -04} - {1684033200 -14400 0 -04} - {1691899200 -10800 1 -04} - {1715482800 -14400 0 -04} - {1723348800 -10800 1 -04} - {1746932400 -14400 0 -04} - {1754798400 -10800 1 -04} - {1778382000 -14400 0 -04} - {1786248000 -10800 1 -04} - {1809831600 -14400 0 -04} - {1818302400 -10800 1 -04} - {1841886000 -14400 0 -04} - {1849752000 -10800 1 -04} - {1873335600 -14400 0 -04} - {1881201600 -10800 1 -04} - {1904785200 -14400 0 -04} - {1912651200 -10800 1 -04} - {1936234800 -14400 0 -04} - {1944100800 -10800 1 -04} - {1967684400 -14400 0 -04} - {1976155200 -10800 1 -04} - {1999738800 -14400 0 -04} - {2007604800 -10800 1 -04} - {2031188400 -14400 0 -04} - {2039054400 -10800 1 -04} - {2062638000 -14400 0 -04} - {2070504000 -10800 1 -04} - {2094087600 -14400 0 -04} - {2101953600 -10800 1 -04} - {2125537200 -14400 0 -04} - {2133403200 -10800 1 -04} - {2156986800 -14400 0 -04} - {2165457600 -10800 1 -04} - {2189041200 -14400 0 -04} - {2196907200 -10800 1 -04} - {2220490800 -14400 0 -04} - {2228356800 -10800 1 -04} - {2251940400 -14400 0 -04} - {2259806400 -10800 1 -04} - {2283390000 -14400 0 -04} - {2291256000 -10800 1 -04} - {2314839600 -14400 0 -04} - {2322705600 -10800 1 -04} - {2346894000 -14400 0 -04} - {2354760000 -10800 1 -04} - {2378343600 -14400 0 -04} - {2386209600 -10800 1 -04} - {2409793200 -14400 0 -04} - {2417659200 -10800 1 -04} - {2441242800 -14400 0 -04} - {2449108800 -10800 1 -04} - {2472692400 -14400 0 -04} - {2480558400 -10800 1 -04} - {2504142000 -14400 0 -04} - {2512612800 -10800 1 -04} - {2536196400 -14400 0 -04} - {2544062400 -10800 1 -04} - {2567646000 -14400 0 -04} - {2575512000 -10800 1 -04} - {2599095600 -14400 0 -04} - {2606961600 -10800 1 -04} - {2630545200 -14400 0 -04} - {2638411200 -10800 1 -04} - {2661994800 -14400 0 -04} - {2669860800 -10800 1 -04} - {2693444400 -14400 0 -04} - {2701915200 -10800 1 -04} - {2725498800 -14400 0 -04} - {2733364800 -10800 1 -04} - {2756948400 -14400 0 -04} - {2764814400 -10800 1 -04} - {2788398000 -14400 0 -04} - {2796264000 -10800 1 -04} - {2819847600 -14400 0 -04} - {2827713600 -10800 1 -04} - {2851297200 -14400 0 -04} - {2859768000 -10800 1 -04} - {2883351600 -14400 0 -04} - {2891217600 -10800 1 -04} - {2914801200 -14400 0 -04} - {2922667200 -10800 1 -04} - {2946250800 -14400 0 -04} - {2954116800 -10800 1 -04} - {2977700400 -14400 0 -04} - {2985566400 -10800 1 -04} - {3009150000 -14400 0 -04} - {3017016000 -10800 1 -04} - {3040599600 -14400 0 -04} - {3049070400 -10800 1 -04} - {3072654000 -14400 0 -04} - {3080520000 -10800 1 -04} - {3104103600 -14400 0 -04} - {3111969600 -10800 1 -04} - {3135553200 -14400 0 -04} - {3143419200 -10800 1 -04} - {3167002800 -14400 0 -04} - {3174868800 -10800 1 -04} - {3198452400 -14400 0 -04} - {3206318400 -10800 1 -04} - {3230506800 -14400 0 -04} - {3238372800 -10800 1 -04} - {3261956400 -14400 0 -04} - {3269822400 -10800 1 -04} - {3293406000 -14400 0 -04} - {3301272000 -10800 1 -04} - {3324855600 -14400 0 -04} - {3332721600 -10800 1 -04} - {3356305200 -14400 0 -04} - {3364171200 -10800 1 -04} - {3387754800 -14400 0 -04} - {3396225600 -10800 1 -04} - {3419809200 -14400 0 -04} - {3427675200 -10800 1 -04} - {3451258800 -14400 0 -04} - {3459124800 -10800 1 -04} - {3482708400 -14400 0 -04} - {3490574400 -10800 1 -04} - {3514158000 -14400 0 -04} - {3522024000 -10800 1 -04} - {3545607600 -14400 0 -04} - {3553473600 -10800 1 -04} - {3577057200 -14400 0 -04} - {3585528000 -10800 1 -04} - {3609111600 -14400 0 -04} - {3616977600 -10800 1 -04} - {3640561200 -14400 0 -04} - {3648427200 -10800 1 -04} - {3672010800 -14400 0 -04} - {3679876800 -10800 1 -04} - {3703460400 -14400 0 -04} - {3711326400 -10800 1 -04} - {3734910000 -14400 0 -04} - {3743380800 -10800 1 -04} - {3766964400 -14400 0 -04} - {3774830400 -10800 1 -04} - {3798414000 -14400 0 -04} - {3806280000 -10800 1 -04} - {3829863600 -14400 0 -04} - {3837729600 -10800 1 -04} - {3861313200 -14400 0 -04} - {3869179200 -10800 1 -04} - {3892762800 -14400 0 -04} - {3900628800 -10800 1 -04} - {3924212400 -14400 0 -04} - {3932683200 -10800 1 -04} - {3956266800 -14400 0 -04} - {3964132800 -10800 1 -04} - {3987716400 -14400 0 -04} - {3995582400 -10800 1 -04} - {4019166000 -14400 0 -04} - {4027032000 -10800 1 -04} - {4050615600 -14400 0 -04} - {4058481600 -10800 1 -04} - {4082065200 -14400 0 -04} - {4089931200 -10800 1 -04} + {1554606000 -14400 0 -04} + {1567915200 -10800 1 -04} + {1586055600 -14400 0 -04} + {1599364800 -10800 1 -04} + {1617505200 -14400 0 -04} + {1630814400 -10800 1 -04} + {1648954800 -14400 0 -04} + {1662264000 -10800 1 -04} + {1680404400 -14400 0 -04} + {1693713600 -10800 1 -04} + {1712458800 -14400 0 -04} + {1725768000 -10800 1 -04} + {1743908400 -14400 0 -04} + {1757217600 -10800 1 -04} + {1775358000 -14400 0 -04} + {1788667200 -10800 1 -04} + {1806807600 -14400 0 -04} + {1820116800 -10800 1 -04} + {1838257200 -14400 0 -04} + {1851566400 -10800 1 -04} + {1870311600 -14400 0 -04} + {1883016000 -10800 1 -04} + {1901761200 -14400 0 -04} + {1915070400 -10800 1 -04} + {1933210800 -14400 0 -04} + {1946520000 -10800 1 -04} + {1964660400 -14400 0 -04} + {1977969600 -10800 1 -04} + {1996110000 -14400 0 -04} + {2009419200 -10800 1 -04} + {2027559600 -14400 0 -04} + {2040868800 -10800 1 -04} + {2059614000 -14400 0 -04} + {2072318400 -10800 1 -04} + {2091063600 -14400 0 -04} + {2104372800 -10800 1 -04} + {2122513200 -14400 0 -04} + {2135822400 -10800 1 -04} + {2153962800 -14400 0 -04} + {2167272000 -10800 1 -04} + {2185412400 -14400 0 -04} + {2198721600 -10800 1 -04} + {2217466800 -14400 0 -04} + {2230171200 -10800 1 -04} + {2248916400 -14400 0 -04} + {2262225600 -10800 1 -04} + {2280366000 -14400 0 -04} + {2293675200 -10800 1 -04} + {2311815600 -14400 0 -04} + {2325124800 -10800 1 -04} + {2343265200 -14400 0 -04} + {2356574400 -10800 1 -04} + {2374714800 -14400 0 -04} + {2388024000 -10800 1 -04} + {2406769200 -14400 0 -04} + {2419473600 -10800 1 -04} + {2438218800 -14400 0 -04} + {2451528000 -10800 1 -04} + {2469668400 -14400 0 -04} + {2482977600 -10800 1 -04} + {2501118000 -14400 0 -04} + {2514427200 -10800 1 -04} + {2532567600 -14400 0 -04} + {2545876800 -10800 1 -04} + {2564017200 -14400 0 -04} + {2577326400 -10800 1 -04} + {2596071600 -14400 0 -04} + {2609380800 -10800 1 -04} + {2627521200 -14400 0 -04} + {2640830400 -10800 1 -04} + {2658970800 -14400 0 -04} + {2672280000 -10800 1 -04} + {2690420400 -14400 0 -04} + {2703729600 -10800 1 -04} + {2721870000 -14400 0 -04} + {2735179200 -10800 1 -04} + {2753924400 -14400 0 -04} + {2766628800 -10800 1 -04} + {2785374000 -14400 0 -04} + {2798683200 -10800 1 -04} + {2816823600 -14400 0 -04} + {2830132800 -10800 1 -04} + {2848273200 -14400 0 -04} + {2861582400 -10800 1 -04} + {2879722800 -14400 0 -04} + {2893032000 -10800 1 -04} + {2911172400 -14400 0 -04} + {2924481600 -10800 1 -04} + {2943226800 -14400 0 -04} + {2955931200 -10800 1 -04} + {2974676400 -14400 0 -04} + {2987985600 -10800 1 -04} + {3006126000 -14400 0 -04} + {3019435200 -10800 1 -04} + {3037575600 -14400 0 -04} + {3050884800 -10800 1 -04} + {3069025200 -14400 0 -04} + {3082334400 -10800 1 -04} + {3101079600 -14400 0 -04} + {3113784000 -10800 1 -04} + {3132529200 -14400 0 -04} + {3145838400 -10800 1 -04} + {3163978800 -14400 0 -04} + {3177288000 -10800 1 -04} + {3195428400 -14400 0 -04} + {3208737600 -10800 1 -04} + {3226878000 -14400 0 -04} + {3240187200 -10800 1 -04} + {3258327600 -14400 0 -04} + {3271636800 -10800 1 -04} + {3290382000 -14400 0 -04} + {3303086400 -10800 1 -04} + {3321831600 -14400 0 -04} + {3335140800 -10800 1 -04} + {3353281200 -14400 0 -04} + {3366590400 -10800 1 -04} + {3384730800 -14400 0 -04} + {3398040000 -10800 1 -04} + {3416180400 -14400 0 -04} + {3429489600 -10800 1 -04} + {3447630000 -14400 0 -04} + {3460939200 -10800 1 -04} + {3479684400 -14400 0 -04} + {3492993600 -10800 1 -04} + {3511134000 -14400 0 -04} + {3524443200 -10800 1 -04} + {3542583600 -14400 0 -04} + {3555892800 -10800 1 -04} + {3574033200 -14400 0 -04} + {3587342400 -10800 1 -04} + {3605482800 -14400 0 -04} + {3618792000 -10800 1 -04} + {3637537200 -14400 0 -04} + {3650241600 -10800 1 -04} + {3668986800 -14400 0 -04} + {3682296000 -10800 1 -04} + {3700436400 -14400 0 -04} + {3713745600 -10800 1 -04} + {3731886000 -14400 0 -04} + {3745195200 -10800 1 -04} + {3763335600 -14400 0 -04} + {3776644800 -10800 1 -04} + {3794785200 -14400 0 -04} + {3808094400 -10800 1 -04} + {3826839600 -14400 0 -04} + {3839544000 -10800 1 -04} + {3858289200 -14400 0 -04} + {3871598400 -10800 1 -04} + {3889738800 -14400 0 -04} + {3903048000 -10800 1 -04} + {3921188400 -14400 0 -04} + {3934497600 -10800 1 -04} + {3952638000 -14400 0 -04} + {3965947200 -10800 1 -04} + {3984692400 -14400 0 -04} + {3997396800 -10800 1 -04} + {4016142000 -14400 0 -04} + {4029451200 -10800 1 -04} + {4047591600 -14400 0 -04} + {4060900800 -10800 1 -04} + {4079041200 -14400 0 -04} + {4092350400 -10800 1 -04} } diff --git a/library/tzdata/Asia/Macau b/library/tzdata/Asia/Macau index 76a00aa..cbafd0e 100644 --- a/library/tzdata/Asia/Macau +++ b/library/tzdata/Asia/Macau @@ -1,20 +1,56 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:Asia/Macau) { - {-9223372036854775808 27260 0 LMT} - {-1830412800 28800 0 CST} + {-9223372036854775808 27250 0 LMT} + {-2056692850 28800 0 CST} + {-884509200 32400 0 +09} + {-873280800 36000 1 +09} + {-855918000 32400 0 +09} + {-841744800 36000 1 +09} + {-828529200 32400 0 +10} + {-765363600 28800 0 CT} + {-747046800 32400 1 CDT} + {-733827600 28800 0 CST} + {-716461200 32400 1 CDT} + {-697021200 28800 0 CST} + {-683715600 32400 1 CDT} + {-667990800 28800 0 CST} + {-654771600 32400 1 CDT} + {-636627600 28800 0 CST} + {-623322000 32400 1 CDT} + {-605178000 28800 0 CST} + {-591872400 32400 1 CDT} + {-573642000 28800 0 CST} + {-559818000 32400 1 CDT} + {-541674000 28800 0 CST} + {-528368400 32400 1 CDT} + {-510224400 28800 0 CST} + {-498128400 32400 1 CDT} + {-478774800 28800 0 CST} + {-466678800 32400 1 CDT} + {-446720400 28800 0 CST} + {-435229200 32400 1 CDT} + {-415258200 28800 0 CST} + {-403158600 32400 1 CDT} + {-383808600 28800 0 CST} + {-371709000 32400 1 CDT} + {-352359000 28800 0 CST} + {-340259400 32400 1 CDT} + {-320909400 28800 0 CST} + {-308809800 32400 1 CDT} + {-288855000 28800 0 CST} {-277360200 32400 1 CDT} {-257405400 28800 0 CST} {-245910600 32400 1 CDT} {-225955800 28800 0 CST} - {-214473600 32400 1 CDT} + {-213856200 32400 1 CDT} {-194506200 28800 0 CST} {-182406600 32400 1 CDT} {-163056600 28800 0 CST} - {-150969600 32400 1 CDT} - {-131619600 28800 0 CST} + {-148537800 32400 1 CDT} + {-132820200 28800 0 CST} {-117088200 32400 1 CDT} - {-101367000 28800 0 CST} + {-101370600 28800 0 CST} {-85638600 32400 1 CDT} {-69312600 28800 0 CST} {-53584200 32400 1 CDT} @@ -25,22 +61,16 @@ set TZData(:Asia/Macau) { {25036200 28800 0 CST} {40764600 32400 1 CDT} {56485800 28800 0 CST} - {72201600 32400 1 CDT} - {87922800 28800 0 CST} - {103651200 32400 1 CDT} - {119977200 28800 0 CST} - {135705600 32400 1 CDT} + {72214200 32400 1 CDT} + {88540200 28800 0 CST} + {104268600 32400 1 CDT} + {119989800 28800 0 CST} + {126041400 32400 1 CDT} {151439400 28800 0 CST} {167167800 32400 1 CDT} {182889000 28800 0 CST} {198617400 32400 1 CDT} {214338600 28800 0 CST} - {230067000 32400 1 CDT} - {245788200 28800 0 CST} - {261504000 32400 1 CDT} - {277225200 28800 0 CST} - {292953600 32400 1 CDT} - {309279600 28800 0 CST} - {325008000 32400 1 CDT} - {340729200 28800 0 CST} + {295385400 32400 1 CDT} + {309292200 28800 0 CST} } diff --git a/library/tzdata/Asia/Manila b/library/tzdata/Asia/Manila index b7ffa7a..6eb1db3 100644 --- a/library/tzdata/Asia/Manila +++ b/library/tzdata/Asia/Manila @@ -3,13 +3,13 @@ set TZData(:Asia/Manila) { {-9223372036854775808 -57360 0 LMT} {-3944621040 29040 0 LMT} - {-2229321840 28800 0 +08} - {-1046678400 32400 1 +08} - {-1038733200 28800 0 +08} - {-873273600 32400 0 +09} - {-794221200 28800 0 +08} - {-496224000 32400 1 +08} - {-489315600 28800 0 +08} - {259344000 32400 1 +08} - {275151600 28800 0 +08} + {-2229321840 28800 0 PST} + {-1046678400 32400 1 PDT} + {-1038733200 28800 0 PST} + {-873273600 32400 0 JST} + {-794221200 28800 0 PST} + {-496224000 32400 1 PDT} + {-489315600 28800 0 PST} + {259344000 32400 1 PDT} + {275151600 28800 0 PST} } diff --git a/library/tzdata/Asia/Pyongyang b/library/tzdata/Asia/Pyongyang index 5746472..5351736 100644 --- a/library/tzdata/Asia/Pyongyang +++ b/library/tzdata/Asia/Pyongyang @@ -6,5 +6,5 @@ set TZData(:Asia/Pyongyang) { {-1830414600 32400 0 JST} {-768646800 32400 0 KST} {1439564400 30600 0 KST} - {1525447800 32400 0 KST} + {1525446000 32400 0 KST} } diff --git a/library/tzdata/Asia/Shanghai b/library/tzdata/Asia/Shanghai index ff2d2b5..66bc4339 100644 --- a/library/tzdata/Asia/Shanghai +++ b/library/tzdata/Asia/Shanghai @@ -3,21 +3,30 @@ set TZData(:Asia/Shanghai) { {-9223372036854775808 29143 0 LMT} {-2177481943 28800 0 CST} - {-933494400 32400 1 CDT} - {-923130000 28800 0 CST} - {-908784000 32400 1 CDT} - {-891594000 28800 0 CST} - {-662716800 28800 0 CST} - {515520000 32400 1 CDT} - {527007600 28800 0 CST} - {545155200 32400 1 CDT} - {558457200 28800 0 CST} - {576604800 32400 1 CDT} - {589906800 28800 0 CST} - {608659200 32400 1 CDT} - {621961200 28800 0 CST} - {640108800 32400 1 CDT} - {653410800 28800 0 CST} - {671558400 32400 1 CDT} - {684860400 28800 0 CST} + {-933667200 32400 1 CDT} + {-922093200 28800 0 CST} + {-908870400 32400 1 CDT} + {-888829200 28800 0 CST} + {-881049600 32400 1 CDT} + {-767869200 28800 0 CST} + {-745833600 32400 1 CDT} + {-733827600 28800 0 CST} + {-716889600 32400 1 CDT} + {-699613200 28800 0 CST} + {-683884800 32400 1 CDT} + {-670669200 28800 0 CST} + {-652348800 32400 1 CDT} + {-650016000 28800 0 CST} + {515527200 32400 1 CDT} + {527014800 28800 0 CST} + {545162400 32400 1 CDT} + {558464400 28800 0 CST} + {577216800 32400 1 CDT} + {589914000 28800 0 CST} + {608666400 32400 1 CDT} + {621968400 28800 0 CST} + {640116000 32400 1 CDT} + {653418000 28800 0 CST} + {671565600 32400 1 CDT} + {684867600 28800 0 CST} } diff --git a/library/tzdata/Asia/Tokyo b/library/tzdata/Asia/Tokyo index 790df0a..cc7a857 100644 --- a/library/tzdata/Asia/Tokyo +++ b/library/tzdata/Asia/Tokyo @@ -4,11 +4,11 @@ set TZData(:Asia/Tokyo) { {-9223372036854775808 33539 0 LMT} {-2587712400 32400 0 JST} {-683802000 36000 1 JDT} - {-672314400 32400 0 JST} + {-672310800 32400 0 JST} {-654771600 36000 1 JDT} - {-640864800 32400 0 JST} + {-640861200 32400 0 JST} {-620298000 36000 1 JDT} - {-609415200 32400 0 JST} + {-609411600 32400 0 JST} {-588848400 36000 1 JDT} - {-577965600 32400 0 JST} + {-577962000 32400 0 JST} } diff --git a/library/tzdata/Europe/Volgograd b/library/tzdata/Europe/Volgograd index 05e1044..3938683 100644 --- a/library/tzdata/Europe/Volgograd +++ b/library/tzdata/Europe/Volgograd @@ -68,4 +68,5 @@ set TZData(:Europe/Volgograd) { {1288479600 10800 0 +03} {1301180400 14400 0 +04} {1414274400 10800 0 +03} + {1540681200 14400 0 +04} } diff --git a/library/tzdata/Pacific/Easter b/library/tzdata/Pacific/Easter index a087cd0..7a8d525 100644 --- a/library/tzdata/Pacific/Easter +++ b/library/tzdata/Pacific/Easter @@ -103,166 +103,166 @@ set TZData(:Pacific/Easter) { {1502596800 -18000 1 -06} {1526180400 -21600 0 -06} {1534046400 -18000 1 -06} - {1557630000 -21600 0 -06} - {1565496000 -18000 1 -06} - {1589079600 -21600 0 -06} - {1596945600 -18000 1 -06} - {1620529200 -21600 0 -06} - {1629000000 -18000 1 -06} - {1652583600 -21600 0 -06} - {1660449600 -18000 1 -06} - {1684033200 -21600 0 -06} - {1691899200 -18000 1 -06} - {1715482800 -21600 0 -06} - {1723348800 -18000 1 -06} - {1746932400 -21600 0 -06} - {1754798400 -18000 1 -06} - {1778382000 -21600 0 -06} - {1786248000 -18000 1 -06} - {1809831600 -21600 0 -06} - {1818302400 -18000 1 -06} - {1841886000 -21600 0 -06} - {1849752000 -18000 1 -06} - {1873335600 -21600 0 -06} - {1881201600 -18000 1 -06} - {1904785200 -21600 0 -06} - {1912651200 -18000 1 -06} - {1936234800 -21600 0 -06} - {1944100800 -18000 1 -06} - {1967684400 -21600 0 -06} - {1976155200 -18000 1 -06} - {1999738800 -21600 0 -06} - {2007604800 -18000 1 -06} - {2031188400 -21600 0 -06} - {2039054400 -18000 1 -06} - {2062638000 -21600 0 -06} - {2070504000 -18000 1 -06} - {2094087600 -21600 0 -06} - {2101953600 -18000 1 -06} - {2125537200 -21600 0 -06} - {2133403200 -18000 1 -06} - {2156986800 -21600 0 -06} - {2165457600 -18000 1 -06} - {2189041200 -21600 0 -06} - {2196907200 -18000 1 -06} - {2220490800 -21600 0 -06} - {2228356800 -18000 1 -06} - {2251940400 -21600 0 -06} - {2259806400 -18000 1 -06} - {2283390000 -21600 0 -06} - {2291256000 -18000 1 -06} - {2314839600 -21600 0 -06} - {2322705600 -18000 1 -06} - {2346894000 -21600 0 -06} - {2354760000 -18000 1 -06} - {2378343600 -21600 0 -06} - {2386209600 -18000 1 -06} - {2409793200 -21600 0 -06} - {2417659200 -18000 1 -06} - {2441242800 -21600 0 -06} - {2449108800 -18000 1 -06} - {2472692400 -21600 0 -06} - {2480558400 -18000 1 -06} - {2504142000 -21600 0 -06} - {2512612800 -18000 1 -06} - {2536196400 -21600 0 -06} - {2544062400 -18000 1 -06} - {2567646000 -21600 0 -06} - {2575512000 -18000 1 -06} - {2599095600 -21600 0 -06} - {2606961600 -18000 1 -06} - {2630545200 -21600 0 -06} - {2638411200 -18000 1 -06} - {2661994800 -21600 0 -06} - {2669860800 -18000 1 -06} - {2693444400 -21600 0 -06} - {2701915200 -18000 1 -06} - {2725498800 -21600 0 -06} - {2733364800 -18000 1 -06} - {2756948400 -21600 0 -06} - {2764814400 -18000 1 -06} - {2788398000 -21600 0 -06} - {2796264000 -18000 1 -06} - {2819847600 -21600 0 -06} - {2827713600 -18000 1 -06} - {2851297200 -21600 0 -06} - {2859768000 -18000 1 -06} - {2883351600 -21600 0 -06} - {2891217600 -18000 1 -06} - {2914801200 -21600 0 -06} - {2922667200 -18000 1 -06} - {2946250800 -21600 0 -06} - {2954116800 -18000 1 -06} - {2977700400 -21600 0 -06} - {2985566400 -18000 1 -06} - {3009150000 -21600 0 -06} - {3017016000 -18000 1 -06} - {3040599600 -21600 0 -06} - {3049070400 -18000 1 -06} - {3072654000 -21600 0 -06} - {3080520000 -18000 1 -06} - {3104103600 -21600 0 -06} - {3111969600 -18000 1 -06} - {3135553200 -21600 0 -06} - {3143419200 -18000 1 -06} - {3167002800 -21600 0 -06} - {3174868800 -18000 1 -06} - {3198452400 -21600 0 -06} - {3206318400 -18000 1 -06} - {3230506800 -21600 0 -06} - {3238372800 -18000 1 -06} - {3261956400 -21600 0 -06} - {3269822400 -18000 1 -06} - {3293406000 -21600 0 -06} - {3301272000 -18000 1 -06} - {3324855600 -21600 0 -06} - {3332721600 -18000 1 -06} - {3356305200 -21600 0 -06} - {3364171200 -18000 1 -06} - {3387754800 -21600 0 -06} - {3396225600 -18000 1 -06} - {3419809200 -21600 0 -06} - {3427675200 -18000 1 -06} - {3451258800 -21600 0 -06} - {3459124800 -18000 1 -06} - {3482708400 -21600 0 -06} - {3490574400 -18000 1 -06} - {3514158000 -21600 0 -06} - {3522024000 -18000 1 -06} - {3545607600 -21600 0 -06} - {3553473600 -18000 1 -06} - {3577057200 -21600 0 -06} - {3585528000 -18000 1 -06} - {3609111600 -21600 0 -06} - {3616977600 -18000 1 -06} - {3640561200 -21600 0 -06} - {3648427200 -18000 1 -06} - {3672010800 -21600 0 -06} - {3679876800 -18000 1 -06} - {3703460400 -21600 0 -06} - {3711326400 -18000 1 -06} - {3734910000 -21600 0 -06} - {3743380800 -18000 1 -06} - {3766964400 -21600 0 -06} - {3774830400 -18000 1 -06} - {3798414000 -21600 0 -06} - {3806280000 -18000 1 -06} - {3829863600 -21600 0 -06} - {3837729600 -18000 1 -06} - {3861313200 -21600 0 -06} - {3869179200 -18000 1 -06} - {3892762800 -21600 0 -06} - {3900628800 -18000 1 -06} - {3924212400 -21600 0 -06} - {3932683200 -18000 1 -06} - {3956266800 -21600 0 -06} - {3964132800 -18000 1 -06} - {3987716400 -21600 0 -06} - {3995582400 -18000 1 -06} - {4019166000 -21600 0 -06} - {4027032000 -18000 1 -06} - {4050615600 -21600 0 -06} - {4058481600 -18000 1 -06} - {4082065200 -21600 0 -06} - {4089931200 -18000 1 -06} + {1554606000 -21600 0 -06} + {1567915200 -18000 1 -06} + {1586055600 -21600 0 -06} + {1599364800 -18000 1 -06} + {1617505200 -21600 0 -06} + {1630814400 -18000 1 -06} + {1648954800 -21600 0 -06} + {1662264000 -18000 1 -06} + {1680404400 -21600 0 -06} + {1693713600 -18000 1 -06} + {1712458800 -21600 0 -06} + {1725768000 -18000 1 -06} + {1743908400 -21600 0 -06} + {1757217600 -18000 1 -06} + {1775358000 -21600 0 -06} + {1788667200 -18000 1 -06} + {1806807600 -21600 0 -06} + {1820116800 -18000 1 -06} + {1838257200 -21600 0 -06} + {1851566400 -18000 1 -06} + {1870311600 -21600 0 -06} + {1883016000 -18000 1 -06} + {1901761200 -21600 0 -06} + {1915070400 -18000 1 -06} + {1933210800 -21600 0 -06} + {1946520000 -18000 1 -06} + {1964660400 -21600 0 -06} + {1977969600 -18000 1 -06} + {1996110000 -21600 0 -06} + {2009419200 -18000 1 -06} + {2027559600 -21600 0 -06} + {2040868800 -18000 1 -06} + {2059614000 -21600 0 -06} + {2072318400 -18000 1 -06} + {2091063600 -21600 0 -06} + {2104372800 -18000 1 -06} + {2122513200 -21600 0 -06} + {2135822400 -18000 1 -06} + {2153962800 -21600 0 -06} + {2167272000 -18000 1 -06} + {2185412400 -21600 0 -06} + {2198721600 -18000 1 -06} + {2217466800 -21600 0 -06} + {2230171200 -18000 1 -06} + {2248916400 -21600 0 -06} + {2262225600 -18000 1 -06} + {2280366000 -21600 0 -06} + {2293675200 -18000 1 -06} + {2311815600 -21600 0 -06} + {2325124800 -18000 1 -06} + {2343265200 -21600 0 -06} + {2356574400 -18000 1 -06} + {2374714800 -21600 0 -06} + {2388024000 -18000 1 -06} + {2406769200 -21600 0 -06} + {2419473600 -18000 1 -06} + {2438218800 -21600 0 -06} + {2451528000 -18000 1 -06} + {2469668400 -21600 0 -06} + {2482977600 -18000 1 -06} + {2501118000 -21600 0 -06} + {2514427200 -18000 1 -06} + {2532567600 -21600 0 -06} + {2545876800 -18000 1 -06} + {2564017200 -21600 0 -06} + {2577326400 -18000 1 -06} + {2596071600 -21600 0 -06} + {2609380800 -18000 1 -06} + {2627521200 -21600 0 -06} + {2640830400 -18000 1 -06} + {2658970800 -21600 0 -06} + {2672280000 -18000 1 -06} + {2690420400 -21600 0 -06} + {2703729600 -18000 1 -06} + {2721870000 -21600 0 -06} + {2735179200 -18000 1 -06} + {2753924400 -21600 0 -06} + {2766628800 -18000 1 -06} + {2785374000 -21600 0 -06} + {2798683200 -18000 1 -06} + {2816823600 -21600 0 -06} + {2830132800 -18000 1 -06} + {2848273200 -21600 0 -06} + {2861582400 -18000 1 -06} + {2879722800 -21600 0 -06} + {2893032000 -18000 1 -06} + {2911172400 -21600 0 -06} + {2924481600 -18000 1 -06} + {2943226800 -21600 0 -06} + {2955931200 -18000 1 -06} + {2974676400 -21600 0 -06} + {2987985600 -18000 1 -06} + {3006126000 -21600 0 -06} + {3019435200 -18000 1 -06} + {3037575600 -21600 0 -06} + {3050884800 -18000 1 -06} + {3069025200 -21600 0 -06} + {3082334400 -18000 1 -06} + {3101079600 -21600 0 -06} + {3113784000 -18000 1 -06} + {3132529200 -21600 0 -06} + {3145838400 -18000 1 -06} + {3163978800 -21600 0 -06} + {3177288000 -18000 1 -06} + {3195428400 -21600 0 -06} + {3208737600 -18000 1 -06} + {3226878000 -21600 0 -06} + {3240187200 -18000 1 -06} + {3258327600 -21600 0 -06} + {3271636800 -18000 1 -06} + {3290382000 -21600 0 -06} + {3303086400 -18000 1 -06} + {3321831600 -21600 0 -06} + {3335140800 -18000 1 -06} + {3353281200 -21600 0 -06} + {3366590400 -18000 1 -06} + {3384730800 -21600 0 -06} + {3398040000 -18000 1 -06} + {3416180400 -21600 0 -06} + {3429489600 -18000 1 -06} + {3447630000 -21600 0 -06} + {3460939200 -18000 1 -06} + {3479684400 -21600 0 -06} + {3492993600 -18000 1 -06} + {3511134000 -21600 0 -06} + {3524443200 -18000 1 -06} + {3542583600 -21600 0 -06} + {3555892800 -18000 1 -06} + {3574033200 -21600 0 -06} + {3587342400 -18000 1 -06} + {3605482800 -21600 0 -06} + {3618792000 -18000 1 -06} + {3637537200 -21600 0 -06} + {3650241600 -18000 1 -06} + {3668986800 -21600 0 -06} + {3682296000 -18000 1 -06} + {3700436400 -21600 0 -06} + {3713745600 -18000 1 -06} + {3731886000 -21600 0 -06} + {3745195200 -18000 1 -06} + {3763335600 -21600 0 -06} + {3776644800 -18000 1 -06} + {3794785200 -21600 0 -06} + {3808094400 -18000 1 -06} + {3826839600 -21600 0 -06} + {3839544000 -18000 1 -06} + {3858289200 -21600 0 -06} + {3871598400 -18000 1 -06} + {3889738800 -21600 0 -06} + {3903048000 -18000 1 -06} + {3921188400 -21600 0 -06} + {3934497600 -18000 1 -06} + {3952638000 -21600 0 -06} + {3965947200 -18000 1 -06} + {3984692400 -21600 0 -06} + {3997396800 -18000 1 -06} + {4016142000 -21600 0 -06} + {4029451200 -18000 1 -06} + {4047591600 -21600 0 -06} + {4060900800 -18000 1 -06} + {4079041200 -21600 0 -06} + {4092350400 -18000 1 -06} } diff --git a/library/tzdata/Pacific/Fiji b/library/tzdata/Pacific/Fiji index 610c191..b05985c 100644 --- a/library/tzdata/Pacific/Fiji +++ b/library/tzdata/Pacific/Fiji @@ -26,7 +26,7 @@ set TZData(:Pacific/Fiji) { {1509804000 46800 1 +12} {1515852000 43200 0 +12} {1541253600 46800 1 +12} - {1547906400 43200 0 +12} + {1547301600 43200 0 +12} {1572703200 46800 1 +12} {1579356000 43200 0 +12} {1604152800 46800 1 +12} @@ -48,7 +48,7 @@ set TZData(:Pacific/Fiji) { {1856959200 46800 1 +12} {1863007200 43200 0 +12} {1888408800 46800 1 +12} - {1895061600 43200 0 +12} + {1894456800 43200 0 +12} {1919858400 46800 1 +12} {1926511200 43200 0 +12} {1951308000 46800 1 +12} @@ -60,7 +60,7 @@ set TZData(:Pacific/Fiji) { {2046261600 46800 1 +12} {2052309600 43200 0 +12} {2077711200 46800 1 +12} - {2084364000 43200 0 +12} + {2083759200 43200 0 +12} {2109160800 46800 1 +12} {2115813600 43200 0 +12} {2140610400 46800 1 +12} @@ -70,7 +70,7 @@ set TZData(:Pacific/Fiji) { {2204114400 46800 1 +12} {2210162400 43200 0 +12} {2235564000 46800 1 +12} - {2242216800 43200 0 +12} + {2241612000 43200 0 +12} {2267013600 46800 1 +12} {2273666400 43200 0 +12} {2298463200 46800 1 +12} @@ -82,7 +82,7 @@ set TZData(:Pacific/Fiji) { {2393416800 46800 1 +12} {2399464800 43200 0 +12} {2424866400 46800 1 +12} - {2431519200 43200 0 +12} + {2430914400 43200 0 +12} {2456316000 46800 1 +12} {2462968800 43200 0 +12} {2487765600 46800 1 +12} @@ -104,7 +104,7 @@ set TZData(:Pacific/Fiji) { {2740572000 46800 1 +12} {2746620000 43200 0 +12} {2772021600 46800 1 +12} - {2778674400 43200 0 +12} + {2778069600 43200 0 +12} {2803471200 46800 1 +12} {2810124000 43200 0 +12} {2834920800 46800 1 +12} @@ -116,7 +116,7 @@ set TZData(:Pacific/Fiji) { {2929874400 46800 1 +12} {2935922400 43200 0 +12} {2961324000 46800 1 +12} - {2967976800 43200 0 +12} + {2967372000 43200 0 +12} {2992773600 46800 1 +12} {2999426400 43200 0 +12} {3024223200 46800 1 +12} @@ -126,7 +126,7 @@ set TZData(:Pacific/Fiji) { {3087727200 46800 1 +12} {3093775200 43200 0 +12} {3119176800 46800 1 +12} - {3125829600 43200 0 +12} + {3125224800 43200 0 +12} {3150626400 46800 1 +12} {3157279200 43200 0 +12} {3182076000 46800 1 +12} @@ -138,7 +138,7 @@ set TZData(:Pacific/Fiji) { {3277029600 46800 1 +12} {3283077600 43200 0 +12} {3308479200 46800 1 +12} - {3315132000 43200 0 +12} + {3314527200 43200 0 +12} {3339928800 46800 1 +12} {3346581600 43200 0 +12} {3371378400 46800 1 +12} @@ -160,7 +160,7 @@ set TZData(:Pacific/Fiji) { {3624184800 46800 1 +12} {3630232800 43200 0 +12} {3655634400 46800 1 +12} - {3662287200 43200 0 +12} + {3661682400 43200 0 +12} {3687084000 46800 1 +12} {3693736800 43200 0 +12} {3718533600 46800 1 +12} @@ -172,7 +172,7 @@ set TZData(:Pacific/Fiji) { {3813487200 46800 1 +12} {3819535200 43200 0 +12} {3844936800 46800 1 +12} - {3851589600 43200 0 +12} + {3850984800 43200 0 +12} {3876386400 46800 1 +12} {3883039200 43200 0 +12} {3907836000 46800 1 +12} @@ -182,7 +182,7 @@ set TZData(:Pacific/Fiji) { {3971340000 46800 1 +12} {3977388000 43200 0 +12} {4002789600 46800 1 +12} - {4009442400 43200 0 +12} + {4008837600 43200 0 +12} {4034239200 46800 1 +12} {4040892000 43200 0 +12} {4065688800 46800 1 +12} -- cgit v0.12 From fbc8feeb407fc9f2ddbf11fa089e56184952581f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 27 Oct 2018 19:33:40 +0000 Subject: Backport various minor issues from 8.6: - gcc compiler warning in tclDate.c - protect Tcl_UtfToUniCharDString() from ever reading more than "length" bytes from its input, not even in the case of invalid UTF-8. - update to latest tzdata - fix 2 failing test-cases on MacOSX --- generic/tclDate.c | 2 +- generic/tclUtf.c | 18 ++- library/tzdata/Africa/Casablanca | 280 ++++++++------------------------------- library/tzdata/Africa/El_Aaiun | 256 ++++++----------------------------- library/tzdata/Pacific/Honolulu | 5 +- tests/macOSXFCmd.test | 22 +-- 6 files changed, 127 insertions(+), 456 deletions(-) diff --git a/generic/tclDate.c b/generic/tclDate.c index 1adcf1e..2cf20d6 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -1348,7 +1348,7 @@ yyparse (info) int yychar; /* The semantic value of the look-ahead symbol. */ -YYSTYPE yylval; +YYSTYPE yylval = {0}; /* Number of syntax errors so far. */ int yynerrs; diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 656a6f0..1ef35a6 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -426,18 +426,28 @@ Tcl_UtfToUniCharDString( oldLength = Tcl_DStringLength(dsPtr); Tcl_DStringSetLength(dsPtr, - (int) ((oldLength + length + 1) * sizeof(Tcl_UniChar))); + oldLength + (int) ((length + 1) * sizeof(Tcl_UniChar))); wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength); w = wString; - end = src + length; - for (p = src; p < end; ) { + p = src; + end = src + length - TCL_UTF_MAX; + while (p < end) { p += TclUtfToUniChar(p, w); w++; } + end += TCL_UTF_MAX; + while (p < end) { + if (Tcl_UtfCharComplete(p, end-p)) { + p += TclUtfToUniChar(p, w); + } else { + *w = UCHAR(*p++); + } + w++; + } *w = '\0'; Tcl_DStringSetLength(dsPtr, - (oldLength + ((char *) w - (char *) wString))); + oldLength + ((char *) w - (char *) wString)); return wString; } diff --git a/library/tzdata/Africa/Casablanca b/library/tzdata/Africa/Casablanca index 33ad99b..3207e59 100644 --- a/library/tzdata/Africa/Casablanca +++ b/library/tzdata/Africa/Casablanca @@ -2,229 +2,59 @@ set TZData(:Africa/Casablanca) { {-9223372036854775808 -1820 0 LMT} - {-1773012580 0 0 WET} - {-956361600 3600 1 WEST} - {-950490000 0 0 WET} - {-942019200 3600 1 WEST} - {-761187600 0 0 WET} - {-617241600 3600 1 WEST} - {-605149200 0 0 WET} - {-81432000 3600 1 WEST} - {-71110800 0 0 WET} - {141264000 3600 1 WEST} - {147222000 0 0 WET} - {199756800 3600 1 WEST} - {207702000 0 0 WET} - {231292800 3600 1 WEST} - {244249200 0 0 WET} - {265507200 3600 1 WEST} - {271033200 0 0 WET} - {448243200 3600 0 CET} - {504918000 0 0 WET} - {1212278400 3600 1 WEST} - {1220223600 0 0 WET} - {1243814400 3600 1 WEST} - {1250809200 0 0 WET} - {1272758400 3600 1 WEST} - {1281222000 0 0 WET} - {1301788800 3600 1 WEST} - {1312066800 0 0 WET} - {1335664800 3600 1 WEST} - {1342749600 0 0 WET} - {1345428000 3600 1 WEST} - {1348970400 0 0 WET} - {1367114400 3600 1 WEST} - {1373162400 0 0 WET} - {1376100000 3600 1 WEST} - {1382839200 0 0 WET} - {1396144800 3600 1 WEST} - {1403920800 0 0 WET} - {1406944800 3600 1 WEST} - {1414288800 0 0 WET} - {1427594400 3600 1 WEST} - {1434247200 0 0 WET} - {1437271200 3600 1 WEST} - {1445738400 0 0 WET} - {1459044000 3600 1 WEST} - {1465092000 0 0 WET} - {1468116000 3600 1 WEST} - {1477792800 0 0 WET} - {1490493600 3600 1 WEST} - {1495332000 0 0 WET} - {1498960800 3600 1 WEST} - {1509242400 0 0 WET} - {1521943200 3600 1 WEST} - {1526176800 0 0 WET} - {1529200800 3600 1 WEST} - {1540692000 0 0 WET} - {1553997600 3600 1 WEST} - {1557021600 0 0 WET} - {1560045600 3600 1 WEST} - {1572141600 0 0 WET} - {1585447200 3600 1 WEST} - {1587261600 0 0 WET} - {1590285600 3600 1 WEST} - {1603591200 0 0 WET} - {1616896800 3600 1 WEST} - {1618106400 0 0 WET} - {1621130400 3600 1 WEST} - {1635645600 0 0 WET} - {1651975200 3600 1 WEST} - {1667095200 0 0 WET} - {1682215200 3600 1 WEST} - {1698544800 0 0 WET} - {1713060000 3600 1 WEST} - {1729994400 0 0 WET} - {1743904800 3600 1 WEST} - {1761444000 0 0 WET} - {1774749600 3600 1 WEST} - {1792893600 0 0 WET} - {1806199200 3600 1 WEST} - {1824948000 0 0 WET} - {1837648800 3600 1 WEST} - {1856397600 0 0 WET} - {1869098400 3600 1 WEST} - {1887847200 0 0 WET} - {1901152800 3600 1 WEST} - {1919296800 0 0 WET} - {1932602400 3600 1 WEST} - {1950746400 0 0 WET} - {1964052000 3600 1 WEST} - {1982800800 0 0 WET} - {1995501600 3600 1 WEST} - {2014250400 0 0 WET} - {2026951200 3600 1 WEST} - {2045700000 0 0 WET} - {2058400800 3600 1 WEST} - {2077149600 0 0 WET} - {2090455200 3600 1 WEST} - {2107994400 0 0 WET} - {2108602800 0 0 WET} - {2121904800 3600 1 WEST} - {2138234400 0 0 WET} - {2140052400 0 0 WET} - {2153354400 3600 1 WEST} - {2172103200 0 0 WET} - {2184804000 3600 1 WEST} - {2203552800 0 0 WET} - {2216253600 3600 1 WEST} - {2235002400 0 0 WET} - {2248308000 3600 1 WEST} - {2266452000 0 0 WET} - {2279757600 3600 1 WEST} - {2297901600 0 0 WET} - {2311207200 3600 1 WEST} - {2329351200 0 0 WET} - {2342656800 3600 1 WEST} - {2361405600 0 0 WET} - {2374106400 3600 1 WEST} - {2392855200 0 0 WET} - {2405556000 3600 1 WEST} - {2424304800 0 0 WET} - {2437610400 3600 1 WEST} - {2455754400 0 0 WET} - {2469060000 3600 1 WEST} - {2487204000 0 0 WET} - {2500509600 3600 1 WEST} - {2519258400 0 0 WET} - {2531959200 3600 1 WEST} - {2550708000 0 0 WET} - {2563408800 3600 1 WEST} - {2582157600 0 0 WET} - {2595463200 3600 1 WEST} - {2613607200 0 0 WET} - {2626912800 3600 1 WEST} - {2645056800 0 0 WET} - {2658362400 3600 1 WEST} - {2676506400 0 0 WET} - {2689812000 3600 1 WEST} - {2708560800 0 0 WET} - {2721261600 3600 1 WEST} - {2740010400 0 0 WET} - {2752711200 3600 1 WEST} - {2771460000 0 0 WET} - {2784765600 3600 1 WEST} - {2802909600 0 0 WET} - {2816215200 3600 1 WEST} - {2834359200 0 0 WET} - {2847664800 3600 1 WEST} - {2866413600 0 0 WET} - {2879114400 3600 1 WEST} - {2897863200 0 0 WET} - {2910564000 3600 1 WEST} - {2929312800 0 0 WET} - {2942013600 3600 1 WEST} - {2960762400 0 0 WET} - {2974068000 3600 1 WEST} - {2992212000 0 0 WET} - {3005517600 3600 1 WEST} - {3023661600 0 0 WET} - {3036967200 3600 1 WEST} - {3055716000 0 0 WET} - {3068416800 3600 1 WEST} - {3087165600 0 0 WET} - {3099866400 3600 1 WEST} - {3118615200 0 0 WET} - {3131920800 3600 1 WEST} - {3150064800 0 0 WET} - {3163370400 3600 1 WEST} - {3181514400 0 0 WET} - {3194820000 3600 1 WEST} - {3212964000 0 0 WET} - {3226269600 3600 1 WEST} - {3245018400 0 0 WET} - {3257719200 3600 1 WEST} - {3276468000 0 0 WET} - {3289168800 3600 1 WEST} - {3307917600 0 0 WET} - {3321223200 3600 1 WEST} - {3339367200 0 0 WET} - {3352672800 3600 1 WEST} - {3370816800 0 0 WET} - {3384122400 3600 1 WEST} - {3402871200 0 0 WET} - {3415572000 3600 1 WEST} - {3434320800 0 0 WET} - {3447021600 3600 1 WEST} - {3465770400 0 0 WET} - {3479076000 3600 1 WEST} - {3497220000 0 0 WET} - {3510525600 3600 1 WEST} - {3528669600 0 0 WET} - {3541975200 3600 1 WEST} - {3560119200 0 0 WET} - {3573424800 3600 1 WEST} - {3592173600 0 0 WET} - {3604874400 3600 1 WEST} - {3623623200 0 0 WET} - {3636324000 3600 1 WEST} - {3655072800 0 0 WET} - {3668378400 3600 1 WEST} - {3686522400 0 0 WET} - {3699828000 3600 1 WEST} - {3717972000 0 0 WET} - {3731277600 3600 1 WEST} - {3750026400 0 0 WET} - {3762727200 3600 1 WEST} - {3781476000 0 0 WET} - {3794176800 3600 1 WEST} - {3812925600 0 0 WET} - {3825626400 3600 1 WEST} - {3844375200 0 0 WET} - {3857680800 3600 1 WEST} - {3875824800 0 0 WET} - {3889130400 3600 1 WEST} - {3907274400 0 0 WET} - {3920580000 3600 1 WEST} - {3939328800 0 0 WET} - {3952029600 3600 1 WEST} - {3970778400 0 0 WET} - {3983479200 3600 1 WEST} - {4002228000 0 0 WET} - {4015533600 3600 1 WEST} - {4033677600 0 0 WET} - {4046983200 3600 1 WEST} - {4065127200 0 0 WET} - {4078432800 3600 1 WEST} - {4096576800 0 0 WET} + {-1773012580 0 0 +00} + {-956361600 3600 1 +00} + {-950490000 0 0 +00} + {-942019200 3600 1 +00} + {-761187600 0 0 +00} + {-617241600 3600 1 +00} + {-605149200 0 0 +00} + {-81432000 3600 1 +00} + {-71110800 0 0 +00} + {141264000 3600 1 +00} + {147222000 0 0 +00} + {199756800 3600 1 +00} + {207702000 0 0 +00} + {231292800 3600 1 +00} + {244249200 0 0 +00} + {265507200 3600 1 +00} + {271033200 0 0 +00} + {448243200 3600 0 +01} + {504918000 0 0 +00} + {1212278400 3600 1 +00} + {1220223600 0 0 +00} + {1243814400 3600 1 +00} + {1250809200 0 0 +00} + {1272758400 3600 1 +00} + {1281222000 0 0 +00} + {1301788800 3600 1 +00} + {1312066800 0 0 +00} + {1335664800 3600 1 +00} + {1342749600 0 0 +00} + {1345428000 3600 1 +00} + {1348970400 0 0 +00} + {1367114400 3600 1 +00} + {1373162400 0 0 +00} + {1376100000 3600 1 +00} + {1382839200 0 0 +00} + {1396144800 3600 1 +00} + {1403920800 0 0 +00} + {1406944800 3600 1 +00} + {1414288800 0 0 +00} + {1427594400 3600 1 +00} + {1434247200 0 0 +00} + {1437271200 3600 1 +00} + {1445738400 0 0 +00} + {1459044000 3600 1 +00} + {1465092000 0 0 +00} + {1468116000 3600 1 +00} + {1477792800 0 0 +00} + {1490493600 3600 1 +00} + {1495332000 0 0 +00} + {1498960800 3600 1 +00} + {1509242400 0 0 +00} + {1521943200 3600 1 +00} + {1526176800 0 0 +00} + {1529200800 3600 1 +00} + {1540598400 3600 0 +01} } diff --git a/library/tzdata/Africa/El_Aaiun b/library/tzdata/Africa/El_Aaiun index 7bdc496..e0f5e1c 100644 --- a/library/tzdata/Africa/El_Aaiun +++ b/library/tzdata/Africa/El_Aaiun @@ -3,217 +3,47 @@ set TZData(:Africa/El_Aaiun) { {-9223372036854775808 -3168 0 LMT} {-1136070432 -3600 0 -01} - {198291600 0 0 WET} - {199756800 3600 1 WEST} - {207702000 0 0 WET} - {231292800 3600 1 WEST} - {244249200 0 0 WET} - {265507200 3600 1 WEST} - {271033200 0 0 WET} - {1212278400 3600 1 WEST} - {1220223600 0 0 WET} - {1243814400 3600 1 WEST} - {1250809200 0 0 WET} - {1272758400 3600 1 WEST} - {1281222000 0 0 WET} - {1301788800 3600 1 WEST} - {1312066800 0 0 WET} - {1335664800 3600 1 WEST} - {1342749600 0 0 WET} - {1345428000 3600 1 WEST} - {1348970400 0 0 WET} - {1367114400 3600 1 WEST} - {1373162400 0 0 WET} - {1376100000 3600 1 WEST} - {1382839200 0 0 WET} - {1396144800 3600 1 WEST} - {1403920800 0 0 WET} - {1406944800 3600 1 WEST} - {1414288800 0 0 WET} - {1427594400 3600 1 WEST} - {1434247200 0 0 WET} - {1437271200 3600 1 WEST} - {1445738400 0 0 WET} - {1459044000 3600 1 WEST} - {1465092000 0 0 WET} - {1468116000 3600 1 WEST} - {1477792800 0 0 WET} - {1490493600 3600 1 WEST} - {1495332000 0 0 WET} - {1498960800 3600 1 WEST} - {1509242400 0 0 WET} - {1521943200 3600 1 WEST} - {1526176800 0 0 WET} - {1529200800 3600 1 WEST} - {1540692000 0 0 WET} - {1553997600 3600 1 WEST} - {1557021600 0 0 WET} - {1560045600 3600 1 WEST} - {1572141600 0 0 WET} - {1585447200 3600 1 WEST} - {1587261600 0 0 WET} - {1590285600 3600 1 WEST} - {1603591200 0 0 WET} - {1616896800 3600 1 WEST} - {1618106400 0 0 WET} - {1621130400 3600 1 WEST} - {1635645600 0 0 WET} - {1651975200 3600 1 WEST} - {1667095200 0 0 WET} - {1682215200 3600 1 WEST} - {1698544800 0 0 WET} - {1713060000 3600 1 WEST} - {1729994400 0 0 WET} - {1743904800 3600 1 WEST} - {1761444000 0 0 WET} - {1774749600 3600 1 WEST} - {1792893600 0 0 WET} - {1806199200 3600 1 WEST} - {1824948000 0 0 WET} - {1837648800 3600 1 WEST} - {1856397600 0 0 WET} - {1869098400 3600 1 WEST} - {1887847200 0 0 WET} - {1901152800 3600 1 WEST} - {1919296800 0 0 WET} - {1932602400 3600 1 WEST} - {1950746400 0 0 WET} - {1964052000 3600 1 WEST} - {1982800800 0 0 WET} - {1995501600 3600 1 WEST} - {2014250400 0 0 WET} - {2026951200 3600 1 WEST} - {2045700000 0 0 WET} - {2058400800 3600 1 WEST} - {2077149600 0 0 WET} - {2090455200 3600 1 WEST} - {2107994400 0 0 WET} - {2108602800 0 0 WET} - {2121904800 3600 1 WEST} - {2138234400 0 0 WET} - {2140052400 0 0 WET} - {2153354400 3600 1 WEST} - {2172103200 0 0 WET} - {2184804000 3600 1 WEST} - {2203552800 0 0 WET} - {2216253600 3600 1 WEST} - {2235002400 0 0 WET} - {2248308000 3600 1 WEST} - {2266452000 0 0 WET} - {2279757600 3600 1 WEST} - {2297901600 0 0 WET} - {2311207200 3600 1 WEST} - {2329351200 0 0 WET} - {2342656800 3600 1 WEST} - {2361405600 0 0 WET} - {2374106400 3600 1 WEST} - {2392855200 0 0 WET} - {2405556000 3600 1 WEST} - {2424304800 0 0 WET} - {2437610400 3600 1 WEST} - {2455754400 0 0 WET} - {2469060000 3600 1 WEST} - {2487204000 0 0 WET} - {2500509600 3600 1 WEST} - {2519258400 0 0 WET} - {2531959200 3600 1 WEST} - {2550708000 0 0 WET} - {2563408800 3600 1 WEST} - {2582157600 0 0 WET} - {2595463200 3600 1 WEST} - {2613607200 0 0 WET} - {2626912800 3600 1 WEST} - {2645056800 0 0 WET} - {2658362400 3600 1 WEST} - {2676506400 0 0 WET} - {2689812000 3600 1 WEST} - {2708560800 0 0 WET} - {2721261600 3600 1 WEST} - {2740010400 0 0 WET} - {2752711200 3600 1 WEST} - {2771460000 0 0 WET} - {2784765600 3600 1 WEST} - {2802909600 0 0 WET} - {2816215200 3600 1 WEST} - {2834359200 0 0 WET} - {2847664800 3600 1 WEST} - {2866413600 0 0 WET} - {2879114400 3600 1 WEST} - {2897863200 0 0 WET} - {2910564000 3600 1 WEST} - {2929312800 0 0 WET} - {2942013600 3600 1 WEST} - {2960762400 0 0 WET} - {2974068000 3600 1 WEST} - {2992212000 0 0 WET} - {3005517600 3600 1 WEST} - {3023661600 0 0 WET} - {3036967200 3600 1 WEST} - {3055716000 0 0 WET} - {3068416800 3600 1 WEST} - {3087165600 0 0 WET} - {3099866400 3600 1 WEST} - {3118615200 0 0 WET} - {3131920800 3600 1 WEST} - {3150064800 0 0 WET} - {3163370400 3600 1 WEST} - {3181514400 0 0 WET} - {3194820000 3600 1 WEST} - {3212964000 0 0 WET} - {3226269600 3600 1 WEST} - {3245018400 0 0 WET} - {3257719200 3600 1 WEST} - {3276468000 0 0 WET} - {3289168800 3600 1 WEST} - {3307917600 0 0 WET} - {3321223200 3600 1 WEST} - {3339367200 0 0 WET} - {3352672800 3600 1 WEST} - {3370816800 0 0 WET} - {3384122400 3600 1 WEST} - {3402871200 0 0 WET} - {3415572000 3600 1 WEST} - {3434320800 0 0 WET} - {3447021600 3600 1 WEST} - {3465770400 0 0 WET} - {3479076000 3600 1 WEST} - {3497220000 0 0 WET} - {3510525600 3600 1 WEST} - {3528669600 0 0 WET} - {3541975200 3600 1 WEST} - {3560119200 0 0 WET} - {3573424800 3600 1 WEST} - {3592173600 0 0 WET} - {3604874400 3600 1 WEST} - {3623623200 0 0 WET} - {3636324000 3600 1 WEST} - {3655072800 0 0 WET} - {3668378400 3600 1 WEST} - {3686522400 0 0 WET} - {3699828000 3600 1 WEST} - {3717972000 0 0 WET} - {3731277600 3600 1 WEST} - {3750026400 0 0 WET} - {3762727200 3600 1 WEST} - {3781476000 0 0 WET} - {3794176800 3600 1 WEST} - {3812925600 0 0 WET} - {3825626400 3600 1 WEST} - {3844375200 0 0 WET} - {3857680800 3600 1 WEST} - {3875824800 0 0 WET} - {3889130400 3600 1 WEST} - {3907274400 0 0 WET} - {3920580000 3600 1 WEST} - {3939328800 0 0 WET} - {3952029600 3600 1 WEST} - {3970778400 0 0 WET} - {3983479200 3600 1 WEST} - {4002228000 0 0 WET} - {4015533600 3600 1 WEST} - {4033677600 0 0 WET} - {4046983200 3600 1 WEST} - {4065127200 0 0 WET} - {4078432800 3600 1 WEST} - {4096576800 0 0 WET} + {198291600 0 0 +00} + {199756800 3600 1 +00} + {207702000 0 0 +00} + {231292800 3600 1 +00} + {244249200 0 0 +00} + {265507200 3600 1 +00} + {271033200 0 0 +00} + {1212278400 3600 1 +00} + {1220223600 0 0 +00} + {1243814400 3600 1 +00} + {1250809200 0 0 +00} + {1272758400 3600 1 +00} + {1281222000 0 0 +00} + {1301788800 3600 1 +00} + {1312066800 0 0 +00} + {1335664800 3600 1 +00} + {1342749600 0 0 +00} + {1345428000 3600 1 +00} + {1348970400 0 0 +00} + {1367114400 3600 1 +00} + {1373162400 0 0 +00} + {1376100000 3600 1 +00} + {1382839200 0 0 +00} + {1396144800 3600 1 +00} + {1403920800 0 0 +00} + {1406944800 3600 1 +00} + {1414288800 0 0 +00} + {1427594400 3600 1 +00} + {1434247200 0 0 +00} + {1437271200 3600 1 +00} + {1445738400 0 0 +00} + {1459044000 3600 1 +00} + {1465092000 0 0 +00} + {1468116000 3600 1 +00} + {1477792800 0 0 +00} + {1490493600 3600 1 +00} + {1495332000 0 0 +00} + {1498960800 3600 1 +00} + {1509242400 0 0 +00} + {1521943200 3600 1 +00} + {1526176800 0 0 +00} + {1529200800 3600 1 +00} + {1540598400 3600 0 +01} } diff --git a/library/tzdata/Pacific/Honolulu b/library/tzdata/Pacific/Honolulu index 5e70598..7d03b45 100644 --- a/library/tzdata/Pacific/Honolulu +++ b/library/tzdata/Pacific/Honolulu @@ -4,8 +4,9 @@ set TZData(:Pacific/Honolulu) { {-9223372036854775808 -37886 0 LMT} {-2334101314 -37800 0 HST} {-1157283000 -34200 1 HDT} - {-1155436200 -37800 0 HST} - {-880198200 -34200 1 HDT} + {-1155436200 -34200 0 HST} + {-880201800 -34200 1 HWT} + {-769395600 -34200 1 HPT} {-765376200 -37800 0 HST} {-712150200 -36000 0 HST} } diff --git a/tests/macOSXFCmd.test b/tests/macOSXFCmd.test index 071f11b..f1758f5 100644 --- a/tests/macOSXFCmd.test +++ b/tests/macOSXFCmd.test @@ -99,7 +99,7 @@ test macOSXFCmd-2.6 {MacOSXSetFileAttribute - hidden} {macosxFileAttr notRoot} { [catch {file attributes foo.test -hidden} msg] $msg \ [file delete -force -- foo.test] } {0 {} 0 1 {}} -test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot} { +test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot nonPortable} { catch {file delete -force -- foo.test} close [open foo.test w] catch { @@ -151,16 +151,16 @@ test macOSXFCmd-4.1 {TclMacOSXMatchType} {macosxFileAttr notRoot} { file attributes dir.test -hidden 1 } set res [list \ - [catch {glob *.test} msg] $msg \ - [catch {glob -types FOOT *.test} msg] $msg \ - [catch {glob -types {{macintosh type FOOT}} *.test} msg] $msg \ - [catch {glob -types FOOTT *.test} msg] $msg \ - [catch {glob -types {{macintosh type FOOTT}} *.test} msg] $msg \ - [catch {glob -types {{macintosh type {}}} *.test} msg] $msg \ - [catch {glob -types {{macintosh creator FOOC}} *.test} msg] $msg \ - [catch {glob -types {{macintosh creator FOOC} {macintosh type FOOT}} *.test} msg] $msg \ - [catch {glob -types hidden *.test} msg] $msg \ - [catch {glob -types {hidden FOOT} *.test} msg] $msg \ + [catch {lsort [glob *.test]} msg] $msg \ + [catch {lsort [glob -types FOOT *.test]} msg] $msg \ + [catch {lsort [glob -types {{macintosh type FOOT}} *.test]} msg] $msg \ + [catch {lsort [glob -types FOOTT *.test]} msg] $msg \ + [catch {lsort [glob -types {{macintosh type FOOTT}} *.test]} msg] $msg \ + [catch {lsort [glob -types {{macintosh type {}}} *.test]} msg] $msg \ + [catch {lsort [glob -types {{macintosh creator FOOC}} *.test]} msg] $msg \ + [catch {lsort [glob -types {{macintosh creator FOOC} {macintosh type FOOT}} *.test]} msg] $msg \ + [catch {lsort [glob -types hidden *.test]} msg] $msg \ + [catch {lsort [glob -types {hidden FOOT} *.test]} msg] $msg \ ] cd .. file delete -force globtest -- cgit v0.12 From 97ed5b117d97994ac272d663a4c754ab73afeace Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 27 Oct 2018 19:36:22 +0000 Subject: (temporary) backout [0386db909a]: Enable CI builds with Travis. This enables everything else to merge-marked to 8.6. Will put it back in the next commit --- README | 185 ++++++++++++++++++++++++++++++++++++++++++++ library/tcltest/tcltest.tcl | 4 +- tests/all.tcl | 4 +- 3 files changed, 188 insertions(+), 5 deletions(-) create mode 100644 README diff --git a/README b/README new file mode 100644 index 0000000..c71d177 --- /dev/null +++ b/README @@ -0,0 +1,185 @@ +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 f69ffd2..936acaa 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -2700,7 +2700,7 @@ proc tcltest::GetMatchingDirectories {rootdir} { # shell being tested # # Results: -# Whether there were any failures. +# None. # # Side effects: # None. @@ -2846,7 +2846,7 @@ proc tcltest::runAllTests { {shell ""} } { puts [outputChannel] "" puts [outputChannel] [string repeat ~ 44] } - return [info exists testFileFailures] + return } ##################################################################### diff --git a/tests/all.tcl b/tests/all.tcl index f3463c6..d01a54d 100644 --- a/tests/all.tcl +++ b/tests/all.tcl @@ -14,6 +14,4 @@ package require Tcl 8.5 package require tcltest 2.2 namespace import tcltest::* configure {*}$argv -testdir [file dir [info script]] -set ErrorOnFailures [info exists env(ERROR_ON_FAILURES)] -unset -nocomplain env(ERROR_ON_FAILURES) -if {[runAllTests] && $ErrorOnFailures} {exit 1} +runAllTests -- cgit v0.12