Itcl - the [incr Tcl] extension

Check-in [bb070ae8b6]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:merge trunk (all tests now available in dev-environment)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | sebres-memopt-perf-branch
Files: files | file ages | folders
SHA3-256: bb070ae8b6d70fc9943b24211e1975be84db8785c2dc1edbae79da29684ae9d8
User & Date: sebres 2019-02-08 18:50:47
Context
2019-02-08
23:59
merge trunk, no segfaults anymore (applied stashes, looks good, so WiP) check-in: 2b6eae425d user: sebres tags: sebres-memopt-perf-branch
18:50
merge trunk (all tests now available in dev-environment) check-in: bb070ae8b6 user: sebres tags: sebres-memopt-perf-branch
17:59
fixes [87a89c9a927db943]: apply "-load" test-option for child interpreter in tests "sfbug-254" and "sfbug-257" (provides library-path to pkgIndex or loads Itcl directly). check-in: 0155e66402 user: sebres tags: trunk
2019-02-07
23:39
amend to [734b2ff2e3]: fix release, ckfree -> ItclCkfree (without in-between temp automation in tcl-core) check-in: befa6a2d70 user: sebres tags: sebres-memopt-perf-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/itclHelpers.c.

124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
	    arglistPtr = NULL;
	    if (defaultArgc == 0 || defaultArgv[0][0] == '\0') {
		if (commandName != NULL) {
	            Tcl_AppendResult(interp, "procedure \"",
		            commandName,
			    "\" has argument with no name", NULL);
		} else {
		    char buf[10+1];
		    sprintf(buf, "%d", i);
		    Tcl_AppendResult(interp, "argument #", buf,
		            " has no name", NULL);
		}
	        result = TCL_ERROR;
	        break;
	    }






|







124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
	    arglistPtr = NULL;
	    if (defaultArgc == 0 || defaultArgv[0][0] == '\0') {
		if (commandName != NULL) {
	            Tcl_AppendResult(interp, "procedure \"",
		            commandName,
			    "\" has argument with no name", NULL);
		} else {
		    char buf[TCL_INTEGER_SPACE];
		    sprintf(buf, "%d", i);
		    Tcl_AppendResult(interp, "argument #", buf,
		            " has no name", NULL);
		}
	        result = TCL_ERROR;
	        break;
	    }

Changes to tests/sfbugs.test.

270
271
272
273
274
275
276

277
278
279
280
281
282
283
...
363
364
365
366
367
368
369

370
371
372
373
374
375
376
    [foo #auto] kerplunk hello world
} -result {{foo0 kerplunk hello world} {foo0 kerplunk hello world} {foo0 kerplunk hello world}} \
  -cleanup {::itcl::delete class foo}

test sfbug-254 { SF bug #254
} -body {
    set interp [interp create]

    $interp eval {
      package require itcl

      set ::test_status ""
      oo::class destroy
      lappend ::test_status "::oo::class destroy worked"
    }
................................................................................
    [::sfbug_256_testclass tc] api-call
} -result {TestClass::api-call TestClass::internal-helper value {TestClass::api-call TestClass::internal-helper value} TestClass::internal-helper value {TestClass::api-call TestClass::internal-helper value {TestClass::api-call TestClass::internal-helper value} TestClass::internal-helper value} value value} \
  -cleanup {::itcl::delete class TestClass256}

test sfbug-257 { SF bug #257
} -body {
    set interp [interp create]

    $interp eval {
      package require itcl
      set ::test_status ""
      ::itcl::class ::cl1 {
        method m1 {} {
          ::oo::class destroy
          lappend ::test_status "method Hello World"






>







 







>







270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
...
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
    [foo #auto] kerplunk hello world
} -result {{foo0 kerplunk hello world} {foo0 kerplunk hello world} {foo0 kerplunk hello world}} \
  -cleanup {::itcl::delete class foo}

test sfbug-254 { SF bug #254
} -body {
    set interp [interp create]
    $interp eval [::tcltest::loadScript]
    $interp eval {
      package require itcl

      set ::test_status ""
      oo::class destroy
      lappend ::test_status "::oo::class destroy worked"
    }
................................................................................
    [::sfbug_256_testclass tc] api-call
} -result {TestClass::api-call TestClass::internal-helper value {TestClass::api-call TestClass::internal-helper value} TestClass::internal-helper value {TestClass::api-call TestClass::internal-helper value {TestClass::api-call TestClass::internal-helper value} TestClass::internal-helper value} value value} \
  -cleanup {::itcl::delete class TestClass256}

test sfbug-257 { SF bug #257
} -body {
    set interp [interp create]
    $interp eval [::tcltest::loadScript]
    $interp eval {
      package require itcl
      set ::test_status ""
      ::itcl::class ::cl1 {
        method m1 {} {
          ::oo::class destroy
          lappend ::test_status "method Hello World"