Index: TODO
===================================================================
diff -u -ra58654d068b1dbd5395f9d26884a70a95363c892 -r134e9484601ec4c2fb68787c129d85ce3c1f5ed2
--- TODO	(.../TODO)	(revision a58654d068b1dbd5395f9d26884a70a95363c892)
+++ TODO	(.../TODO)	(revision 134e9484601ec4c2fb68787c129d85ce3c1f5ed2)
@@ -4835,6 +4835,7 @@
 
 -nsf.c:
 - fix bug in interaction between uplevel method and interceptor transparency
+- fix bug in interaction between uplevel method from tcl procs
 - extend regression test
 
 ========================================================================
Index: generic/nsfStack.c
===================================================================
diff -u -ra58654d068b1dbd5395f9d26884a70a95363c892 -r134e9484601ec4c2fb68787c129d85ce3c1f5ed2
--- generic/nsfStack.c	(.../nsfStack.c)	(revision a58654d068b1dbd5395f9d26884a70a95363c892)
+++ generic/nsfStack.c	(.../nsfStack.c)	(revision 134e9484601ec4c2fb68787c129d85ce3c1f5ed2)
@@ -418,6 +418,9 @@
     if (Tcl_CallFrame_isProcCallFrame(varFramePtr) & (FRAME_IS_NSF_METHOD|FRAME_IS_NSF_CMETHOD)) {
       NsfCallStackContent *cscPtr = (NsfCallStackContent *)Tcl_CallFrame_clientData(varFramePtr);
 
+      /*
+       * A NSF method frame.
+       */
       if ((cscPtr->flags & (NSF_CSC_CALL_IS_NEXT|NSF_CSC_CALL_IS_ENSEMBLE))
 	  || (cscPtr->frameType & NSF_CSC_TYPE_INACTIVE)) {
         continue;
@@ -429,8 +432,20 @@
 	if (framePtrPtr) *framePtrPtr = varFramePtr;
 	return cscPtr;
       }
+    } else if (Tcl_CallFrame_isProcCallFrame(varFramePtr)) {
+
+      /*
+       * A Tcl proc frame.
+       */
+      if (offset) {
+        offset--;
+      } else if (Tcl_CallFrame_level(varFramePtr) < lvl) {
+	if (framePtrPtr) *framePtrPtr = varFramePtr;
+	return NULL;
+      }
     }
   }
+
   if (framePtrPtr) *framePtrPtr = NULL;
   return NULL;
 }
Index: tests/methods.test
===================================================================
diff -u -ra58654d068b1dbd5395f9d26884a70a95363c892 -r134e9484601ec4c2fb68787c129d85ce3c1f5ed2
--- tests/methods.test	(.../methods.test)	(revision a58654d068b1dbd5395f9d26884a70a95363c892)
+++ tests/methods.test	(.../methods.test)	(revision 134e9484601ec4c2fb68787c129d85ce3c1f5ed2)
@@ -314,14 +314,14 @@
   
   nx::Class create Foo {
 
-     :method "Info filter guard" {filter} {return [current object]-[current method]}
-     :method "Info filter methods" {-guards pattern:optional} {return [current object]-[current method]}
-     :method "Info args" {} {return [current object]-[current method]}
-     :method "Info foo" {} {return [current object]-[current method]}
+    :method "Info filter guard" {filter} {return [current object]-[current method]}
+    :method "Info filter methods" {-guards pattern:optional} {return [current object]-[current method]}
+    :method "Info args" {} {return [current object]-[current method]}
+    :method "Info foo" {} {return [current object]-[current method]}
 
-     :object method "INFO filter guard" {a b} {return [current object]-[current method]}
-     :object method "INFO filter methods" {-guards pattern:optional} {return [current object]-[current method]}
-   }
+    :object method "INFO filter guard" {a b} {return [current object]-[current method]}
+    :object method "INFO filter methods" {-guards pattern:optional} {return [current object]-[current method]}
+  }
   
   ? {Foo INFO filter guard 1 2} ::Foo-guard
   ? {Foo INFO filter methods a*} ::Foo-methods
@@ -1118,39 +1118,122 @@
 }
 
 
