Insert of calling point in middle of procedure code. Also cleaned up how

[apply] terms generate stack trace info.

1 files changed, 3 insertions, 35 deletions

diff --git a/tests/apply.test b/tests/apply.test
index e639638..10131ce 100644
--- a/tests/apply.test
+++ b/tests/apply.test
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: apply.test,v 1.8 2006/10/24 23:13:07 msofer Exp $
+# RCS: @(#) $Id: apply.test,v 1.9 2006/10/28 22:48:43 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -23,7 +23,7 @@ if {[info commands ::apply] eq {}} {
     return
 }
 
-testConstraint memory     [llength [info commands memory]]
+testConstraint memory [llength [info commands memory]]
 
 # Tests for wrong number of arguments
 
@@ -39,13 +39,11 @@ test apply-2.0 {malformed lambda} {
     set res [catch {apply $lambda} msg]
     list $res $msg
 } {1 {can't interpret "a" as a lambda expression}}
-
 test apply-2.1 {malformed lambda} {
     set lambda [list a b c d]
     set res [catch {apply $lambda} msg]
     list $res $msg
 } {1 {can't interpret "a b c d" as a lambda expression}}
-
 test apply-2.2 {malformed lambda} {
     set lambda [list {{}} boo]
     set res [catch {apply $lambda} msg]
@@ -54,7 +52,6 @@ test apply-2.2 {malformed lambda} {
     (parsing lambda expression "{{}} boo")
     invoked from within
 "apply $lambda"}}
-
 test apply-2.3 {malformed lambda} {
     set lambda [list {{a b c}} boo]
     set res [catch {apply $lambda} msg]
@@ -63,7 +60,6 @@ test apply-2.3 {malformed lambda} {
     (parsing lambda expression "{{a b c}} boo")
     invoked from within
 "apply $lambda"}}
-
 test apply-2.4 {malformed lambda} {
     set lambda [list a(1) boo]
     set res [catch {apply $lambda} msg]
@@ -72,7 +68,6 @@ test apply-2.4 {malformed lambda} {
     (parsing lambda expression "a(1) boo")
     invoked from within
 "apply $lambda"}}
-
 test apply-2.5 {malformed lambda} {
     set lambda [list a::b boo]
     set res [catch {apply $lambda} msg]
@@ -82,7 +77,6 @@ test apply-2.5 {malformed lambda} {
     invoked from within
 "apply $lambda"}}
 
-
 # Tests for runtime errors in the lambda expression
 
 test apply-3.1 {non-existing namespace} {
@@ -90,7 +84,6 @@ test apply-3.1 {non-existing namespace} {
     set res [catch {apply $lambda x} msg]
     list $res $msg
 } {1 {cannot find namespace "::NONEXIST::FOR::SURE"}}
-
 test apply-3.2 {non-existing namespace} {
     namespace eval ::NONEXIST::FOR::SURE {}
     set lambda [list x {set x 1} ::NONEXIST::FOR::SURE]
@@ -99,13 +92,11 @@ test apply-3.2 {non-existing namespace} {
     set res [catch {apply $lambda x} msg]
     list $res $msg
 } {1 {cannot find namespace "::NONEXIST::FOR::SURE"}}
-
 test apply-3.3 {non-existing namespace} {
     set lambda [list x {set x 1} NONEXIST::FOR::SURE]
     set res [catch {apply $lambda x} msg]
     list $res $msg
 } {1 {cannot find namespace "::NONEXIST::FOR::SURE"}}
-
 test apply-3.4 {non-existing namespace} {
     namespace eval ::NONEXIST::FOR::SURE {}
     set lambda [list x {set x 1} NONEXIST::FOR::SURE]
@@ -120,27 +111,23 @@ test apply-4.1 {error in arguments to lambda expression} {
     set res [catch {apply $lambda} msg]
     list $res $msg
 } {1 {wrong # args: should be "apply {x {set x 1}} x"}}
-
 test apply-4.2 {error in arguments to lambda expression} {
     set lambda [list x {set x 1}]
     set res [catch {apply $lambda a b} msg]
     list $res $msg
 } {1 {wrong # args: should be "apply {x {set x 1}} x"}}
-
 test apply-4.3 {error in arguments to lambda expression} {
     set lambda [list x {set x 1}]
     interp alias {} foo {} ::apply $lambda
     set res [catch {foo a b} msg]
     list $res $msg [rename foo {}]
 } {1 {wrong # args: should be "foo x"} {}}
-
 test apply-4.4 {error in arguments to lambda expression} {
     set lambda [list x {set x 1}]
     interp alias {} foo {} ::apply $lambda a
     set res [catch {foo b} msg]
     list $res $msg [rename foo {}]
 } {1 {wrong # args: should be "foo"} {}}
-
 test apply-4.5 {error in arguments to lambda expression} {
     set lambda [list x {set x 1}]
     namespace eval a {
@@ -168,7 +155,7 @@ test apply-5.1 {runtime error in lambda expression} {
 } {1 {foo
     while executing
 "error foo"
-    (procedure "apply {{} {error foo}}" line 1)
+    (lambda term "{} {error foo}" line 1)
     invoked from within
 "apply $lambda"}}
 
@@ -180,12 +167,10 @@ test apply-6.1 {info level} {
     set lambda [list {} {info level}]
     expr {[apply $lambda] - $lev}
 } 1
-
 test apply-6.2 {info level} {
     set lambda [list {} {info level 0}]
     apply $lambda
 } {apply {{} {info level 0}}}
-
 test apply-6.3 {info level} {
     set lambda [list args {info level 0}]
     apply $lambda x y
@@ -202,50 +187,42 @@ test apply-7.1 {namespace access} {
     set body {set x 1; set x}
     list [apply [list args $body ::testApply]] $::testApply::x
 } {1 0}
-
 test apply-7.2 {namespace access} {
     set ::testApply::x 0
     set body {variable x; set x}
     list [apply [list args $body ::testApply]] $::testApply::x
 } {0 0}
-
 test apply-7.3 {namespace access} {
     set ::testApply::x 0
     set body {variable x; set x 1}
     list [apply [list args $body ::testApply]] $::testApply::x
 } {1 1}
-
 test apply-7.4 {namespace access} {
     set ::testApply::x 0
     set body {testApply}
     apply [list args $body ::testApply]
 } testApply
-
 test apply-7.5 {namespace access} {
     set ::testApply::x 0
     set body {set x 1; set x}
     list [apply [list args $body testApply]] $::testApply::x
 } {1 0}
-
 test apply-7.6 {namespace access} {
     set ::testApply::x 0
     set body {variable x; set x}
     list [apply [list args $body testApply]] $::testApply::x
 } {0 0}
-
 test apply-7.7 {namespace access} {
     set ::testApply::x 0
     set body {variable x; set x 1}
     list [apply [list args $body testApply]] $::testApply::x
 } {1 1}
-
 test apply-7.8 {namespace access} {
     set ::testApply::x 0
     set body {testApply}
     apply [list args $body testApply]
 } testApply
 
-
 # Tests for correct argument treatment
 
 set applyBody {
@@ -260,39 +237,30 @@ set applyBody {
 test apply-8.1 {args treatment} {
     apply [list args $applyBody] 1 2 3
 } {{args {1 2 3}}}
-
 test apply-8.2 {args treatment} {
     apply [list {x args} $applyBody] 1 2
 } {{x 1} {args 2}}
-
 test apply-8.3 {args treatment} {
     apply [list {x args} $applyBody] 1 2 3
 } {{x 1} {args {2 3}}}
-
 test apply-8.4 {default values} {
     apply [list {{x 1} {y 2}} $applyBody] 
 } {{x 1} {y 2}}
-
 test apply-8.5 {default values} {
     apply [list {{x 1} {y 2}} $applyBody] 3 4
 } {{x 3} {y 4}}
-
 test apply-8.6 {default values} {
     apply [list {{x 1} {y 2}} $applyBody] 3
 } {{x 3} {y 2}}
-
 test apply-8.7 {default values} {
     apply [list {x {y 2}} $applyBody] 1
 } {{x 1} {y 2}}
-
 test apply-8.8 {default values} {
     apply [list {x {y 2}} $applyBody] 1 3
 } {{x 1} {y 3}}
-
 test apply-8.9 {default values} {
     apply [list {x {y 2} args} $applyBody] 1
 } {{x 1} {y 2} {args {}}}
-
 test apply-8.10 {default values} {
     apply [list {x {y 2} args} $applyBody] 1 3
 } {{x 1} {y 3} {args {}}}