From 859e9838d18c82b7c6fbcc1c9af736f6be73aecb Mon Sep 17 00:00:00 2001 From: Kevin B Kenny Date: Fri, 2 Apr 2010 19:27:44 +0000 Subject: * library/reg/pkgIndex.tcl: [TIP #362]: Fixed first round of * tests/registry.test: bugs resulting from the recent commits * win/tclWinReg.c: of changes in support of the referenced TIP. --- ChangeLog | 5 +++++ library/reg/pkgIndex.tcl | 4 ++-- tests/registry.test | 10 +++++----- win/tclWinReg.c | 16 ++++++++-------- 4 files changed, 20 insertions(+), 15 deletions(-) diff --git a/ChangeLog b/ChangeLog index 7997e27..cfeb154 100644 --- a/ChangeLog +++ b/ChangeLog @@ -4,6 +4,11 @@ floating point number until it is actually used. (This change avoids a bogus syslog message regarding a 'floating point software assist fault' on SGI systems.) + + * library/reg/pkgIndex.tcl: [TIP #362]: Fixed first round of + * tests/registry.test: bugs resulting from the recent commits + * win/tclWinReg.c: of changes in support of the referenced + TIP. 2010-03-31 Donal K. Fellows diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl index c24e700..f07dee4 100755 --- a/library/reg/pkgIndex.tcl +++ b/library/reg/pkgIndex.tcl @@ -2,8 +2,8 @@ if {![package vsatisfies [package provide Tcl] 8]} {return} if {[string compare $::tcl_platform(platform) windows]} {return} if {[info exists ::tcl_platform(debug)]} { package ifneeded registry 1.3 \ - [list load [file join $dir tclreg12g.dll] registry] + [list load [file join $dir tclreg13g.dll] registry] } else { package ifneeded registry 1.3 \ - [list load [file join $dir tclreg12.dll] registry] + [list load [file join $dir tclreg13.dll] registry] } diff --git a/tests/registry.test b/tests/registry.test index 8a7c4d4..02866f3 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -10,7 +10,7 @@ # Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# RCS: @(#) $Id: registry.test,v 1.25 2010/03/30 12:33:47 dkf Exp $ +# RCS: @(#) $Id: registry.test,v 1.26 2010/04/02 19:27:44 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -50,7 +50,7 @@ test registry-1.2 {argument parsing for registry command} {win reg} { } {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 option "-33bit": must be broadcast, delete, get, keys, set, type, or values}} +} {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 @@ -662,13 +662,13 @@ test registry-11.3 {SetValue: failure} \ test registry-12.1 {BroadcastValue} -constraints {win reg} -body { registry broadcast -} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout millisecs?\"" +} -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 millisecs?\"" +} -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 millisecs?\"" +} -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} diff --git a/win/tclWinReg.c b/win/tclWinReg.c index d7eeae6..a2d9085 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinReg.c,v 1.52 2010/03/30 12:38:30 dkf Exp $ + * RCS: @(#) $Id: tclWinReg.c,v 1.53 2010/04/02 19:27:44 kennykb Exp $ */ #undef STATIC_BUILD @@ -409,13 +409,13 @@ RegistryObjCmd( if (argc == 1) { return DeleteKey(interp, objv[n], mode); } else if (argc == 2) { - return DeleteValue(interp, objv[n], objv[++n], mode); + return DeleteValue(interp, objv[n], objv[n+1], mode); } errString = "keyName ?valueName?"; break; case GetIdx: /* get */ if (argc == 2) { - return GetValue(interp, objv[n], objv[++n], mode); + return GetValue(interp, objv[n], objv[n+1], mode); } errString = "keyName valueName"; break; @@ -423,7 +423,7 @@ RegistryObjCmd( if (argc == 1) { return GetKeyNames(interp, objv[n], NULL, mode); } else if (argc == 2) { - return GetKeyNames(interp, objv[n], objv[++n], mode); + return GetKeyNames(interp, objv[n], objv[n+1], mode); } errString = "keyName ?pattern?"; break; @@ -442,17 +442,17 @@ RegistryObjCmd( RegCloseKey(key); return TCL_OK; } else if (argc == 3) { - return SetValue(interp, objv[n], objv[++n], objv[++n], NULL, + return SetValue(interp, objv[n], objv[n+1], objv[n+2], NULL, mode); } else if (argc == 4) { - return SetValue(interp, objv[n], objv[++n], objv[++n], objv[++n], + 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 (argc == 2) { - return GetType(interp, objv[n], objv[++n], mode); + return GetType(interp, objv[n], objv[n+1], mode); } errString = "keyName valueName"; break; @@ -460,7 +460,7 @@ RegistryObjCmd( if (argc == 1) { return GetValueNames(interp, objv[n], NULL, mode); } else if (argc == 2) { - return GetValueNames(interp, objv[n], objv[++n], mode); + return GetValueNames(interp, objv[n], objv[n+1], mode); } errString = "keyName ?pattern?"; break; -- cgit v0.12