-nx::test case uplevel+mixin-transparency {
+nx::test case uplevel+interceptor-transparency {
+  #
+  # A real-world case from OpenACS + from the database abstraction
+  # layer. Since profiling is realized via mixin, and the db interface
+  # requires heavy upleveling for SQL bind variables, we have complex
+  # interaction between upleveling and interceptor transparency. In
+  # earlier versions, the Profile mixin towards the end of this test
+  # case lead to a problem with the variable scope (the interceptor
+  # transparency was violated).
+  #
+  nx::Object create ns_cache {
+    :public object method eval {script} {
+      set rc [catch {:uplevel $script} result]
+      return -code $rc $result
+    }
+  }
+  nx::Class create DBI {
+    :public method 1row {} { :uplevel {return $x} }
+  }
+  nx::Class create Profile {
+    :public method 1row {} { next }
+  }
+  DBI create db
 
-    nx::Object create ns_cache {
-	:public object method eval {script} {
-	    set rc [catch {:uplevel $script} result]
-	    return -code $rc $result
-	}
+  nx::Class create C {
+    :public method foo {} {
+      set x 1
+      return [db 1row]
     }
-    nx::Class create DBI {
-	:public method 1row {} { :uplevel {return $x} }
+    :public method bar {} {
+      set x 2
+      return [ns_cache eval {db 1row}]
     }
-    nx::Class create Profile {
-	:public method 1row {} { next }
-    }
-    DBI create db
+    :create c1
+  }
 
-    nx::Class create C {
-	:public method foo {} {
-	    set x 1
-	    return [db 1row]
-	}
-	:public method bar {} {
-	    set x 2
-	    return [ns_cache eval {db 1row}]
-	}
-	:create c1
+  ? {c1 foo} 1
+  ? {c1 bar} 2
+
+  db object mixin Profile
+  ? {c1 foo} 1
+  ? {c1 bar} 2
+
+}
+
+nx::test case uplevel+tcl-transparency {
+  #
+  # A real-world case from OpenACS + from the database abstraction
+  # layer. Frequently, nsf based methods are called from tcl procs
+  # (and tcl-upleveled code). In order to preserve interceptor
+  # transparency (i.e. to be able to use a mixin on the tcl-called nsf
+  # method), the uplevel method has to behave like tcl-uplevel when the
+  # caller is a tcl method.
+  #
+
+  nx::Object create ns_cache {
+    :public object method eval {script} {
+      set rc [catch {:uplevel $script} result]
+      return -code $rc $result
     }
+    :public object method eval0 {script} {
+      set rc [catch {uplevel $script} result]
+      return -code $rc $result
+    }
+  }
 
-    ? {c1 foo} 1
-    ? {c1 bar} 2
+  nx::Class create Profile {
+    :public method eval  {script} { next }
+    :public method eval0 {script} { next }
+  }
 
-    db object mixin Profile
-    ? {c1 foo} 1
-    ? {c1 bar} 2
+  proc db {cmd} {
+    #nsf::__db_show_stack
+    return [uplevel $cmd]
+  }
 
+  proc foo {} {
+    set x 1
+    db {set x}
+  }
+
+  proc bar0 {} {
+    set x 2
+    ns_cache eval0 {db {set x}}
+  }
+
+  proc bar {} {
+    set x 2
+    ns_cache eval {db {set x}}
+  }
+
+  # foo is tcl, only
+  ? foo 1
+
+  # The "bar" functions use the ns_cache interface, which is
+  # nsf-based.  The function "bar0" uses tcl uplevel, which is fine,
+  # as long no interceptor is used. The function "bar0" uses the
+  # uplevel method, which works also, when e.g. mixins are used on
+  # ns_cache.
+
+  ? bar0 2
+  ? bar 2
+
+  ns_cache object mixin Profile
+  
+  # the version with tcl-uplevel should fail
+  ? bar0 {can't read "x": no such variable}
+
+  # the version with uplevel method should succeed
+  ? bar 2
 }
+
+
+#
+# Local variables:
+#    mode: tcl
+#    tcl-indent-level: 2
+#    indent-tabs-mode: nil
+# End: