Tcl Source Code

View Ticket
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Ticket UUID: 0f42ff78717afacc72710ec0c79aa71a48abb5f3
Title: [tailcall] punches through [next]
Type: Bug Version: 8.6.2 and later
Submitter: anonymous Created on: 2015-04-08 14:29:47
Subsystem: 60. NRE and coroutines Assigned To: aku
Priority: 5 Medium Severity: Severe
Status: Closed Last Modified: 2015-05-15 14:42:00
Resolution: Fixed Closed By: dkf
    Closed on: 2015-05-15 14:42:00
Description:
This might smell a bit similar to [d87cb1820]?

Replacing the [next] calls with [set next next; $next] removes the error.

dgp identified [4492d3b64521] as the checkin which identified this
behaviour with bytecoded [next].

    oo::class create Foo {
        method five {} {
            tailcall expr 5
        }
    }
    oo::class create Unfoo {
        superclass Foo
        method five {} {
            return -[next]
        }
    }
    Unfoo create fu
    puts "[fu five] should be -5?"
    # 8.6.2..trunk:  5 should be -5?
    # 8.6.1:         -5 should be -5?

For added hilarity:

    oo::class create Foo {
        method five {} {
            tailcall puts 2
        }
    }
    oo::class create Unfoo {
        superclass Foo
        method five {} {
            puts 1
            next
            puts 3
        }
    }
    Unfoo create fu
    fu five
    # 1
    # 3
    # 2
User Comments: dkf added on 2015-05-15 14:42:00:

I've merged the changes. There may be other things wrong too, but this at least reduces the scope of wrong. We can open issues for the other things if they bother us too much.


msofer added on 2015-05-12 16:07:37:
I agree about it being a candidate to merge: it fixes at least one bug, right? 

Donal is the best person to look at the [next] compiler and at least make it do the same thing as the non-compiled version. Or does the fix already achieve that much? Also the testnrelevels interactions, but I could try to help there.

Interaction of tailcall with catch and uplevel is indeed tricky, hard to determine what we actually want to happen.

dgp added on 2015-05-12 15:01:09:
tests added to bug fix branch.

Still think it's a candidate to merge.

aspect added on 2015-05-12 05:47:44:
Starting from dkf's examples, I have tried to make a comprehensive test suite
for tcloo + tailcall interaction.  This should cover all the significant parts
visible on the script level .. if I've missed anything, feel free to add it!

These tests all pass if compilation of [next] is inhibited by uncommenting the
block near the top.  Otherwise, every test involving [next] fails in exactly the same way.  This suggests to me we're dealing with a single bug here, and
the proposed fix at [5c3a32ed23] is sound.

Things I still don't understand:

  * testnrelevels - clearly needs to be included with these tests, but I'm not
    clear how to set up good tests (ref [0527225cc]).
  * tailcall under catch, uplevel or both requires careful consideration, but
    I don't think that directly impacts this issue.  I'm investigating those
    separately.

======
# dkf's "Principles Leading to a Fix"
#
#   A method ought to work "the same" whether or not it has been overridden by
#   a subclass. A tailcalled command ought to have as parent stack the same
#   thing you'd get with uplevel 1. A subclass will often expect the
#   superclass's result to be the result that would be returned if the subclass
#   was not there. 
#
package require tcltest
namespace import -force ::tcltest::*

;# uncomment this to inhibit compilation of [next] and [nextto]
;# .. which permits all the tests to pass
;# A simpler, per-test inhibition is possible by using
;# [[string cat next]] inline.
if 0 {
    rename ::oo::Helpers::next ::oo::Helpers::_next
    proc ::oo::Helpers::next args {
        tailcall _next {*}$args
    }
    rename ::oo::Helpers::nextto ::oo::Helpers::_nextto
    proc ::oo::Helpers::nextto args {
        tailcall _nextto {*}$args
    }
}

;# common setup:
;#  any invocation of bar should emit "abc\nhi\n" then return to its caller
set testopts {
    -setup {
        oo::class create Foo {
            method bar {} {
                puts abc
                tailcall puts hi
                puts xyz
            }
        }
    }
    -cleanup {
        catch {Foo destroy}
        catch {Foo2 destroy}    ;# created by some tests
    }
}

;# these succeed, showing that without [next] the bug doesn't fire
test next-tailcall-simple-1 "trivial case with one method" {*}$testopts -body {
    [Foo create foo] bar
} -output [join {abc hi} \n]\n

test next-tailcall-simple-2 "my bar" {*}$testopts -body {
    oo::define Foo method baz {} {
        puts a
        my bar
        puts b
    }
    [Foo create foo] baz
} -output [join {a abc hi b} \n]\n

test next-tailcall-simple-3 "\[self\] bar" {*}$testopts -body {
    oo::define Foo method baz {} {
        puts a
        [self] bar
        puts b
    }
    [Foo create foo] baz
} -output [join {a abc hi b} \n]\n

test next-tailcall-simple-4 "foo bar" {*}$testopts -body {
    oo::define Foo method baz {} {
        puts a
        foo bar
        puts b
    }
    [Foo create foo] baz
} -output [join {a abc hi b} \n]\n


;# everything from here on uses [next], and fails on 8.6.4 with compilation
test next-tailcall-superclass-1 "next superclass" {*}$testopts -body {
    oo::class create Foo2 {
        superclass Foo
        method bar {} {
            puts a
            next
            puts b
        }
    }
    [Foo2 create foo] bar
} -output [join {a abc hi b} \n]\n

test next-tailcall-superclass-2 "nextto superclass" {*}$testopts -body {
    oo::class create Foo2 {
        superclass Foo
        method bar {} {
            puts a
            nextto Foo
            puts b
        }
    }
    [Foo2 create foo] bar
} -output [join {a abc hi b} \n]\n


test next-tailcall-mixin-1 "class mixin" {*}$testopts -body {
    oo::class create Foo2 {
        method Bar {} {
            puts a
            next
            puts b
        }
        filter Bar
    }
    oo::define Foo mixin Foo2
    Foo create foo
    foo bar
} -output [join {a abc hi b} \n]\n

test next-tailcall-objmixin-1 "object mixin" {*}$testopts -body {
    oo::class create Foo2 {
        method Bar {} {
            puts a
            next
            puts b
        }
        filter Bar
    }
    Foo create foo
    oo::objdefine foo mixin Foo2
    foo bar
} -output [join {a abc hi b} \n]\n

test next-tailcall-filter-1 "filter method" {*}$testopts -body {
    oo::define Foo method Filter {} {
        puts a
        next
        puts b
    }
    oo::define Foo filter Filter
    [Foo new] bar
} -output [join {a abc hi b} \n]\n

test next-tailcall-forward-1 "forward method" {*}$testopts -body {
    proc foobar {} {
        puts "abc"
        tailcall puts "hi"
        puts "xyz"
    }
    oo::define Foo forward foobar foobar
    oo::class create Foo2 {
        superclass Foo
        method foobar {} {
            puts a
            next
            puts b
        }
    }
    [Foo2 new] foobar
} -output [join {a abc hi b} \n]\n

test next-tailcall-constructor-1 "next in constructor" -body {
    oo::class create Foo {
        constructor {} {
            puts abc
            tailcall puts hi
            puts xyz
        }
    }
    oo::class create Foo2 {
        superclass Foo
        constructor {} {
            puts a
            next
            puts b
        }
    }
    list [Foo new] [Foo2 new]
    return ""
} -cleanup {
    Foo destroy
} -output [join {abc hi a abc hi b} \n]\n


test next-tailcall-destructor-1 "next in destructor" -body {
    oo::class create Foo {
        destructor {
            puts abc
            tailcall puts hi
            puts xyz
        }
    }
    oo::class create Foo2 {
        superclass Foo
        destructor {
            puts a
            next
            puts b
        }
    }
    Foo  create foo
    Foo2 create foo2
    foo destroy
    foo2 destroy
} -output [join {abc hi a abc hi b} \n]\n

======

dkf added on 2015-04-08 21:27:41:

I'm not going to recommend merging anything until we figure out what the behaviour should be. To do that, we need a few cases.

Simple case

oo::class create Foo {
    method bar {} {
        tailcall puts hi
        puts xyz
    }
}
[Foo create foo] bar
This should replace the invoke of bar on foo with a call to puts. Expected output:
hi

Complex case 1

oo::class create Foo {
    method bar {} {
        tailcall puts hi
        puts xyz
    }
}
oo::class create Foo2 {
    superclass Foo
    method bar {} {
        puts a
        next
    }
}
[Foo2 create foo] bar
Expected output:
a
hi

Complex case 2

oo::class create Foo {
    method bar {} {
        tailcall puts hi
        puts xyz
    }
}
oo::class create Foo2 {
    method Bar {} {
        puts a
        next
    }
    filter Bar
}
Foo create foo
oo::objdefine foo mixin Foo2
foo bar
Same expected output as above.

But what if the filter wants to process the result? What if there's a [catch { next } msg opt] in there? My head aches when I try to think about these things.

Possible Principles Leading to a Fix

A method ought to work "the same" whether or not it has been overridden by a subclass. A tailcalled command ought to have as parent stack the same thing you'd get with uplevel 1. A subclass will often expect the superclass's result to be the result that would be returned if the subclass was not there.

I ought to look what happens with catch { tailcall foo }...


dgp added on 2015-04-08 16:42:42:
Correction suggested by miguel works better.
Candidate for trunk merge.

dgp added on 2015-04-08 14:46:24:
Branch bug-0f42ff7871 has patch that fixes the
behavior of the submitted scripts, but breaks
test nre-oo.4

dkf added on 2015-04-08 14:32:12:

I do not know what the correct behaviour even is, or whether both 8.6.1 (interpreted path) and 8.6.4 (compiled path) are wrong.