Tcl Source Code

Check-in [cc7f2babeb]
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Fix Bug #3545367: DDE test failures It turns out that "dde poke" had the same bug, unfortunately we cannot make a test-case for that. Also modified more test-cases to use unicode variable names, so we can more reliably detect this
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: cc7f2babebef487a31e05bea4feaa0a83ae880e6
User & Date: jan.nijtmans 2012-08-02 09:54:22
Context
2012-08-03
10:56
converting to using Tcl_Obj API for error message generation; part done check-in: 7fb86a29c9 user: dkf tags: trunk
2012-08-02
12:54
merge trunk check-in: 15da7fc903 user: jan.nijtmans tags: tip-402
12:08
merge trunk check-in: d62cfbac77 user: jan.nijtmans tags: frq-3527238
09:54
Fix Bug #3545367: DDE test failures It turns out that "dde poke" had the same bug, unfortunately we ... check-in: cc7f2babeb user: jan.nijtmans tags: trunk
2012-08-01
14:53
Fix Bug #3545367: DDE test failures check-in: bc4b7b1b91 user: jan.nijtmans tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/winDde.test.

︙︙
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167

test winDde-3.2 {DDE execute -async locally} -constraints dde -body {
    set \xe1 ""
    dde execute -async TclEval self [list set \xe1 foo]
    update
    set \xe1
} -result foo
test winDde-3.3 {DDE request locally} -constraints dde -body {
    set a ""
    dde execute TclEval self [list set a foo]
    dde request TclEval self a
} -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 a ""
    dde execute TclEval self [list set a foo]
    dde request -binary TclEval self a
} -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 a "not set"
    dde execute TclEval self "set a \xc4"
    scan $a %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 a "not set"
    dde execute -binary TclEval self [list set a \xc3\x84\x00]
    scan $a %c








|
|
|






|
|
|




|
|
|








135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167

test winDde-3.2 {DDE execute -async locally} -constraints dde -body {
    set \xe1 ""
    dde execute -async TclEval self [list set \xe1 foo]
    update
    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 a "not set"
    dde execute -binary TclEval self [list set a \xc3\x84\x00]
    scan $a %c
︙︙
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215

    dde execute -async TclEval $name [list set \xe1 foo]
    update
    dde execute TclEval $name {set done 1}
    update
    set \xe1
} -result ""
test winDde-4.3 {DDE request remotely} -constraints {dde stdio} -body {
    set a ""
    set name ch\xEDld-4.3
    set child [createChildProcess $name]
    dde execute TclEval $name [list set a foo]
    set a [dde request TclEval $name a]
    dde execute TclEval $name {set done 1}
    update
    set a
} -result foo
test winDde-4.4 {DDE eval remotely} -constraints {dde stdio} -body {
    set a ""
    set name ch\xEDld-4.4
    set child [createChildProcess $name]
    set a [dde eval $name set a foo]
    dde execute TclEval $name {set done 1}
    update
    set a
}  -result foo

# -------------------------------------------------------------------------

test winDde-5.1 {check for bad arguments} -constraints dde -body {
    dde execute "" "" "" ""
} -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"}








|



|


|


|


|


|








185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215

    dde execute -async TclEval $name [list set \xe1 foo]
    update
    dde execute TclEval $name {set done 1}
    update
    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 a foo]
    set \xe1 [dde request TclEval $name a]
    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]
    set \xe1 [dde eval $name set a foo]
    dde execute TclEval $name {set done 1}
    update
    set \xe1
}  -result foo

# -------------------------------------------------------------------------

test winDde-5.1 {check for bad arguments} -constraints dde -body {
    dde execute "" "" "" ""
} -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"}
︙︙

Changes to win/tclWinDde.c.

︙︙
1479
1480
1481
1482
1483
1484
1485




1486
1487

1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513

	} else {
	    SetDdeError(interp);
	    result = TCL_ERROR;
	}
	break;
    }
    case DDE_REQUEST: {




	const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
		&length);


	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;
	}
	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
	DdeFreeStringHandle(ddeInstance, ddeService);
	DdeFreeStringHandle(ddeInstance, ddeTopic);

	if (hConv == NULL) {
	    SetDdeError(interp);
	    result = TCL_ERROR;
	} else {
	    Tcl_Obj *returnObjPtr;
	    ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString,
		    CP_WINANSI);
	    if (ddeItem != NULL) {
		ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
			CF_TEXT, XTYP_REQUEST, 5000, NULL);
		if (ddeData == NULL) {
		    SetDdeError(interp);
		    result = TCL_ERROR;
		} else {








>
>
>
>
|

>


















|








1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518

	} else {
	    SetDdeError(interp);
	    result = TCL_ERROR;
	}
	break;
    }
    case DDE_REQUEST: {
#ifdef UNICODE
	const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2],
		&length);
#else
	const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
		&length);
#endif

	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;
	}
	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
	DdeFreeStringHandle(ddeInstance, ddeService);
	DdeFreeStringHandle(ddeInstance, ddeTopic);

	if (hConv == NULL) {
	    SetDdeError(interp);
	    result = TCL_ERROR;
	} else {
	    Tcl_Obj *returnObjPtr;
	    ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString,
		    CP_WINUNICODE);
	    if (ddeItem != NULL) {
		ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
			CF_TEXT, XTYP_REQUEST, 5000, NULL);
		if (ddeData == NULL) {
		    SetDdeError(interp);
		    result = TCL_ERROR;
		} else {
︙︙
1533
1534
1535
1536
1537
1538
1539




1540
1541

1542
1543
1544
1545
1546
1547
1548

		result = TCL_ERROR;
	    }
	}

	break;
    }
    case DDE_POKE: {




	const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
		&length);

	BYTE *dataString;

	if (length == 0) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot have a null item", -1));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;








>
>
>
>
|

>








1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558

		result = TCL_ERROR;
	    }
	}

	break;
    }
    case DDE_POKE: {
#ifdef UNICODE
	const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2],
		&length);
#else
	const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
		&length);
#endif
	BYTE *dataString;

	if (length == 0) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot have a null item", -1));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
︙︙

This page was generated in about 0.019s by Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19