Index: Makefile.in
===================================================================
diff -u -r1914a014643964e54046fca2960f8c7b2a9d224d -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- Makefile.in (.../Makefile.in) (revision 1914a014643964e54046fca2960f8c7b2a9d224d)
+++ Makefile.in (.../Makefile.in) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -509,7 +509,8 @@
$(TCLSH) $(src_test_dir_native)/contains.test -libdir $(PLATFORM_DIR) $(TESTFLAGS)
$(TCLSH) $(src_test_dir_native)/tcloo.test -libdir $(PLATFORM_DIR) $(TESTFLAGS)
$(TCLSH) $(src_test_dir_native)/interp.test -libdir $(PLATFORM_DIR) $(TESTFLAGS)
- $(TCLSH) $(src_test_dir_native)/serialize.test -libdir $(PLATFORM_DIR) $(TESTFLAGS)
+ $(TCLSH) $(src_test_dir_native)/serialize.test -libdir $(PLATFORM_DIR) $(TESTFLAGS)
+ $(TCLSH) $(src_test_dir_native)/plain-object-method.test -libdir $(PLATFORM_DIR) $(TESTFLAGS)
$(TCLSH) $(src_doc_dir_native)/example-scripts/bagel.tcl -libdir $(PLATFORM_DIR) $(TESTFLAGS)
$(TCLSH) $(src_doc_dir_native)/example-scripts/container.tcl -libdir $(PLATFORM_DIR) $(TESTFLAGS)
$(TCLSH) $(src_doc_dir_native)/example-scripts/rosetta-abstract-type.tcl -libdir $(PLATFORM_DIR) $(TESTFLAGS)
Index: TODO
===================================================================
diff -u -r827f6d934f60d5ea0c02ea68d9e4cb8fc8a2f7ad -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- TODO (.../TODO) (revision 827f6d934f60d5ea0c02ea68d9e4cb8fc8a2f7ad)
+++ TODO (.../TODO) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -4272,8 +4272,93 @@
- handling of method names in error messages from nsfAPI.h. Make sure
that error message is generated with the actual method name.
+Object-method Reform:
+- changed interface to object specific commands by requiring an
+ ensemble named "object". The rational behind is essentially
+ to use always the same info command to retrieve object
+ specific methods, no matter whether these are defined
+ on a plain object or an a class object (does not break
+ the "contract" what e.g. "info method" returns).
+
+ Now we define methods via:
+
+ /cls/ method foo {args} {...body...}
+ /cls/ object method foo {args} {...body...}
+ /obj/ object method foo {args} {...body...}
+
+ Similarly, aliases, forwards and mixins are defined, e.g.
+
+ /cls/ mixin add ...
+ /cls/ object mixin add ...
+ /obj/ object mixin add ...
+ /obj/ require object method ...
+
+ The same change propagated as well to the "info" method.
+ Now we have:
+
+ /cls/ info methods ...
+ /cls/ info object methods ...
+ /obj/ info object methods ...
+
+ Similar, the object parametererization uses
+ /cls/ create obj -object-mixin M
+ /cls/ create obj -object-filter f
+ /metacls/ create cls -mixin M1 -object-mixin M2
+ /metacls/ create cls -filter f1 -object-filter f2
+
+- as a consequence,
+ a) "/cls/ class method ...",
+ "/cls/ class alias ...",
+ "/cls/ class forward ...",
+ "/cls/ class filter ...",
+ "/cls/ class mixin ...",
+ "/cls/ class info ..."
+ "/obj/ class method require method ..."
+ "/obj/ class method require public method ..."
+ "/obj/ class method require protected method ..."
+ "/obj/ class method require private method ..."
+ were dropped
+
+ b) "/obj/ method ....",
+ "/obj/ alias ....",
+ "/obj/ forward ...."
+ "/obj/ filter ...."
+ "/obj/ mixin ...."
+ "/obj/ info method*"
+ "/cls/ create obj -mixin M"
+ "/cls/ create obj -filter f"
+ "/obj/ method require method ..."
+ "/obj/ method require public method ..."
+ "/obj/ method require protected method ..."
+ "/obj/ method require private method ..."
+ were dropped
+
+- added package nx::class to allow optionally the "class" notation
+ "/cls/ class method ..." (and friends, see (a)), and
+ "/cls/ class info ...
+
+- added package nx::plain-object-method to allow optionally plain method
+ b) "/obj/ method ...." (and friends, see (b))
+
+- add support to slots to use ensemble methods as setters
+
========================================================================
TODO:
+- reconsider
+ #? {c1 cget -mixin} ""
+ ? {c1 cget -object-mixin} ""
+
+- handle
+ o object property foo
+ o object variable foo
+
+- test cases
+ complete tests/plain-object-method.test
+ provide tests/class.test
+
+- reconsider lower multiplicty on
+ -object-mixin, -mixin...
+
- flatten out interface asymmetry between methods and properties
methods:
Index: configure
===================================================================
diff -u -r7d2af5a3b3f0ac8ade700c3cd90a9aac5d00f0fa -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- configure (.../configure) (revision 7d2af5a3b3f0ac8ade700c3cd90a9aac5d00f0fa)
+++ configure (.../configure) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -1,11 +1,9 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.68 for nsf 2.0b4.
+# Generated by GNU Autoconf 2.69 for nsf 2.0b4.
#
#
-# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
-# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software
-# Foundation, Inc.
+# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
#
#
# This configure script is free software; the Free Software Foundation
@@ -134,6 +132,31 @@
# CDPATH.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+# Use a proper internal environment variable to ensure we don't fall
+ # into an infinite loop, continuously re-executing ourselves.
+ if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then
+ _as_can_reexec=no; export _as_can_reexec;
+ # We cannot yet assume a decent shell, so we have to provide a
+# neutralization value for shells without unset; and this also
+# works around shells that cannot unset nonexistent variables.
+# Preserve -v and -x to the replacement shell.
+BASH_ENV=/dev/null
+ENV=/dev/null
+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+case $- in # ((((
+ *v*x* | *x*v* ) as_opts=-vx ;;
+ *v* ) as_opts=-v ;;
+ *x* ) as_opts=-x ;;
+ * ) as_opts= ;;
+esac
+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
+# Admittedly, this is quite paranoid, since all the known shells bail
+# out after a failed `exec'.
+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
+as_fn_exit 255
+ fi
+ # We don't want this to propagate to other subprocesses.
+ { _as_can_reexec=; unset _as_can_reexec;}
if test "x$CONFIG_SHELL" = x; then
as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :
emulate sh
@@ -167,7 +190,8 @@
else
exitcode=1; echo positional parameters were not saved.
fi
-test x\$exitcode = x0 || exit 1"
+test x\$exitcode = x0 || exit 1
+test -x / || exit 1"
as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO
as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO
eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&
@@ -212,21 +236,25 @@
if test "x$CONFIG_SHELL" != x; then :
- # We cannot yet assume a decent shell, so we have to provide a
- # neutralization value for shells without unset; and this also
- # works around shells that cannot unset nonexistent variables.
- # Preserve -v and -x to the replacement shell.
- BASH_ENV=/dev/null
- ENV=/dev/null
- (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
- export CONFIG_SHELL
- case $- in # ((((
- *v*x* | *x*v* ) as_opts=-vx ;;
- *v* ) as_opts=-v ;;
- *x* ) as_opts=-x ;;
- * ) as_opts= ;;
- esac
- exec "$CONFIG_SHELL" $as_opts "$as_myself" ${1+"$@"}
+ export CONFIG_SHELL
+ # We cannot yet assume a decent shell, so we have to provide a
+# neutralization value for shells without unset; and this also
+# works around shells that cannot unset nonexistent variables.
+# Preserve -v and -x to the replacement shell.
+BASH_ENV=/dev/null
+ENV=/dev/null
+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+case $- in # ((((
+ *v*x* | *x*v* ) as_opts=-vx ;;
+ *v* ) as_opts=-v ;;
+ *x* ) as_opts=-x ;;
+ * ) as_opts= ;;
+esac
+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
+# Admittedly, this is quite paranoid, since all the known shells bail
+# out after a failed `exec'.
+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
+exit 255
fi
if test x$as_have_required = xno; then :
@@ -328,6 +356,14 @@
} # as_fn_mkdir_p
+
+# as_fn_executable_p FILE
+# -----------------------
+# Test if FILE is an executable regular file.
+as_fn_executable_p ()
+{
+ test -f "$1" && test -x "$1"
+} # as_fn_executable_p
# as_fn_append VAR VALUE
# ----------------------
# Append the text in VALUE to the end of the definition contained in VAR. Take
@@ -449,6 +485,10 @@
chmod +x "$as_me.lineno" ||
{ $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }
+ # If we had to re-execute with $CONFIG_SHELL, we're ensured to have
+ # already done that, so ensure we don't try to do so again and fall
+ # in an infinite loop. This has already happened in practice.
+ _as_can_reexec=no; export _as_can_reexec
# Don't try to exec as it changes $[0], causing all sort of problems
# (the dirname of $[0] is not the place where we might find the
# original and so on. Autoconf is especially sensitive to this).
@@ -483,16 +523,16 @@
# ... but there are two gotchas:
# 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
# 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
- # In both cases, we have to default to `cp -p'.
+ # In both cases, we have to default to `cp -pR'.
ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
elif ln conf$$.file conf$$ 2>/dev/null; then
as_ln_s=ln
else
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
fi
else
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
fi
rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
rmdir conf$$.dir 2>/dev/null
@@ -504,28 +544,8 @@
as_mkdir_p=false
fi
-if test -x / >/dev/null 2>&1; then
- as_test_x='test -x'
-else
- if ls -dL / >/dev/null 2>&1; then
- as_ls_L_option=L
- else
- as_ls_L_option=
- fi
- as_test_x='
- eval sh -c '\''
- if test -d "$1"; then
- test -d "$1/.";
- else
- case $1 in #(
- -*)set "./$1";;
- esac;
- case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((
- ???[sx]*):;;*)false;;esac;fi
- '\'' sh
- '
-fi
-as_executable_p=$as_test_x
+as_test_x='test -x'
+as_executable_p=as_fn_executable_p
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
@@ -620,6 +640,8 @@
SHARED_LIB_SUFFIX
NSF_COMPATIBLE_TCLSH
TCLSH_PROG
+VC_MANIFEST_EMBED_EXE
+VC_MANIFEST_EMBED_DLL
RANLIB_STUB
MAKE_STUB_LIB
MAKE_STATIC_LIB
@@ -636,6 +658,7 @@
CFLAGS_WARNING
CFLAGS_OPTIMIZE
CFLAGS_DEBUG
+RC
CELIB_DIR
AR
SHARED_BUILD
@@ -651,22 +674,19 @@
GREP
RANLIB
SET_MAKE
-INSTALL_DATA
-INSTALL_SCRIPT
-INSTALL_PROGRAM
CPP
-OBJEXT
-ac_ct_CC
-CPPFLAGS
-LDFLAGS
-CFLAGS
-CC
TCL_SHLIB_LD_LIBS
TCL_LD_FLAGS
TCL_EXTRA_CFLAGS
TCL_DEFS
TCL_LIBS
CLEANFILES
+OBJEXT
+ac_ct_CC
+CPPFLAGS
+LDFLAGS
+CFLAGS
+CC
TCL_STUB_LIB_SPEC
TCL_STUB_LIB_FLAG
TCL_STUB_LIB_FILE
@@ -1216,8 +1236,6 @@
if test "x$host_alias" != x; then
if test "x$build_alias" = x; then
cross_compiling=maybe
- $as_echo "$as_me: WARNING: if you wanted to set the --build type, don't use --host.
- If a cross compiler is detected then cross compile mode will be used" >&2
elif test "x$build_alias" != "x$host_alias"; then
cross_compiling=yes
fi
@@ -1478,9 +1496,9 @@
if $ac_init_version; then
cat <<\_ACEOF
nsf configure 2.0b4
-generated by GNU Autoconf 2.68
+generated by GNU Autoconf 2.69
-Copyright (C) 2010 Free Software Foundation, Inc.
+Copyright (C) 2012 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
@@ -1556,7 +1574,7 @@
test ! -s conftest.err
} && test -s conftest$ac_exeext && {
test "$cross_compiling" = yes ||
- $as_test_x conftest$ac_exeext
+ test -x conftest$ac_exeext
}; then :
ac_retval=0
else
@@ -1843,7 +1861,7 @@
running configure, to aid debugging if configure makes a mistake.
It was created by nsf $as_me 2.0b4, which was
-generated by GNU Autoconf 2.68. Invocation command line was
+generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
@@ -2217,6 +2235,13 @@
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: ok (TEA ${TEA_VERSION})" >&5
$as_echo "ok (TEA ${TEA_VERSION})" >&6; }
fi
+
+ # If the user did not set CFLAGS, set it now to keep macros
+ # like AC_PROG_CC and AC_TRY_COMPILE from adding "-g -O2".
+ if test "${CFLAGS+set}" != "set" ; then
+ CFLAGS=""
+ fi
+
case "`uname -s`" in
*win32*|*WIN32*|*MINGW32_*)
# Extract the first word of "cygpath", so it can be a program name with args.
@@ -2235,7 +2260,7 @@
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CYGPATH="cygpath -w"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -2267,8 +2292,17 @@
;;
*)
CYGPATH=echo
- EXEEXT=""
- TEA_PLATFORM="unix"
+ # Maybe we are cross-compiling....
+ case ${host_alias} in
+ *mingw32*)
+ EXEEXT=".exe"
+ TEA_PLATFORM="windows"
+ ;;
+ *)
+ EXEEXT=""
+ TEA_PLATFORM="unix"
+ ;;
+ esac
;;
esac
@@ -2281,9 +2315,12 @@
exec_prefix=$prefix
fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: configuring ${PACKAGE_NAME} ${PACKAGE_VERSION}" >&5
+$as_echo "$as_me: configuring ${PACKAGE_NAME} ${PACKAGE_VERSION}" >&6;}
+
# This package name must be replaced statically for AC_SUBST to work
# Substitute STUB_LIB_FILE in case package creates a stub library too.
@@ -2560,7 +2597,7 @@
if test x"${ac_cv_c_tclconfig}" = x ; then
TCL_BIN_DIR="# no Tcl configs found"
- as_fn_error $? "Can't find Tcl configuration definitions" "$LINENO" 5
+ as_fn_error $? "Can't find Tcl configuration definitions. Use --with-tcl to specify a directory containing tclConfig.sh" "$LINENO" 5
else
no_tcl=
TCL_BIN_DIR="${ac_cv_c_tclconfig}"
@@ -2569,118 +2606,6 @@
fi
fi
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for existence of ${TCL_BIN_DIR}/tclConfig.sh" >&5
-$as_echo_n "checking for existence of ${TCL_BIN_DIR}/tclConfig.sh... " >&6; }
-
- if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: loading" >&5
-$as_echo "loading" >&6; }
- . "${TCL_BIN_DIR}/tclConfig.sh"
- else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: could not find ${TCL_BIN_DIR}/tclConfig.sh" >&5
-$as_echo "could not find ${TCL_BIN_DIR}/tclConfig.sh" >&6; }
- fi
-
- # eval is required to do the TCL_DBGX substitution
- eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\""
- eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""
-
- # If the TCL_BIN_DIR is the build directory (not the install directory),
- # then set the common variable name to the value of the build variables.
- # For example, the variable TCL_LIB_SPEC will be set to the value
- # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC
- # instead of TCL_BUILD_LIB_SPEC since it will work with both an
- # installed and uninstalled version of Tcl.
- if test -f "${TCL_BIN_DIR}/Makefile" ; then
- TCL_LIB_SPEC="${TCL_BUILD_LIB_SPEC}"
- TCL_STUB_LIB_SPEC="${TCL_BUILD_STUB_LIB_SPEC}"
- TCL_STUB_LIB_PATH="${TCL_BUILD_STUB_LIB_PATH}"
- elif test "`uname -s`" = "Darwin"; then
- # If Tcl was built as a framework, attempt to use the libraries
- # from the framework at the given location so that linking works
- # against Tcl.framework installed in an arbitrary location.
- case ${TCL_DEFS} in
- *TCL_FRAMEWORK*)
- if test -f "${TCL_BIN_DIR}/${TCL_LIB_FILE}"; then
- for i in "`cd "${TCL_BIN_DIR}"; pwd`" \
- "`cd "${TCL_BIN_DIR}"/../..; pwd`"; do
- if test "`basename "$i"`" = "${TCL_LIB_FILE}.framework"; then
- TCL_LIB_SPEC="-F`dirname "$i" | sed -e 's/ /\\\\ /g'` -framework ${TCL_LIB_FILE}"
- break
- fi
- done
- fi
- if test -f "${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}"; then
- TCL_STUB_LIB_SPEC="-L`echo "${TCL_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}"
- TCL_STUB_LIB_PATH="${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}"
- fi
- ;;
- esac
- fi
-
- # eval is required to do the TCL_DBGX substitution
- eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\""
- eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\""
- eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\""
- eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\""
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- case "`uname -s`" in
- *CYGWIN_*)
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cygwin variant" >&5
-$as_echo_n "checking for cygwin variant... " >&6; }
- case ${TCL_EXTRA_CFLAGS} in
- *-mwin32*|*-mno-cygwin*)
- TEA_PLATFORM="windows"
- CFLAGS="$CFLAGS -mwin32"
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: win32" >&5
-$as_echo "win32" >&6; }
- ;;
- *)
- TEA_PLATFORM="unix"
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: unix" >&5
-$as_echo "unix" >&6; }
- ;;
- esac
- EXEEXT=".exe"
- ;;
- *)
- ;;
- esac
-
- # Do this here as we have fully defined TEA_PLATFORM now
- if test "${TEA_PLATFORM}" = "windows" ; then
- # The BUILD_$pkg is to define the correct extern storage class
- # handling when making this package
- cat >>confdefs.h <<_ACEOF
-#define BUILD_${PACKAGE_NAME} 1
-_ACEOF
-
- CLEANFILES="$CLEANFILES *.lib *.dll *.pdb"
- fi
-
- # TEA specific:
-
-
-
-
-
-
-
-
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
@@ -2703,7 +2628,7 @@
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="${ac_tool_prefix}gcc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -2743,7 +2668,7 @@
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_CC="gcc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -2796,7 +2721,7 @@
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="${ac_tool_prefix}cc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -2837,7 +2762,7 @@
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
ac_prog_rejected=yes
continue
@@ -2895,7 +2820,7 @@
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -2939,7 +2864,7 @@
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_CC="$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -3385,8 +3310,7 @@
/* end confdefs.h. */
#include <stdarg.h>
#include <stdio.h>
-#include <sys/types.h>
-#include <sys/stat.h>
+struct stat;
/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */
struct buf { int x; };
FILE * (*rcsopen) (struct buf *, struct stat *, int);
@@ -3472,6 +3396,126 @@
ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for existence of ${TCL_BIN_DIR}/tclConfig.sh" >&5
+$as_echo_n "checking for existence of ${TCL_BIN_DIR}/tclConfig.sh... " >&6; }
+
+ if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: loading" >&5
+$as_echo "loading" >&6; }
+ . "${TCL_BIN_DIR}/tclConfig.sh"
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: could not find ${TCL_BIN_DIR}/tclConfig.sh" >&5
+$as_echo "could not find ${TCL_BIN_DIR}/tclConfig.sh" >&6; }
+ fi
+
+ # eval is required to do the TCL_DBGX substitution
+ eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\""
+ eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""
+
+ # If the TCL_BIN_DIR is the build directory (not the install directory),
+ # then set the common variable name to the value of the build variables.
+ # For example, the variable TCL_LIB_SPEC will be set to the value
+ # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC
+ # instead of TCL_BUILD_LIB_SPEC since it will work with both an
+ # installed and uninstalled version of Tcl.
+ if test -f "${TCL_BIN_DIR}/Makefile" ; then
+ TCL_LIB_SPEC="${TCL_BUILD_LIB_SPEC}"
+ TCL_STUB_LIB_SPEC="${TCL_BUILD_STUB_LIB_SPEC}"
+ TCL_STUB_LIB_PATH="${TCL_BUILD_STUB_LIB_PATH}"
+ elif test "`uname -s`" = "Darwin"; then
+ # If Tcl was built as a framework, attempt to use the libraries
+ # from the framework at the given location so that linking works
+ # against Tcl.framework installed in an arbitrary location.
+ case ${TCL_DEFS} in
+ *TCL_FRAMEWORK*)
+ if test -f "${TCL_BIN_DIR}/${TCL_LIB_FILE}"; then
+ for i in "`cd "${TCL_BIN_DIR}"; pwd`" \
+ "`cd "${TCL_BIN_DIR}"/../..; pwd`"; do
+ if test "`basename "$i"`" = "${TCL_LIB_FILE}.framework"; then
+ TCL_LIB_SPEC="-F`dirname "$i" | sed -e 's/ /\\\\ /g'` -framework ${TCL_LIB_FILE}"
+ break
+ fi
+ done
+ fi
+ if test -f "${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}"; then
+ TCL_STUB_LIB_SPEC="-L`echo "${TCL_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}"
+ TCL_STUB_LIB_PATH="${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}"
+ fi
+ ;;
+ esac
+ fi
+
+ # eval is required to do the TCL_DBGX substitution
+ eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\""
+ eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\""
+ eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\""
+ eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\""
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking platform" >&5
+$as_echo_n "checking platform... " >&6; }
+ hold_cc=$CC; CC="$TCL_CC"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ #ifdef _WIN32
+ #error win32
+ #endif
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ TEA_PLATFORM="unix"
+else
+ TEA_PLATFORM="windows"
+
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ CC=$hold_cc
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TEA_PLATFORM" >&5
+$as_echo "$TEA_PLATFORM" >&6; }
+
+ # The BUILD_$pkg is to define the correct extern storage class
+ # handling when making this package
+
+cat >>confdefs.h <<_ACEOF
+#define BUILD_${PACKAGE_NAME} /**/
+_ACEOF
+
+ # Do this here as we have fully defined TEA_PLATFORM now
+ if test "${TEA_PLATFORM}" = "windows" ; then
+ EXEEXT=".exe"
+ CLEANFILES="$CLEANFILES *.lib *.dll *.pdb *.exp"
+ fi
+
+ # TEA specific:
+
+
+
+
+
+
+
+
for ac_func in strnstr
do :
ac_fn_c_check_func "$LINENO" "strnstr" "ac_cv_func_strnstr"
@@ -3528,109 +3572,10 @@
# the basic setup necessary to compile executables.
#-----------------------------------------------------------------------
-# Find a good install program. We prefer a C program (faster),
-# so one script is as good as another. But avoid the broken or
-# incompatible versions:
-# SysV /etc/install, /usr/sbin/install
-# SunOS /usr/etc/install
-# IRIX /sbin/install
-# AIX /bin/install
-# AmigaOS /C/install, which installs bootblocks on floppy discs
-# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
-# AFS /usr/afsws/bin/install, which mishandles nonexistent args
-# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
-# OS/2's system install, which has a completely different semantic
-# ./install, which can be erroneously created by make from ./install.sh.
-# Reject install programs that cannot install multiple files.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5
-$as_echo_n "checking for a BSD-compatible install... " >&6; }
-if test -z "$INSTALL"; then
-if ${ac_cv_path_install+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- # Account for people who put trailing slashes in PATH elements.
-case $as_dir/ in #((
- ./ | .// | /[cC]/* | \
- /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \
- ?:[\\/]os2[\\/]install[\\/]* | ?:[\\/]OS2[\\/]INSTALL[\\/]* | \
- /usr/ucb/* ) ;;
- *)
- # OSF1 and SCO ODT 3.0 have their own names for install.
- # Don't use installbsd from OSF since it installs stuff as root
- # by default.
- for ac_prog in ginstall scoinst install; do
- for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_prog$ac_exec_ext" && $as_test_x "$as_dir/$ac_prog$ac_exec_ext"; }; then
- if test $ac_prog = install &&
- grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
- # AIX install. It has an incompatible calling convention.
- :
- elif test $ac_prog = install &&
- grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
- # program-specific install script used by HP pwplus--don't use.
- :
- else
- rm -rf conftest.one conftest.two conftest.dir
- echo one > conftest.one
- echo two > conftest.two
- mkdir conftest.dir
- if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" &&
- test -s conftest.one && test -s conftest.two &&
- test -s conftest.dir/conftest.one &&
- test -s conftest.dir/conftest.two
- then
- ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c"
- break 3
- fi
- fi
- fi
- done
- done
- ;;
-esac
- done
-IFS=$as_save_IFS
-
-rm -rf conftest.one conftest.two conftest.dir
-
-fi
- if test "${ac_cv_path_install+set}" = set; then
- INSTALL=$ac_cv_path_install
- else
- # As a last resort, use the slow shell script. Don't cache a
- # value for INSTALL within a source directory, because that will
- # break other packages using the cache if that directory is
- # removed, or if the value is a relative name.
- INSTALL=$ac_install_sh
- fi
-fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL" >&5
-$as_echo "$INSTALL" >&6; }
-
-# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
-# It thinks the first close brace ends the variable substitution.
-test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
-
-test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'
-
-test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
-
-
# Don't put any macros that use the compiler (e.g. AC_TRY_COMPILE)
# in this macro, they need to go into TEA_SETUP_COMPILER instead.
- # If the user did not set CFLAGS, set it now to keep
- # the AC_PROG_CC macro from adding "-g -O2".
- if test "${CFLAGS+set}" != "set" ; then
- CFLAGS=""
- fi
-
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
@@ -3653,7 +3598,7 @@
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="${ac_tool_prefix}gcc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -3693,7 +3638,7 @@
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_CC="gcc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -3746,7 +3691,7 @@
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="${ac_tool_prefix}cc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -3787,7 +3732,7 @@
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
ac_prog_rejected=yes
continue
@@ -3845,7 +3790,7 @@
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -3889,7 +3834,7 @@
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_CC="$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -4085,8 +4030,7 @@
/* end confdefs.h. */
#include <stdarg.h>
#include <stdio.h>
-#include <sys/types.h>
-#include <sys/stat.h>
+struct stat;
/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */
struct buf { int x; };
FILE * (*rcsopen) (struct buf *, struct stat *, int);
@@ -4309,8 +4253,6 @@
ac_compiler_gnu=$ac_cv_c_compiler_gnu
-
-
#--------------------------------------------------------------------
# Checks to see if the make program sets the $MAKE variable.
#--------------------------------------------------------------------
@@ -4368,7 +4310,7 @@
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -4408,7 +4350,7 @@
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_RANLIB="ranlib"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -4429,7 +4371,7 @@
fi
if test "x$ac_ct_RANLIB" = x; then
- RANLIB=":"
+ RANLIB=""
else
case $cross_compiling:$ac_tool_warned in
yes:)
@@ -4468,7 +4410,7 @@
for ac_prog in grep ggrep; do
for ac_exec_ext in '' $ac_executable_extensions; do
ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"
- { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue
+ as_fn_executable_p "$ac_path_GREP" || continue
# Check for GNU ac_path_GREP and select it if it is found.
# Check for GNU $ac_path_GREP
case `"$ac_path_GREP" --version 2>&1` in
@@ -4534,7 +4476,7 @@
for ac_prog in egrep; do
for ac_exec_ext in '' $ac_executable_extensions; do
ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"
- { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue
+ as_fn_executable_p "$ac_path_EGREP" || continue
# Check for GNU ac_path_EGREP and select it if it is found.
# Check for GNU $ac_path_EGREP
case `"$ac_path_EGREP" --version 2>&1` in
@@ -6224,9 +6166,101 @@
# can be taken from the tclConfig.sh file, but this figures it all out.
#--------------------------------------------------------------------
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ranlib; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_RANLIB+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+ done
+IFS=$as_save_IFS
+fi
+fi
+RANLIB=$ac_cv_prog_RANLIB
+if test -n "$RANLIB"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5
+$as_echo "$RANLIB" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+fi
+if test -z "$ac_cv_prog_RANLIB"; then
+ ac_ct_RANLIB=$RANLIB
+ # Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_RANLIB+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test -n "$ac_ct_RANLIB"; then
+ ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_RANLIB="ranlib"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+ done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB
+if test -n "$ac_ct_RANLIB"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5
+$as_echo "$ac_ct_RANLIB" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+ if test "x$ac_ct_RANLIB" = x; then
+ RANLIB=":"
+ else
+ case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+ RANLIB=$ac_ct_RANLIB
+ fi
+else
+ RANLIB="$ac_cv_prog_RANLIB"
+fi
+
+
+
+
# Step 0.a: Enable 64 bit support?
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if 64bit support is requested" >&5
@@ -6386,18 +6420,20 @@
ECHO_VERSION='`echo ${PACKAGE_VERSION}`'
TCL_LIB_VERSIONS_OK=ok
CFLAGS_DEBUG=-g
- CFLAGS_OPTIMIZE=-O
if test "$GCC" = yes; then :
- # TEA specific:
CFLAGS_OPTIMIZE=-O2
CFLAGS_WARNING="-Wall"
else
- CFLAGS_WARNING=""
+
+ CFLAGS_OPTIMIZE=-O
+ CFLAGS_WARNING=""
+
fi
- # Extract the first word of "ar", so it can be a program name with args.
-set dummy ar; ac_word=$2
+ if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ar; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_AR+:} false; then :
@@ -6412,8 +6448,8 @@
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
- ac_cv_prog_AR="ar"
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_AR="${ac_tool_prefix}ar"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
@@ -6433,6 +6469,60 @@
fi
+fi
+if test -z "$ac_cv_prog_AR"; then
+ ac_ct_AR=$AR
+ # Extract the first word of "ar", so it can be a program name with args.
+set dummy ar; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_AR+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test -n "$ac_ct_AR"; then
+ ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_AR="ar"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+ done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_AR=$ac_cv_prog_ac_ct_AR
+if test -n "$ac_ct_AR"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5
+$as_echo "$ac_ct_AR" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+ if test "x$ac_ct_AR" = x; then
+ AR=""
+ else
+ case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+ AR=$ac_ct_AR
+ fi
+else
+ AR="$ac_cv_prog_AR"
+fi
+
STLIB_LD='${AR} cr'
LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"
if test "x$SHLIB_VERSION" = x; then :
@@ -6463,7 +6553,7 @@
PATH64="${MSSDK}/Bin/Win64"
;;
esac
- if test ! -d "${PATH64}" ; then
+ if test "$GCC" != "yes" -a ! -d "${PATH64}" ; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&5
$as_echo "$as_me: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&2;}
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Ensure latest Platform SDK is installed" >&5
@@ -6672,13 +6762,154 @@
if test "$GCC" = "yes"; then
# mingw gcc mode
- RC="windres"
+ if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args.
+set dummy ${ac_tool_prefix}windres; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_RC+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test -n "$RC"; then
+ ac_cv_prog_RC="$RC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_RC="${ac_tool_prefix}windres"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+ done
+IFS=$as_save_IFS
+
+fi
+fi
+RC=$ac_cv_prog_RC
+if test -n "$RC"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RC" >&5
+$as_echo "$RC" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_RC"; then
+ ac_ct_RC=$RC
+ # Extract the first word of "windres", so it can be a program name with args.
+set dummy windres; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_RC+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test -n "$ac_ct_RC"; then
+ ac_cv_prog_ac_ct_RC="$ac_ct_RC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_RC="windres"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+ done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_RC=$ac_cv_prog_ac_ct_RC
+if test -n "$ac_ct_RC"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RC" >&5
+$as_echo "$ac_ct_RC" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+ if test "x$ac_ct_RC" = x; then
+ RC=""
+ else
+ case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+ RC=$ac_ct_RC
+ fi
+else
+ RC="$ac_cv_prog_RC"
+fi
+
CFLAGS_DEBUG="-g"
CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
- SHLIB_LD="$CC -shared"
+ SHLIB_LD='${CC} -shared'
UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
LDFLAGS_CONSOLE="-wl,--subsystem,console ${lflags}"
LDFLAGS_WINDOW="-wl,--subsystem,windows ${lflags}"
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cross-compile version of gcc" >&5
+$as_echo_n "checking for cross-compile version of gcc... " >&6; }
+if ${ac_cv_cross+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+ #ifdef __WIN32__
+ #error cross-compiler
+ #endif
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_cross=yes
+else
+ ac_cv_cross=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cross" >&5
+$as_echo "$ac_cv_cross" >&6; }
+ if test "$ac_cv_cross" = "yes"; then
+ case "$do64bit" in
+ amd64|x64|yes)
+ CC="x86_64-w64-mingw32-gcc"
+ LD="x86_64-w64-mingw32-ld"
+ AR="x86_64-w64-mingw32-ar"
+ RANLIB="x86_64-w64-mingw32-ranlib"
+ RC="x86_64-w64-mingw32-windres"
+ ;;
+ *)
+ CC="i686-w64-mingw32-gcc"
+ LD="i686-w64-mingw32-ld"
+ AR="i686-w64-mingw32-ar"
+ RANLIB="i686-w64-mingw32-ranlib"
+ RC="i686-w64-mingw32-windres"
+ ;;
+ esac
+ fi
+
else
SHLIB_LD="${LINKBIN} -dll ${lflags}"
# link -lib only works when -lib is the first arg
@@ -6846,7 +7077,7 @@
SHLIB_CFLAGS=""
SHLIB_LD='${CC} -shared'
SHLIB_SUFFIX=".dll"
- EXE_SUFFIX=".exe"
+ EXEEXT=".exe"
CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
@@ -6962,7 +7193,7 @@
if test "$tcl_ok" = yes; then :
- LDFLAGS="$LDFLAGS -E"
+ LDFLAGS="$LDFLAGS -Wl,-E"
CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.'
LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.'
LD_LIBRARY_PATH_VAR="SHLIB_PATH"
@@ -7168,15 +7399,32 @@
fi
;;
OpenBSD-*)
- SHLIB_CFLAGS="-fPIC"
- SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
- SHLIB_SUFFIX=".so"
- if test $doRpath = yes; then :
+ arch=`arch -s`
+ case "$arch" in
+ m88k|vax)
+ SHLIB_SUFFIX=""
+ SHARED_LIB_SUFFIX=""
+ ;;
+ *)
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
+ SHLIB_SUFFIX=".so"
+ if test $doRpath = yes; then :
- CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi
- LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
- SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}'
+ LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}'
+ ;;
+ esac
+ case "$arch" in
+ m88k|vax)
+ CFLAGS_OPTIMIZE="-O1"
+ ;;
+ *)
+ CFLAGS_OPTIMIZE="-O2"
+ ;;
+ esac
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ELF" >&5
$as_echo_n "checking for ELF... " >&6; }
if ${tcl_cv_ld_elf+:} false; then :
@@ -7211,10 +7459,10 @@
fi
if test "${TCL_THREADS}" = "1"; then :
- # OpenBSD builds and links with -pthread, never -lpthread.
+ # On OpenBSD: Compile with -pthread
+ # Don't link with -lpthread
LIBS=`echo $LIBS | sed s/-lpthread//`
CFLAGS="$CFLAGS -pthread"
- SHLIB_CFLAGS="$SHLIB_CFLAGS -pthread"
fi
# OpenBSD doesn't do version numbers with dots.
@@ -7416,7 +7664,7 @@
SHLIB_LD="${SHLIB_LD} -Wl,-single_module"
fi
- # TEA specific: link shlib with current and compatiblity version flags
+ # TEA specific: link shlib with current and compatibility version flags
vers=`echo ${PACKAGE_VERSION} | sed -e 's/^\([0-9]\{1,5\}\)\(\(\.[0-9]\{1,3\}\)\{0,2\}\).*$/\1\2/p' -e d`
SHLIB_LD="${SHLIB_LD} -current_version ${vers:-0} -compatibility_version ${vers:-0}"
SHLIB_SUFFIX=".dylib"
@@ -7850,34 +8098,211 @@
$as_echo "#define MODULE_SCOPE extern" >>confdefs.h
- $as_echo "#define NO_VIZ 1" >>confdefs.h
+$as_echo "#define NO_VIZ /**/" >>confdefs.h
+
fi
if test "$SHARED_LIB_SUFFIX" = ""; then :
- # TEA specific: use PACKAGE_VERSION instead of VERSION
- SHARED_LIB_SUFFIX='${PACKAGE_VERSION}${SHLIB_SUFFIX}'
+ # TEA specific: use PACKAGE_VERSION instead of VERSION
+ SHARED_LIB_SUFFIX='${PACKAGE_VERSION}${SHLIB_SUFFIX}'
fi
if test "$UNSHARED_LIB_SUFFIX" = ""; then :
- # TEA specific: use PACKAGE_VERSION instead of VERSION
- UNSHARED_LIB_SUFFIX='${PACKAGE_VERSION}.a'
+ # TEA specific: use PACKAGE_VERSION instead of VERSION
+ UNSHARED_LIB_SUFFIX='${PACKAGE_VERSION}.a'
fi
+ if test "${GCC}" = "yes" ; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for SEH support in compiler" >&5
+$as_echo_n "checking for SEH support in compiler... " >&6; }
+if ${tcl_cv_seh+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test "$cross_compiling" = yes; then :
+ tcl_cv_seh=no
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+ #define WIN32_LEAN_AND_MEAN
+ #include <windows.h>
+ #undef WIN32_LEAN_AND_MEAN
+ int main(int argc, char** argv) {
+ int a, b = 0;
+ __try {
+ a = 666 / b;
+ }
+ __except (EXCEPTION_EXECUTE_HANDLER) {
+ return 0;
+ }
+ return 1;
+ }
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ tcl_cv_seh=yes
+else
+ tcl_cv_seh=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_seh" >&5
+$as_echo "$tcl_cv_seh" >&6; }
+ if test "$tcl_cv_seh" = "no" ; then
+$as_echo "#define HAVE_NO_SEH 1" >>confdefs.h
+ fi
+ #
+ # Check to see if the excpt.h include file provided contains the
+ # definition for EXCEPTION_DISPOSITION; if not, which is the case
+ # with Cygwin's version as of 2002-04-10, define it to be int,
+ # sufficient for getting the current code to work.
+ #
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for EXCEPTION_DISPOSITION support in include files" >&5
+$as_echo_n "checking for EXCEPTION_DISPOSITION support in include files... " >&6; }
+if ${tcl_cv_eh_disposition+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+# undef WIN32_LEAN_AND_MEAN
+int
+main ()
+{
+ EXCEPTION_DISPOSITION x;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ tcl_cv_eh_disposition=yes
+else
+ tcl_cv_eh_disposition=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_eh_disposition" >&5
+$as_echo "$tcl_cv_eh_disposition" >&6; }
+ if test "$tcl_cv_eh_disposition" = "no" ; then
+
+$as_echo "#define EXCEPTION_DISPOSITION int" >>confdefs.h
+
+ fi
+
+ # Check to see if winnt.h defines CHAR, SHORT, and LONG
+ # even if VOID has already been #defined. The win32api
+ # used by mingw and cygwin is known to do this.
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for winnt.h that ignores VOID define" >&5
+$as_echo_n "checking for winnt.h that ignores VOID define... " >&6; }
+if ${tcl_cv_winnt_ignore_void+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+ #define VOID void
+ #define WIN32_LEAN_AND_MEAN
+ #include <windows.h>
+ #undef WIN32_LEAN_AND_MEAN
+
+int
+main ()
+{
+
+ CHAR c;
+ SHORT s;
+ LONG l;
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ tcl_cv_winnt_ignore_void=yes
+else
+ tcl_cv_winnt_ignore_void=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_winnt_ignore_void" >&5
+$as_echo "$tcl_cv_winnt_ignore_void" >&6; }
+ if test "$tcl_cv_winnt_ignore_void" = "yes" ; then
+
+$as_echo "#define HAVE_WINNT_IGNORE_VOID 1" >>confdefs.h
+
+ fi
+
+ # See if the compiler supports casting to a union type.
+ # This is used to stop gcc from printing a compiler
+ # warning when initializing a union member.
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cast to union support" >&5
+$as_echo_n "checking for cast to union support... " >&6; }
+if ${tcl_cv_cast_to_union+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ union foo { int i; double d; };
+ union foo f = (union foo) (int) 0;
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ tcl_cv_cast_to_union=yes
+else
+ tcl_cv_cast_to_union=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cast_to_union" >&5
+$as_echo "$tcl_cv_cast_to_union" >&6; }
+ if test "$tcl_cv_cast_to_union" = "yes"; then
+
+$as_echo "#define HAVE_CAST_TO_UNION 1" >>confdefs.h
+
+ fi
+ fi
+
+
+
+
+
+
+
+
+
+
+
+
+
# These must be called after we do the basic CFLAGS checks and
# verify any possible 64-bit or similar switches are necessary
@@ -8261,7 +8686,7 @@
DBGX=""
if test "$tcl_ok" = "no"; then
- CFLAGS_DEFAULT="${CFLAGS_OPTIMIZE}"
+ CFLAGS_DEFAULT="${CFLAGS_OPTIMIZE} -DNDEBUG"
LDFLAGS_DEFAULT="${LDFLAGS_OPTIMIZE}"
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
@@ -8319,6 +8744,28 @@
if test "${TEA_PLATFORM}" = "windows" -a "$GCC" != "yes"; then
MAKE_STATIC_LIB="\${STLIB_LD} -out:\$@ \$(PKG_OBJECTS)"
MAKE_SHARED_LIB="\${SHLIB_LD} \${SHLIB_LD_LIBS} \${LDFLAGS_DEFAULT} -out:\$@ \$(PKG_OBJECTS)"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#if defined(_MSC_VER) && _MSC_VER >= 1400
+print("manifest needed")
+#endif
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "manifest needed" >/dev/null 2>&1; then :
+
+ # Could do a CHECK_PROG for mt, but should always be with MSVC8+
+ VC_MANIFEST_EMBED_DLL="if test -f \$@.manifest ; then mt.exe -nologo -manifest \$@.manifest -outputresource:\$@\;2 ; fi"
+ VC_MANIFEST_EMBED_EXE="if test -f \$@.manifest ; then mt.exe -nologo -manifest \$@.manifest -outputresource:\$@\;1 ; fi"
+ MAKE_SHARED_LIB="${MAKE_SHARED_LIB} ; ${VC_MANIFEST_EMBED_DLL}"
+
+ CLEANFILES="$CLEANFILES *.manifest"
+
+
+fi
+rm -f conftest*
+
MAKE_STUB_LIB="\${STLIB_LD} -out:\$@ \$(PKG_STUB_OBJECTS)"
else
MAKE_STATIC_LIB="\${STLIB_LD} \$@ \$(PKG_OBJECTS)"
@@ -8388,6 +8835,8 @@
+
+
#--------------------------------------------------------------------
# Find tclsh so that we can run pkg_mkIndex to generate the pkgIndex.tcl
# file during the install process. Don't run the TCLSH_PROG through
@@ -8964,16 +9413,16 @@
# ... but there are two gotchas:
# 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
# 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
- # In both cases, we have to default to `cp -p'.
+ # In both cases, we have to default to `cp -pR'.
ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
elif ln conf$$.file conf$$ 2>/dev/null; then
as_ln_s=ln
else
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
fi
else
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
fi
rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
rmdir conf$$.dir 2>/dev/null
@@ -9033,29 +9482,17 @@
as_mkdir_p=false
fi
-if test -x / >/dev/null 2>&1; then
- as_test_x='test -x'
-else
- if ls -dL / >/dev/null 2>&1; then
- as_ls_L_option=L
- else
- as_ls_L_option=
- fi
- as_test_x='
- eval sh -c '\''
- if test -d "$1"; then
- test -d "$1/.";
- else
- case $1 in #(
- -*)set "./$1";;
- esac;
- case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((
- ???[sx]*):;;*)false;;esac;fi
- '\'' sh
- '
-fi
-as_executable_p=$as_test_x
+# as_fn_executable_p FILE
+# -----------------------
+# Test if FILE is an executable regular file.
+as_fn_executable_p ()
+{
+ test -f "$1" && test -x "$1"
+} # as_fn_executable_p
+as_test_x='test -x'
+as_executable_p=as_fn_executable_p
+
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
@@ -9076,7 +9513,7 @@
# values after options handling.
ac_log="
This file was extended by nsf $as_me 2.0b4, which was
-generated by GNU Autoconf 2.68. Invocation command line was
+generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
CONFIG_HEADERS = $CONFIG_HEADERS
@@ -9129,16 +9566,15 @@
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
nsf config.status 2.0b4
-configured by $0, generated by GNU Autoconf 2.68,
+configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
-Copyright (C) 2010 Free Software Foundation, Inc.
+Copyright (C) 2012 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
ac_pwd='$ac_pwd'
srcdir='$srcdir'
-INSTALL='$INSTALL'
test -n "\$AWK" || AWK=awk
_ACEOF
@@ -9210,7 +9646,7 @@
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
if \$ac_cs_recheck; then
- set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+ set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
shift
\$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6
CONFIG_SHELL='$SHELL'
@@ -9580,10 +10016,6 @@
# CONFIG_FILE
#
- case $INSTALL in
- [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;;
- *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;;
- esac
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
@@ -9637,7 +10069,6 @@
s&@builddir@&$ac_builddir&;t t
s&@abs_builddir@&$ac_abs_builddir&;t t
s&@abs_top_builddir@&$ac_abs_top_builddir&;t t
-s&@INSTALL@&$ac_INSTALL&;t t
$ac_datarootdir_hack
"
eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \
Index: doc/example-scripts/rosetta-abstract-type.tcl
===================================================================
diff -u -r719eecc82209c59eabf2ab50f082a177c5a001a9 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- doc/example-scripts/rosetta-abstract-type.tcl (.../rosetta-abstract-type.tcl) (revision 719eecc82209c59eabf2ab50f082a177c5a001a9)
+++ doc/example-scripts/rosetta-abstract-type.tcl (.../rosetta-abstract-type.tcl) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -15,7 +15,7 @@
:public method enqueue {item} {error "not implemented"}
:public method dequeue {} {error "not implemented"}
- :public class method create {args} {
+ :public object method create {args} {
error "Cannot instantiate abstract class [self]"
}
}
Index: doc/example-scripts/rosetta-singleton.tcl
===================================================================
diff -u -r5693145107c55b5f64bf0fb487aa43e0f2238f1a -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- doc/example-scripts/rosetta-singleton.tcl (.../rosetta-singleton.tcl) (revision 5693145107c55b5f64bf0fb487aa43e0f2238f1a)
+++ doc/example-scripts/rosetta-singleton.tcl (.../rosetta-singleton.tcl) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -14,7 +14,7 @@
#
:variable instance:object
- :public class method create {args} {
+ :public object method create {args} {
return [expr {[info exists :instance] ? ${:instance} : [set :instance [next]]}]
}
}
Index: doc/example-scripts/ruby-mixins.tcl
===================================================================
diff -u -r0f57269d982e98ad81b82a12a5ab5b936784813f -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- doc/example-scripts/ruby-mixins.tcl (.../ruby-mixins.tcl) (revision 0f57269d982e98ad81b82a12a5ab5b936784813f)
+++ doc/example-scripts/ruby-mixins.tcl (.../ruby-mixins.tcl) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -124,14 +124,14 @@
# the precedence list. A decorator is able to modify the behavior of
# all of the methods of the class, where it is mixed into.
-? {g1 mixin Mix} "::Mix"
+? {g1 object mixin Mix} "::Mix"
? {g1 info precedence} "::Mix ::Group ::Enumerable ::nx::Object"
? {g1 count} {alpha 3 omega}
# For the time being, remove the mixin class again.
-? {g1 mixin ""} ""
+? {g1 object mixin ""} ""
? {g1 info precedence} "::Group ::Enumerable ::nx::Object"
#
Index: doc/example-scripts/traits-composite.tcl
===================================================================
diff -u -rd31c271afb2488abafa0642b07538a3e62106130 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- doc/example-scripts/traits-composite.tcl (.../traits-composite.tcl) (revision d31c271afb2488abafa0642b07538a3e62106130)
+++ doc/example-scripts/traits-composite.tcl (.../traits-composite.tcl) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -19,13 +19,13 @@
#
# Define the methods provided by this trait:
#
- :public method atStart {} {expr {[:position] == [:minPosition]}}
- :public method atEnd {} {expr {[:position] == [:maxPosition]}}
- :public method setToStart {} {set :position [:minPosition]}
- :public method setToEnd {} {set :position [:maxPosition]}
- :public method maxPosition {} {llength ${:collection}}
- :public method minPosition {} {return 0}
- :public method nextPosition {} {incr :position 1}
+ :public object method atStart {} {expr {[:position] == [:minPosition]}}
+ :public object method atEnd {} {expr {[:position] == [:maxPosition]}}
+ :public object method setToStart {} {set :position [:minPosition]}
+ :public object method setToEnd {} {set :position [:maxPosition]}
+ :public object method maxPosition {} {llength ${:collection}}
+ :public object method minPosition {} {return 0}
+ :public object method nextPosition {} {incr :position 1}
# The trait requires a method "position" and a variable "collection"
# from the base class or other traits. The definition is incomplete
@@ -43,8 +43,8 @@
#
# Methods provided by this trait:
#
- :public method on {collection} {set :collection $collection; :setToStart}
- :public method next {} {
+ :public object method on {collection} {set :collection $collection; :setToStart}
+ :public object method next {} {
if {[:atEnd]} {return ""} else {
set r [lindex ${:collection} ${:position}]
:nextPosition
@@ -67,8 +67,8 @@
#
# Methods provided by this trait:
#
- :public method on {collection} {set :collection $collection; :setToEnd}
- :public method nextPut {element} {
+ :public object method on {collection} {set :collection $collection; :setToEnd}
+ :public object method nextPut {element} {
lappend :collection $element
:nextPosition
return ""
Index: doc/example-scripts/traits-simple.tcl
===================================================================
diff -u -rd31c271afb2488abafa0642b07538a3e62106130 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- doc/example-scripts/traits-simple.tcl (.../traits-simple.tcl) (revision d31c271afb2488abafa0642b07538a3e62106130)
+++ doc/example-scripts/traits-simple.tcl (.../traits-simple.tcl) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -20,21 +20,21 @@
#
# Define the methods provided by this trait:
#
- :public method atStart {} {expr {[:position] == [:minPosition]}}
- :public method atEnd {} {expr {[:position] == [:maxPosition]}}
- :public method setToStart {} {set :position [:minPosition]}
- :public method setToEnd {} {set :position [:maxPosition]}
- :public method maxPosition {} {llength ${:collection}}
- :public method on {collection} {set :collection $collection; :setToStart}
- :public method next {} {
+ :public object method atStart {} {expr {[:position] == [:minPosition]}}
+ :public object method atEnd {} {expr {[:position] == [:maxPosition]}}
+ :public object method setToStart {} {set :position [:minPosition]}
+ :public object method setToEnd {} {set :position [:maxPosition]}
+ :public object method maxPosition {} {llength ${:collection}}
+ :public object method on {collection} {set :collection $collection; :setToStart}
+ :public object method next {} {
if {[:atEnd]} {return ""} else {
set r [lindex ${:collection} ${:position}]
:nextPosition
return $r
}
}
- :public method minPosition {} {return 0}
- :public method nextPosition {} {incr :position 1}
+ :public object method minPosition {} {return 0}
+ :public object method nextPosition {} {incr :position 1}
# This trait requires a method "position" and a variable
# "collection" from the base class. The definition is incomplete in
Index: generic/nsf.c
===================================================================
diff -u -r9ec1809a2cf35bba30d1c546dcf92675693108d3 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- generic/nsf.c (.../nsf.c) (revision 9ec1809a2cf35bba30d1c546dcf92675693108d3)
+++ generic/nsf.c (.../nsf.c) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -17758,8 +17758,12 @@
? Tcl_NewStringObj("protected", 9)
: Tcl_NewStringObj("public", 6));
}
- if (withPer_object) {
- Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("class", 5));
+
+ //if (withPer_object) {
+ // Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("class", 5));
+ //}
+ if (!NsfObjectIsClass(object) || withPer_object) {
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("object", 6));
}
Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj(registerCmdName, -1));
Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj(methodName, -1));
Index: generic/nsfObj.c
===================================================================
diff -u -r77b8c1919a102d9309079071f070f2f5b48d50a5 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- generic/nsfObj.c (.../nsfObj.c) (revision 77b8c1919a102d9309079071f070f2f5b48d50a5)
+++ generic/nsfObj.c (.../nsfObj.c) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -413,7 +413,7 @@
if (oc == 3 && !strcmp(ObjStr(ov[1]), NsfGlobalStrings[NSF_GUARD_OPTION])) {
nameObj = ov[0];
guardObj = ov[2];
- /*fprintf(stderr, "mixinadd name = '%s', guard = '%s'\n", ObjStr(name), ObjStr(guard));*/
+ /* fprintf(stderr, "mixinadd name = '%s', guard = '%s'\n", ObjStr(nameObj), ObjStr(guardObj));*/
} else if (oc == 1) {
nameObj = ov[0];
} else {
Index: library/lib/make.tcl
===================================================================
diff -u -r9a0b8bb0992be0561d8187c275fc1d9b7e0bbcd0 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- library/lib/make.tcl (.../make.tcl) (revision 9a0b8bb0992be0561d8187c275fc1d9b7e0bbcd0)
+++ library/lib/make.tcl (.../make.tcl) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -13,7 +13,7 @@
#
# shared lib add files for pkgIndex.tcl
#
- :method mkIndex {name} {
+ :object method mkIndex {name} {
#puts stderr "+++ mkIndex in [pwd]"
set fls {}
foreach f [glob -nocomplain *tcl] {
@@ -78,7 +78,7 @@
#puts stderr "+++ mkIndex name=$name, pwd=[pwd] DONE"
}
- :public method inEachDir {path cmd} {
+ :public object method inEachDir {path cmd} {
#puts stderr "[pwd] inEachDir $path [file isdirectory $path]"
if { [file isdirectory $path]
&& ![string match *CVS $path]
@@ -98,7 +98,7 @@
}
}
- :method in {path cmd} {
+ :object method in {path cmd} {
if {[file isdirectory $path] && ![string match *CVS $path]} {
set olddir [pwd]
cd $path
@@ -123,7 +123,7 @@
}
foreach subcmd [array names :destructive] {
- :public method $subcmd args {
+ :public object method $subcmd args {
#puts stderr " [pwd] call: '::tcl_file [current method] $args'"
::tcl_file [current method] {*}$args
}
@@ -136,7 +136,7 @@
### minus n option
nx::Class create make::-n
-foreach f [file info methods] {
+foreach f [file info object methods] {
if {$f eq "unknown" || $f eq "next" || $f eq "self"} continue
if {![file exists destructive($f)] || [file eval [list set :destructive($f)]]} {
#puts stderr destruct=$f
@@ -158,7 +158,7 @@
if {$argv eq "-n"} {set argv "-n -all"}
nx::Class create Script {
- :public class method create args {
+ :public object method create args {
lappend args {*}$::argv
set s [next]
set method [list]
@@ -167,12 +167,15 @@
"-all" {$s all}
"-n" {$s n}
"-*" {set method [string range $arg 1 end]}
- default {$s $method $arg}
+ default {
+ puts "$s $method $arg"
+ $s $method $arg
+ }
}
}
}
- :method unknown args {
+ :object method unknown args {
puts stderr "$::argv0: Unknown option ´-$args´ provided"
}
Index: library/lib/nx-test.tcl
===================================================================
diff -u -rb4e6c8da93f250a75e634cf9ecd317432cbd2199 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- library/lib/nx-test.tcl (.../nx-test.tcl) (revision b4e6c8da93f250a75e634cf9ecd317432cbd2199)
+++ library/lib/nx-test.tcl (.../nx-test.tcl) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -31,22 +31,22 @@
:property pre
:property post
- :class variable success 0
- :class variable failure 0
- :class variable testfile ""
- :class variable count 0
- :class variable ms 0
+ :object variable success 0
+ :object variable failure 0
+ :object variable testfile ""
+ :object variable count 0
+ :object variable ms 0
- :public class method success {} {
+ :public object method success {} {
incr :success
}
- :public class method failure {} {
+ :public object method failure {} {
incr :failure
}
- :public class method ms {ms:double} {
+ :public object method ms {ms:double} {
set :ms [expr {${:ms} + $ms}]
}
- :public class method destroy {} {
+ :public object method destroy {} {
lappend msg \
file [file rootname [file tail ${:testfile}]] \
tests [expr {${:success} + ${:failure}}] \
@@ -61,7 +61,7 @@
next
}
- :public class method case {name arg:optional} {
+ :public object method case {name arg:optional} {
#
# Experimental version of Test case, which (1) accepts test case as argument
# and (2) destroys all created objects on exit (auto cleanup)
@@ -87,7 +87,7 @@
}
}
- :public class method parameter {name value:optional} {
+ :public object method parameter {name value:optional} {
if {[info exists value]} {
[self]::slot::$name default $value
[self]::slot::$name reconfigure
@@ -96,7 +96,7 @@
}
}
- :public class method new args {
+ :public object method new args {
set testfile [file rootname [file tail [info script]]]
set :testfile $testfile
if {[info exists :case]} {
@@ -108,7 +108,7 @@
:create ${:name} -name ${:name} {*}$args
}
- :public class method run {} {
+ :public object method run {} {
set startTime [clock clicks -milliseconds]
foreach example [lsort [:info instances -closure]] {
$example run
Index: library/lib/nx-traits.tcl
===================================================================
diff -u -r3b5d2f4e0bc018420ebea39e54ad3212ade2a5bd -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- library/lib/nx-traits.tcl (.../nx-traits.tcl) (revision 3b5d2f4e0bc018420ebea39e54ad3212ade2a5bd)
+++ library/lib/nx-traits.tcl (.../nx-traits.tcl) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -67,13 +67,13 @@
#
nsf::proc nx::trait::add {obj -per-object:switch traitName {nameMap ""}} {
array set map $nameMap
- foreach m [$traitName info methods -callprotection all] {
+ foreach m [$traitName info object methods -callprotection all] {
if {[info exists map($m)]} {set newName $map($m)} else {set newName $m}
# do not add entries with $newName empty
if {$newName eq ""} continue
- set traitMethodHandle [$traitName info method definitionhandle $m]
- if {${per-object}} {
- $obj ::nsf::classes::nx::Object::alias $newName $traitMethodHandle
+ set traitMethodHandle [$traitName info object method definitionhandle $m]
+ if {${per-object} || ![::nsf::is class $obj]} {
+ $obj object alias $newName $traitMethodHandle
} else {
$obj public alias $newName $traitMethodHandle
# We define property inheritance for the time being only for
Index: library/nx/class.tcl
===================================================================
diff -u
--- library/nx/class.tcl (revision 0)
+++ library/nx/class.tcl (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -0,0 +1,108 @@
+package provide nx::class 1.0
+
+namespace eval ::nsf {
+ array set ::nsf::methodDefiningMethod {
+ class 1
+ }
+}
+
+namespace eval ::nx {
+ nx::Class eval {
+ :public alias "class method" ::nx::Object::slot::__object::method
+
+ :public alias "class alias" ::nx::Object::slot::__object::alias
+ :public alias "class forward" ::nx::Object::slot::__object::forward
+ #:public method "class forward" args {
+ # puts stderr "CLASS CMD: [self] [current method] [current args]"
+ # :public object forward {*}$args
+ #}
+
+ :public alias "class info" ::nx::Object::slot::__info
+
+ :public method "class filter" args {
+ set what filter
+ switch [llength $args] {
+ 0 {return [::nsf::relation [::nsf::self] object-$what]}
+ 1 {return [::nsf::relation [::nsf::self] object-$what {*}$args]}
+ default {return [::nx::Object::slot::$what [lindex $args 0] \
+ [::nsf::self] object-$what \
+ {*}[lrange $args 1 end]]
+ }
+ }
+ }
+ :public method "class mixin" args {
+ set what mixin
+ switch [llength $args] {
+ 0 {return [::nsf::relation [::nsf::self] object-$what]}
+ 1 {return [::nsf::relation [::nsf::self] object-$what {*}$args]}
+ default {return [::nx::Object::slot::$what [lindex $args 0] \
+ [::nsf::self] object-$what \
+ {*}[lrange $args 1 end]]
+ }
+ }
+ }
+ :public alias "class filterguard" ::nsf::methods::object::filterguard
+ :public alias "class mixinguard" ::nsf::methods::object::mixinguard
+
+ }
+
+ #
+ # provide aliases for "class property" and "class variable"
+ #
+ ::nx::Class eval {
+ :alias "class property" ::nsf::classes::nx::Object::property
+ :alias "class variable" ::nsf::classes::nx::Object::variable
+ }
+
+ #
+ # provide aliases for "class delete"
+ #
+ ::nx::Class eval {
+ :alias "class delete property" ::nx::Object::slot::__delete::property
+ :alias "class delete variable" ::nx::Object::slot::__delete::variable
+ :alias "class delete method" ::nx::Object::slot::__delete::method
+ }
+
+ #
+ # info redirector
+ #
+ ::nx::Class eval {
+ :alias "class info" ::nx::Object::slot::__info
+ }
+ ######################################################################
+ # Provide method "require"
+ ######################################################################
+ Object eval {
+ #
+ # method require, base cases
+ #
+ :method "require class method" {methodName} {
+ ::nsf::method::require [::nsf::self] $methodName 1
+ return [:info lookup method $methodName]
+ }
+ #
+ # method require, public explicitly
+ #
+ :method "require public class method" {methodName} {
+ set result [:require class method $methodName]
+ ::nsf::method::property [self] $result call-protected false
+ return $result
+ }
+ #
+ # method require, protected explicitly
+ #
+ :method "require protected class method" {methodName} {
+ set result [:require class method $methodName]
+ ::nsf::method::property [self] $result call-protected true
+ return $result
+ }
+ #
+ # method require, private explicitly
+ #
+ :method "require private class method" {methodName} {
+ set result [:require class method $methodName]
+ ::nsf::method::property [self] $result call-private true
+ return $result
+ }
+ }
+}
\ No newline at end of file
Index: library/nx/nx.tcl
===================================================================
diff -u -rc281c2d34f67092885aca29f6ccc16363713b54d -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- library/nx/nx.tcl (.../nx.tcl) (revision c281c2d34f67092885aca29f6ccc16363713b54d)
+++ library/nx/nx.tcl (.../nx.tcl) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -113,7 +113,7 @@
# set a few aliases as protected
# "__next", if defined, should be added as well
- foreach cmd [list uplevel upvar] {
+ foreach cmd {uplevel upvar} {
::nsf::method::property Object $cmd call-protected 1
}
unset cmd
@@ -215,7 +215,7 @@
::nsf::method::property Object __default_accessor call-protected true
######################################################################
- # Define method "method" for Class and Object
+ # Define method "method" for Class
######################################################################
::nsf::method::create Class method {
@@ -238,27 +238,6 @@
return $r
}
- ::nsf::method::create Object method {
- name arguments:parameter,0..* -returns body -precondition -postcondition
- } {
- set conditions [list]
- if {[info exists precondition]} {lappend conditions -precondition $precondition}
- if {[info exists postcondition]} {lappend conditions -postcondition $postcondition}
- array set "" [:__resolve_method_path -per-object $name]
- # puts "object method $(object).$(methodName) [list $arguments] {...}"
- set r [::nsf::method::create $(object) \
- {*}[expr {$(regObject) ne "" ? "-reg-object [list $(regObject)]" : ""}] \
- -per-object \
- $(methodName) $arguments $body {*}$conditions]
- if {$r ne ""} {
- # the method was not deleted
- ::nsf::method::property $(object) $r call-protected \
- [::nsf::dispatch $(object) __default_method_call_protection]
- if {[info exists returns]} {::nsf::method::property $(object) $r returns $returns}
- }
- return $r
- }
-
######################################################################
# Define method "unknown"
######################################################################
@@ -280,7 +259,7 @@
# Well, class is not a method defining method either, but a modifier
array set ::nsf::methodDefiningMethod {
- method 1 alias 1 forward 1 class 1
+ method 1 alias 1 forward 1 object 1
::nsf::classes::nx::Class::method 1 ::nsf::classes::nx::Object::method 1
::nsf::classes::nx::Class::alias 1 ::nsf::classes::nx::Object::alias 1
::nsf::classes::nx::Class::forward 1 ::nsf::classes::nx::Object::forward 1
@@ -295,7 +274,7 @@
:method public {args} {
if {![info exists ::nsf::methodDefiningMethod([lindex $args 0])]} {
error "'[lindex $args 0]' is not a method defining method"
- } elseif {[lindex $args 0] eq "class" && ![info exists ::nsf::methodDefiningMethod([lindex $args 1])]} {
+ } elseif {[lindex $args 0] eq "object" && ![info exists ::nsf::methodDefiningMethod([lindex $args 1])]} {
error "'[lindex $args 1]' is not a method defining method"
}
set r [: -system {*}$args]
@@ -308,7 +287,7 @@
:method protected {args} {
if {![info exists ::nsf::methodDefiningMethod([lindex $args 0])]} {
error "'[lindex $args 0]' is not a method defining method"
- } elseif {[lindex $args 0] eq "class" && ![info exists ::nsf::methodDefiningMethod([lindex $args 1])]} {
+ } elseif {[lindex $args 0] eq "object" && ![info exists ::nsf::methodDefiningMethod([lindex $args 1])]} {
error "'[lindex $args 1]' is not a method defining method"
}
set r [: -system {*}$args]
@@ -320,7 +299,7 @@
:method private {args} {
if {![info exists ::nsf::methodDefiningMethod([lindex $args 0])]} {
error "'[lindex $args 0]' is not a method defining method"
- } elseif {[lindex $args 0] eq "class" && ![info exists ::nsf::methodDefiningMethod([lindex $args 1])]} {
+ } elseif {[lindex $args 0] eq "object" && ![info exists ::nsf::methodDefiningMethod([lindex $args 1])]} {
error "'[lindex $args 1]' is not a method defining method"
}
set r [: -system {*}$args]
@@ -347,26 +326,6 @@
# but then, we would loose the option to use compound names
#
- Object public method forward {
- method
- -default -methodprefix -objframe:switch -onerror -returns -verbose:switch
- target:optional args
- } {
- array set "" [:__resolve_method_path -per-object $method]
- set arguments [lrange [::nsf::current args] 1 end]
- if {[info exists returns]} {
- # search for "-returns" in the arguments before $args ...
- set p [lsearch -exact [lrange $arguments 0 [expr {[llength $arguments]-[llength $args]}]] -returns]
- # ... and remove it if found
- if {$p > -1} {set arguments [lreplace $arguments $p $p+1]}
- }
- set r [::nsf::method::forward $(object) -per-object $(methodName) {*}$arguments]
- ::nsf::method::property $(object) -per-object $r call-protected \
- [::nsf::dispatch $(object) __default_method_call_protection]
- if {[info exists returns]} {::nsf::method::property $(object) $r returns $returns}
- return $r
- }
-
Class public method forward {
method
-default -methodprefix -objframe:switch -onerror -returns -verbose:switch
@@ -393,17 +352,6 @@
# -frame object|method make only sense for c-defined cmds,
######################################################################
- Object public method alias {methodName -returns {-frame default} cmd} {
- array set "" [:__resolve_method_path -per-object $methodName]
- #puts "object alias $(object).$(methodName) $cmd"
- set r [::nsf::method::alias $(object) -per-object $(methodName) \
- -frame $frame $cmd]
- ::nsf::method::property $(object) -per-object $r call-protected \
- [::nsf::dispatch $(object) __default_method_call_protection]
- if {[info exists returns]} {::nsf::method::property $(object) $r returns $returns}
- return $r
- }
-
Class public method alias {methodName -returns {-frame default} cmd} {
array set "" [:__resolve_method_path $methodName]
#puts "class alias $(object).$(methodName) $cmd"
@@ -528,6 +476,74 @@
# Now we are able to use ensemble methods in the definition of NX
######################################################################
+
+ Object eval {
+ #
+ # Define method defining methods for Object.
+ #
+ # These are:
+ # - "method"
+ # - "alias"
+ # - "forward"
+
+ :public method "object method" {
+ name arguments:parameter,0..* -returns body -precondition -postcondition
+ } {
+ set conditions [list]
+ if {[info exists precondition]} {lappend conditions -precondition $precondition}
+ if {[info exists postcondition]} {lappend conditions -postcondition $postcondition}
+ array set "" [:__resolve_method_path -per-object $name]
+ # puts "object method $(object).$(methodName) [list $arguments] {...}"
+ set r [::nsf::method::create $(object) \
+ {*}[expr {$(regObject) ne "" ? "-reg-object [list $(regObject)]" : ""}] \
+ -per-object \
+ $(methodName) $arguments $body {*}$conditions]
+ if {$r ne ""} {
+ # the method was not deleted
+ ::nsf::method::property $(object) $r call-protected \
+ [::nsf::dispatch $(object) __default_method_call_protection]
+ if {[info exists returns]} {::nsf::method::property $(object) $r returns $returns}
+ }
+ return $r
+ }
+
+ :public method "object alias" {methodName -returns {-frame default} cmd} {
+ array set "" [:__resolve_method_path -per-object $methodName]
+ #puts "object alias $(object).$(methodName) $cmd"
+ set r [::nsf::method::alias $(object) -per-object $(methodName) \
+ -frame $frame $cmd]
+ ::nsf::method::property $(object) -per-object $r call-protected \
+ [::nsf::dispatch $(object) __default_method_call_protection]
+ if {[info exists returns]} {::nsf::method::property $(object) $r returns $returns}
+ return $r
+ }
+
+ :public method "object forward" {
+ method
+ -default -methodprefix -objframe:switch -onerror -returns -verbose:switch
+ target:optional args
+ } {
+ array set "" [:__resolve_method_path -per-object $method]
+ set arguments [lrange [::nsf::current args] 1 end]
+ if {[info exists returns]} {
+ # search for "-returns" in the arguments before $args ...
+ set p [lsearch -exact [lrange $arguments 0 [expr {[llength $arguments]-[llength $args]}]] -returns]
+ # ... and remove it if found
+ if {$p > -1} {set arguments [lreplace $arguments $p $p+1]}
+ }
+ puts "::nsf::method::forward $(object) -per-object $(methodName) {*}$arguments"
+ set r [::nsf::method::forward $(object) -per-object $(methodName) {*}$arguments]
+ ::nsf::method::property $(object) -per-object $r call-protected \
+ [::nsf::dispatch $(object) __default_method_call_protection]
+ if {[info exists returns]} {::nsf::method::property $(object) $r returns $returns}
+ return $r
+ }
+
+ ### TODO needed?
+ #:alias "object filterguard" ::nsf::methods::object::filterguard
+ #:alias "object mixinguard" ::nsf::methods::object::mixinguard
+ }
+
#
# Method for deletion of properties, variables and plain methods
#
@@ -572,9 +588,9 @@
# provide aliases for "class delete"
#
::nx::Class eval {
- :alias "class delete property" ::nx::Object::slot::__delete::property
- :alias "class delete variable" ::nx::Object::slot::__delete::variable
- :alias "class delete method" ::nx::Object::slot::__delete::method
+ :alias "delete object property" ::nx::Object::slot::__delete::property
+ :alias "delete object variable" ::nx::Object::slot::__delete::variable
+ :alias "delete object method" ::nx::Object::slot::__delete::method
}
######################################################################
@@ -584,53 +600,57 @@
:method "require namespace" {} {
::nsf::directdispatch [::nsf::self] ::nsf::methods::object::requirenamespace
}
+
#
# method require, base cases
#
- :method "require method" {methodName} {
- return [::nsf::method::require [::nsf::self] $methodName 0]
- }
- :method "require class method" {methodName} {
+ :method "require object method" {methodName} {
::nsf::method::require [::nsf::self] $methodName 1
return [:info lookup method $methodName]
}
#
# method require, public explicitly
#
- :method "require public method" {methodName} {
- set result [:require method $methodName]
+ :method "require public object method" {methodName} {
+ set result [:require object method $methodName]
::nsf::method::property [self] $result call-protected false
return $result
}
- :method "require public class method" {methodName} {
- set result [:require class method $methodName]
- ::nsf::method::property [self] $result call-protected false
- return $result
- }
#
# method require, protected explicitly
#
- :method "require protected method" {methodName} {
- set result [:require method $methodName]
+ :method "require protected object method" {methodName} {
+ set result [:require object method $methodName]
::nsf::method::property [self] $result call-protected true
return $result
}
- :method "require protected class method" {methodName} {
- set result [:require class method $methodName]
- ::nsf::method::property [self] $result call-protected true
- return $result
- }
#
# method require, private explicitly
#
- :method "require private method" {methodName} {
- set result [:require method $methodName]
+ :method "require private object method" {methodName} {
+ set result [:require object method $methodName]
::nsf::method::property [self] $result call-private true
return $result
}
- :method "require private class method" {methodName} {
- set result [:require class method $methodName]
+ }
+
+ nx::Class eval {
+ :method "require method" {methodName} {
+ return [::nsf::method::require [::nsf::self] $methodName 0]
+ }
+ :method "require public method" {methodName} {
+ set result [:require method $methodName]
+ ::nsf::method::property [self] $result call-protected false
+ return $result
+ }
+ :method "require protected method" {methodName} {
+ set result [:require method $methodName]
+ ::nsf::method::property [self] $result call-protected true
+ return $result
+ }
+ :method "require private method" {methodName} {
+ set result [:require method $methodName]
::nsf::method::property [self] $result call-private true
return $result
}
@@ -691,16 +711,16 @@
}
:alias "info children" ::nsf::methods::object::info::children
:alias "info class" ::nsf::methods::object::info::class
- :alias "info filter guard" ::nsf::methods::object::info::filterguard
- :alias "info filter methods" ::nsf::methods::object::info::filtermethods
:alias "info has mixin" ::nsf::methods::object::info::hasmixin
:alias "info has namespace" ::nsf::methods::object::info::hasnamespace
:alias "info has type" ::nsf::methods::object::info::hastype
:alias "info is" ::nsf::methods::object::info::is
- :alias "info methods" ::nsf::methods::object::info::methods
- :alias "info mixin guard" ::nsf::methods::object::info::mixinguard
- :alias "info mixin classes" ::nsf::methods::object::info::mixinclasses
:alias "info name" ::nsf::methods::object::info::name
+ :alias "info object filter guard" ::nsf::methods::object::info::filterguard
+ :alias "info object filter methods" ::nsf::methods::object::info::filtermethods
+ :alias "info object methods" ::nsf::methods::object::info::methods
+ :alias "info object mixin guard" ::nsf::methods::object::info::mixinguard
+ :alias "info object mixin classes" ::nsf::methods::object::info::mixinclasses
:alias "info parent" ::nsf::methods::object::info::parent
:alias "info precedence" ::nsf::methods::object::info::precedence
:method "info slot definitions" {{-type:class ::nx::Slot} pattern:optional} {
@@ -841,7 +861,7 @@
Class method "info info" {} {::nx::internal::infoOptions ::nx::Class::slot::__info}
# finally register method "method" (otherwise, we cannot use "method" above)
- Object alias "info method" ::nsf::methods::object::info::method
+ Object alias "info object method" ::nsf::methods::object::info::method
Class alias "info method" ::nsf::methods::class::info::method
######################################################################
@@ -866,42 +886,12 @@
# }
# }
- #
- # Provide basic "class ...." functionality. The aliases require the
- # RHS to be defined.
- #
-
+
::nx::Class eval {
-
- :alias "class alias" ::nsf::classes::nx::Object::alias
- :alias "class forward" ::nsf::classes::nx::Object::forward
- :alias "class method" ::nsf::classes::nx::Object::method
- :alias "class info" ::nx::Object::slot::__info
-
- :method "class filter" args {
- set what filter
- switch [llength $args] {
- 0 {return [::nsf::relation [::nsf::self] object-$what]}
- 1 {return [::nsf::relation [::nsf::self] object-$what {*}$args]}
- default {return [::nx::Object::slot::$what [lindex $args 0] \
- [::nsf::self] object-$what \
- {*}[lrange $args 1 end]]
- }
- }
- }
- :method "class mixin" args {
- set what mixin
- switch [llength $args] {
- 0 {return [::nsf::relation [::nsf::self] object-$what]}
- 1 {return [::nsf::relation [::nsf::self] object-$what {*}$args]}
- default {return [::nx::Object::slot::$what [lindex $args 0] \
- [::nsf::self] object-$what \
- {*}[lrange $args 1 end]]
- }
- }
- }
- :alias "class filterguard" ::nsf::methods::object::filterguard
- :alias "class mixinguard" ::nsf::methods::object::mixinguard
+ #
+ # info redirector
+ #
+ :alias "info object" ::nx::Object::slot::__info
}
######################################################################
@@ -918,7 +908,7 @@
Class create ::nx::MetaSlot
::nsf::relation MetaSlot superclass Class
- MetaSlot class method requireClass {required:class old:class,0..1} {
+ MetaSlot object method requireClass {required:class old:class,0..1} {
#
# Combine two classes and return the more specialized one
#
@@ -934,7 +924,7 @@
}
}
- MetaSlot public class method parseParameterSpec {
+ MetaSlot public object method parseParameterSpec {
{-class ""}
{-defaultopts ""}
spec
@@ -989,7 +979,7 @@
return [list $name $parameterOptions $class $opts]
}
- MetaSlot public class method createFromParameterSpec {
+ MetaSlot public object method createFromParameterSpec {
target
-per-object:switch
{-class ""}
@@ -1251,11 +1241,16 @@
}
#puts stderr "makeforwarder --> '${:forwardername}'"
if {[info exists :settername]} {
- set name ${:settername}
+ array set "" [nsf::directdispatch ${:domain} \
+ ::nsf::classes::nx::Object::__resolve_method_path \
+ {*}[expr {${:per-object} ? "-per-object" : ""}] ${:settername}]
+ set name $(methodName)
+ set domain $(object)
} else {
set name ${:name}
+ set domain ${:domain}
}
- ::nsf::method::forward ${:domain} \
+ ::nsf::method::forward $domain \
{*}[expr {${:per-object} ? "-per-object" : ""}] \
$name \
${:manager} \
@@ -1394,6 +1389,7 @@
createBootstrapVariableSlots ::nx::RelationSlot {
{accessor public}
{multiplicity 0..n}
+ {settername}
}
RelationSlot protected method init {} {
@@ -1487,28 +1483,35 @@
######################################################################
#
- # Most system slots are RelationSlots
+ # Create relation slots
#
- ::nx::RelationSlot create ::nx::Object::slot::mixin \
- -forwardername object-mixin -elementtype mixinreg
- ::nx::RelationSlot create ::nx::Object::slot::filter \
- -forwardername object-filter -elementtype filterreg
+ # on nx::Object for
+ #
+ # object-mixin
+ # object-filter
+ #
+ # and on nx::Class for
+ #
+ # mixin
+ # filter
+ ::nx::RelationSlot create ::nx::Object::slot::object-mixin \
+ -multiplicity 1..n \
+ -methodname "::nx::Object::slot::__object::mixin" \
+ -settername "object mixin" -forwardername object-mixin -elementtype mixinreg
+ ::nx::RelationSlot create ::nx::Object::slot::object-filter \
+ -methodname "::nx::Object::slot::__object::filter" \
+ -multiplicity 1..n \
+ -settername "object filter" -forwardername object-filter -elementtype filterreg
+
::nx::RelationSlot create ::nx::Class::slot::mixin \
+ -multiplicity 1..n \
-forwardername class-mixin -elementtype mixinreg
::nx::RelationSlot create ::nx::Class::slot::filter \
+ -multiplicity 1..n \
-forwardername class-filter -elementtype filterreg
#
- # Create two convenience object parameters to allow configuration
- # of per-object mixins and filters for classes.
- #
- ::nx::ObjectParameterSlot create ::nx::Class::slot::object-mixin \
- -methodname "::nsf::classes::nx::Object::mixin" -elementtype mixinreg
- ::nx::ObjectParameterSlot create ::nx::Class::slot::object-filter \
- -methodname "::nsf::classes::nx::Object::filter" -elementtype filterreg
-
- #
# Create object parameter slots for "noninit" and "volatile"
#
::nx::ObjectParameterSlot create ::nx::Object::slot::noinit \
@@ -1551,35 +1554,35 @@
#
# Define method "guard" for mixin- and filter-slots of Object and Class
#
- ::nx::Object::slot::filter method guard {obj prop filter guard:optional} {
+ ::nx::Object::slot::object-filter object method guard {obj prop filter guard:optional} {
if {[info exists guard]} {
::nsf::directdispatch $obj ::nsf::methods::object::filterguard $filter $guard
} else {
- $obj info filter guard $filter
+ $obj info object filter guard $filter
}
}
- ::nx::Class::slot::filter method guard {obj prop filter guard:optional} {
+ ::nx::Class::slot::filter object method guard {obj prop filter guard:optional} {
if {[info exists guard]} {
::nsf::directdispatch $obj ::nsf::methods::class::filterguard $filter $guard
} else {
$obj info filter guard $filter
}
}
- ::nx::Object::slot::mixin method guard {obj prop mixin guard:optional} {
+ ::nx::Object::slot::object-mixin object method guard {obj prop mixin guard:optional} {
if {[info exists guard]} {
::nsf::directdispatch $obj ::nsf::methods::object::mixinguard $mixin $guard
} else {
- $obj info mixin guard $mixin
+ $obj info object mixin guard $mixin
}
}
- ::nx::Class::slot::mixin method guard {obj prop filter guard:optional} {
+ ::nx::Class::slot::mixin object method guard {obj prop filter guard:optional} {
if {[info exists guard]} {
::nsf::directdispatch $obj ::nsf::methods::class::mixinguard $filter $guard
} else {
$obj info mixin guard $filter
}
}
- #::nsf::method::alias ::nx::Class::slot::object-filter guard ::nx::Object::slot::filter::guard
+ #::nsf::method::alias ::nx::Class::slot::object-filter guard ::nx::Object::slot::object-filter::guard
#
# With a special purpose eval, we could avoid the need for
@@ -1594,7 +1597,6 @@
# return $r
#}
-
######################################################################
# Variable slots
######################################################################
@@ -1802,13 +1804,13 @@
# We need the following rule e.g. for private properties, where
# the setting of the property is handled via slot.
if {[:info lookup method assign] eq "::nsf::classes::nx::VariableSlot::assign"} {
- #puts stderr ":public method assign [list obj var [:namedParameterSpec {} value $options]] $body"
- :public method assign [list obj var [:namedParameterSpec {} value $options]] $body
+ #puts stderr ":public object method assign [list obj var [:namedParameterSpec {} value $options]] $body"
+ :public object method assign [list obj var [:namedParameterSpec {} value $options]] $body
}
if {[:isMultivalued] && [:info lookup method add] eq "::nsf::classes::nx::VariableSlot::add"} {
lappend options_single slot=[::nsf::self]
- #puts stderr ":public method add [list obj prop [:namedParameterSpec {} value $options_single] {pos 0}] {::nsf::next}"
- :public method add [list obj prop [:namedParameterSpec {} value $options_single] {pos 0}] {::nsf::next}
+ #puts stderr ":public object method add [list obj prop [:namedParameterSpec {} value $options_single] {pos 0}] {::nsf::next}"
+ :public object method add [list obj prop [:namedParameterSpec {} value $options_single] {pos 0}] {::nsf::next}
} else {
# TODO should we deactivate add/delete?
}
@@ -2070,11 +2072,11 @@
}
#
- # provide aliases for "class property" and "class variable"
+ # provide aliases for "object property" and "object variable"
#
::nx::Class eval {
- :alias "class property" ::nsf::classes::nx::Object::property
- :alias "class variable" ::nsf::classes::nx::Object::variable
+ :alias "object property" ::nsf::classes::nx::Object::property
+ :alias "object variable" ::nsf::classes::nx::Object::variable
}
@@ -2415,7 +2417,7 @@
# of scripted methods, aliases and forwarders without explicit
# protection specified.
#
- :method defaultMethodCallProtection {value:boolean,optional} {
+ :object method defaultMethodCallProtection {value:boolean,optional} {
if {[info exists value]} {
::nsf::method::create Object __default_method_call_protection args [list return $value]
::nsf::method::property Object __default_method_call_protection call-protected true
@@ -2427,7 +2429,7 @@
# Set the default method accessor handling nx properties. The configured
# value is used for creating accessors for properties in nx.
#
- :method defaultAccessor {value:optional} {
+ :object method defaultAccessor {value:optional} {
if {[info exists value]} {
if {$value ni {"public" "protected" "private" "none"}} {
error {defaultAccessor must be "public", "protected", "private" or "none"}
@@ -2450,9 +2452,9 @@
# framework is faster than namespace-ensembles.
#
Object create ::nx::var {
- :public alias exists ::nsf::var::exists
- :public alias import ::nsf::var::import
- :public alias set ::nsf::var::set
+ :public object alias exists ::nsf::var::exists
+ :public object alias import ::nsf::var::import
+ :public object alias set ::nsf::var::set
}
#interp alias {} ::nx::self {} ::nsf::self
@@ -2497,3 +2499,4 @@
}
puts stderr "======= nx loaded"
}
+
Index: library/nx/pkgIndex.tcl
===================================================================
diff -u -r764405083cfd6152d6956674e54f3a77cf7e1dcd -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- library/nx/pkgIndex.tcl (.../pkgIndex.tcl) (revision 764405083cfd6152d6956674e54f3a77cf7e1dcd)
+++ library/nx/pkgIndex.tcl (.../pkgIndex.tcl) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -1,5 +1,5 @@
# Tcl package index file, version 1.1
-# This file is generated by the "pkg_mkIndex -direct -load nsf" command
+# This file is generated by the "pkg_mkIndex -direct -load nsf -load nx" command
# and sourced either when an application starts up or
# by a "package unknown" script. It invokes the
# "package ifneeded" command to set up package-related
@@ -9,3 +9,5 @@
# full path name of this file's directory.
package ifneeded nx 2.0b4 [list source [file join $dir nx.tcl]]
+package ifneeded nx::class 1.0 [list source [file join $dir class.tcl]]
+package ifneeded nx::plain-object-method 1.0 [list source [file join $dir plain-object-method.tcl]]
Index: library/nx/plain-object-method.tcl
===================================================================
diff -u
--- library/nx/plain-object-method.tcl (revision 0)
+++ library/nx/plain-object-method.tcl (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -0,0 +1,78 @@
+package provide nx::plain-object-method 1.0
+
+namespace eval ::nx {
+
+ nx::Object eval {
+
+ :public method method {
+ name arguments:parameter,0..* -returns body -precondition -postcondition
+ } {
+ puts stderr "LEGACY CMD: [self] [current method] [current args]"
+ :public object method {*}[current args]
+ }
+
+ :public method alias args {
+ puts stderr "LEGACY CMD: [self] [current method] [current args]"
+ :public object alias {*}$args
+ }
+ :public method forward args {
+ puts stderr "LEGACY CMD: [self] [current method] [current args]"
+ :public object forward {*}$args
+ }
+
+ :public method mixin args {
+ puts stderr "LEGACY CMD: [self] [current method] [current args]"
+ :object mixin {*}$args
+ }
+
+ :public method filter args {
+ puts stderr "LEGACY CMD: [self] [current method] [current args]"
+ :object filter {*}$args
+ }
+
+ :public alias "info method" ::nsf::methods::object::info::method
+ :public alias "info methods" ::nsf::methods::object::info::methods
+ :public alias "info filter guard" ::nsf::methods::object::info::filterguard
+ :public alias "info filter methods" ::nsf::methods::object::info::filtermethods
+ :public alias "info mixin guard" ::nsf::methods::object::info::mixinguard
+ :public alias "info mixin classes" ::nsf::methods::object::info::mixinclasses
+
+ }
+
+
+ Object eval {
+ #
+ # method require, base cases
+ #
+ :method "require method" {methodName} {
+ ::nsf::method::require [::nsf::self] $methodName 1
+ return [:info lookup method $methodName]
+ }
+ #
+ # method require, public explicitly
+ #
+ :method "require public method" {methodName} {
+ set result [:require object method $methodName]
+ ::nsf::method::property [self] $result call-protected false
+ return $result
+ }
+ #
+ # method require, protected explicitly
+ #
+ :method "require protected method" {methodName} {
+ set result [:require object method $methodName]
+ ::nsf::method::property [self] $result call-protected true
+ return $result
+ }
+
+ #
+ # method require, private explicitly
+ #
+ :method "require private method" {methodName} {
+ set result [:require object method $methodName]
+ ::nsf::method::property [self] $result call-private true
+ return $result
+ }
+ }
+
+}
\ No newline at end of file
Index: library/serialize/serializer.tcl
===================================================================
diff -u -r46688d146087a76aa06b15391708736fa68fc05a -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- library/serialize/serializer.tcl (.../serializer.tcl) (revision 46688d146087a76aa06b15391708736fa68fc05a)
+++ library/serialize/serializer.tcl (.../serializer.tcl) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -1,4 +1,7 @@
package require nx
+# TODO: should go away
+#package require nx::plain-object-method
+
package require XOTcl 2.0
package provide nx::serializer 1.0
@@ -295,7 +298,7 @@
# class object specfic methods
###############################
- :public class method allChildren o {
+ :public object method allChildren o {
# return o and all its children fully qualified
set set [::nsf::directdispatch $o -frame method ::nsf::current]
foreach c [$o info children] {
@@ -304,21 +307,21 @@
return $set
}
- :public class method exportMethods list {
+ :public object method exportMethods list {
foreach {o p m} $list {set :exportMethods([list $o $p $m]) 1}
}
- :public class method exportObjects list {
+ :public object method exportObjects list {
foreach o $list {set :exportObjects($o) 1}
}
- :public class method exportedMethods {} {array names :exportMethods}
- :public class method exportedObjects {} {array names :exportObjects}
+ :public object method exportedMethods {} {array names :exportMethods}
+ :public object method exportedObjects {} {array names :exportObjects}
- :public class method resetPattern {} {array unset :ignorePattern}
- :public class method addPattern {p} {set :ignorePattern($p) 1}
+ :public object method resetPattern {} {array unset :ignorePattern}
+ :public object method addPattern {p} {set :ignorePattern($p) 1}
- :class method checkExportedMethods {} {
+ :object method checkExportedMethods {} {
foreach k [array names :exportMethods] {
foreach {o p m} $k break
set ok 0
@@ -334,7 +337,7 @@
}
}
- :class method checkExportedObject {} {
+ :object method checkExportedObject {} {
foreach o [array names :exportObjects] {
if {![::nsf::object::exists $o]} {
:warn "Serializer exportObject: ignore non-existing object $o"
@@ -348,7 +351,7 @@
}
}
- :public class method all {-ignoreVarsRE -ignore} {
+ :public object method all {-ignoreVarsRE -ignore} {
#
# Remove objects which should not be included in the
# blueprint. TODO: this is not the best place to do this, since
@@ -409,19 +412,19 @@
return $r
}
- :class method add_child_namespaces {ns} {
+ :object method add_child_namespaces {ns} {
if {$ns eq "::nsf"} return
lappend :namespaces $ns
foreach n [namespace children $ns] {
:add_child_namespaces $n
}
}
- :public class method application_namespaces {ns} {
+ :public object method application_namespaces {ns} {
set :namespaces ""
:add_child_namespaces $ns
return ${:namespaces}
}
- :public class method export_nsfprocs {ns} {
+ :public object method export_nsfprocs {ns} {
set result ""
foreach n [:application_namespaces $ns] {
foreach p [:info methods -methodtype nsfproc ${n}::*] {
@@ -431,7 +434,7 @@
return $result
}
- :public class method methodSerialize {object method prefix} {
+ :public object method methodSerialize {object method prefix} {
set s [:new -childof [::nsf::current object] -volatile]
foreach oss [ObjectSystemSerializer info instances] {
if {[$oss responsibleSerializer $object]} {
@@ -443,7 +446,7 @@
return $result
}
- :public class method deepSerialize {-ignoreVarsRE -ignore -map args} {
+ :public object method deepSerialize {-ignoreVarsRE -ignore -map args} {
:resetPattern
set s [:new -childof [::nsf::current object] -volatile]
#$s volatile
@@ -718,7 +721,7 @@
set :rootMetaClass ::nx::Class
array set :ignorePattern [list "::nsf::*" 1 "::nx::*" 1 "::xotcl::*" 1]
- :public method serialize-all-start {s} {
+ :public object method serialize-all-start {s} {
set intro [subst {
package require nx
::nx::configure defaultMethodCallProtection [::nx::configure defaultMethodCallProtection]
@@ -734,26 +737,26 @@
# nx method serialization
###############################
- :method methodExists {object kind name} {
+ :object method methodExists {object kind name} {
expr {[$object info method type $name] ne ""}
}
- :public method serializeExportedMethod {object kind name} {
+ :public object method serializeExportedMethod {object kind name} {
# todo: object modifier is missing
return [:method-serialize $object $name ""]
}
- :method method-serialize {o m modifier} {
- if {![::nsf::is class $o]} {set modifier ""}
- if {[$o {*}$modifier info method type $m] eq "object"} {
+ :object method method-serialize {o m modifier} {
+ if {![::nsf::is class $o]} {set modifier "object"}
+ if {[$o info {*}$modifier method type $m] eq "object"} {
# object serialization is fully handled by the serializer
- return "# [$o {*}$modifier info method definition $m]"
+ return "# [$o info {*}$modifier method definition $m]"
}
- if {[$o {*}$modifier info method type $m] eq "setter"} {
+ if {[$o info {*}$modifier method type $m] eq "setter"} {
set def ""
} else {
- set def [$o {*}$modifier info method definition $m]
- set handle [$o {*}$modifier info method registrationhandle $m]
+ set def [$o info {*}$modifier method definition $m]
+ set handle [$o info {*}$modifier method registrationhandle $m]
}
return $def
}
@@ -762,7 +765,7 @@
# nx object serialization
###############################
- :method Object-serialize {o s} {
+ :object method Object-serialize {o s} {
if {[$o ::nsf::methods::object::info::hastype ::nx::EnsembleObject]} {
return ""
}
@@ -776,7 +779,7 @@
} else {
append cmd [list [$o info class] create $objectName -noinit]\n
foreach i [lsort [$o ::nsf::methods::object::info::methods -callprotection all -path]] {
- append cmd [:method-serialize $o $i "class"] "\n"
+ append cmd [:method-serialize $o $i "object"] "\n"
}
}
@@ -803,7 +806,7 @@
# nx class serialization
###############################
- :method Class-serialize {o s} {
+ :object method Class-serialize {o s} {
set cmd [:Object-serialize $o $s]
foreach i [lsort [$o ::nsf::methods::class::info::methods -callprotection all -path]] {
@@ -838,15 +841,15 @@
#array set :ignorePattern [list "::xotcl::*" 1]
array set :ignorePattern [list "::nsf::*" 1 "::nx::*" 1 "::xotcl::*" 1]
- :public method serialize-all-start {s} {
+ :public object method serialize-all-start {s} {
set intro "package require XOTcl 2.0"
if {[info command ::Object] ne "" && [namespace origin ::Object] eq "::xotcl::Object"} {
append intro "\nnamespace import -force ::xotcl::*"
}
return "$intro\n::xotcl::Object instproc trace args {}\n[next]"
}
- :public method serialize-all-end {s} {
+ :public object method serialize-all-end {s} {
return "[next]\n::nsf::method::alias ::xotcl::Object trace -frame object ::trace\n"
}
@@ -855,7 +858,7 @@
# XOTcl method serialization
###############################
- :method methodExists {object kind name} {
+ :object method methodExists {object kind name} {
switch $kind {
proc - instproc {
return [expr {[$object info ${kind}s $name] ne ""}]
@@ -866,7 +869,7 @@
}
}
- :public method serializeExportedMethod {object kind name} {
+ :public object method serializeExportedMethod {object kind name} {
set code ""
switch $kind {
"" - inst {
@@ -888,7 +891,7 @@
return $code
}
- :method method-serialize {o m prefix} {
+ :object method method-serialize {o m prefix} {
set arglist [list]
foreach v [$o info ${prefix}args $m] {
if {[$o info ${prefix}default $m $v x]} {
@@ -908,12 +911,12 @@
# XOTcl object serialization
###############################
- :method Object-serialize {o s} {
+ :object method Object-serialize {o s} {
:collect-var-traces $o $s
append cmd [list [$o info class] create [::nsf::directdispatch $o -frame method ::nsf::current object]]
append cmd " -noinit\n"
foreach i [$o ::nsf::methods::object::info::methods -methodtype scripted -callprotection all] {
- append cmd [:method-serialize $o $i ""] "\n"
+ append cmd [:method-serialize $o $i "object"] "\n"
}
foreach i [$o ::nsf::methods::object::info::methods -methodtype forward -callprotection all] {
append cmd [concat [list $o] forward $i [$o info forward -definition $i]] "\n"
@@ -934,7 +937,7 @@
# XOTcl class serialization
###############################
- :method Class-serialize {o s} {
+ :object method Class-serialize {o s} {
set cmd [:Object-serialize $o $s]
foreach i [$o info instprocs] {
append cmd [:method-serialize $o $i inst] "\n"
Index: library/xotcl/library/xotcl2.tcl
===================================================================
diff -u -r200af46a04ef0a09e4d27b6662a5a49b82c8ba52 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision 200af46a04ef0a09e4d27b6662a5a49b82c8ba52)
+++ library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -847,7 +847,7 @@
if {$definition ne ""} {
set obj [lindex $definition 0]
set modifier [lindex $definition 2]
- if {$modifier eq "class-object"} {
+ if {$modifier eq "object"} {
set prefix ""
set kind [lindex $definition 3]
set name [lindex $definition 4]
@@ -938,7 +938,7 @@
}
:public forward instproc %self public method
- :public forward proc %self public class method
+ :public forward proc %self public object method
#
# As NX/XOTcl hybrids, all slot kinds would not inherit the
@@ -953,12 +953,12 @@
#
::xotcl::MetaSlot create ::xotcl::Attribute -superclass ::nx::VariableSlot {
:property multivalued {
- :public method assign {object property value} {
+ :public object method assign {object property value} {
set mClass [expr {$value ? "0..n" : "1..1"}]
$object incremental $value
$object multiplicity $mClass
}
- :public method get {object property} {
+ :public object method get {object property} {
return [$object eval [list :isMultivalued]]
}
}
@@ -1124,18 +1124,18 @@
:property {autoexport {}}
:property {export {}}
- :public class method create {name args} {
+ :public object method create {name args} {
set nq [namespace qualifiers $name]
if {$nq ne "" && ![namespace exists $nq]} {Object create $nq}
next
}
- :public class method extend {name args} {
+ :public object method extend {name args} {
:require $name
$name configure {*}$args
}
- :public class method contains script {
+ :public object method contains script {
if {[info exists :provide]} {
package provide [set :provide] [set :version]
} else {
@@ -1159,16 +1159,16 @@
}
}
- :public class method unknown args {
+ :public object method unknown args {
#puts stderr "unknown: package $args"
[set :packagecmd] {*}$args
}
- :public class method verbose value {
+ :public object method verbose value {
set :verbose $value
}
- :public class method present args {
+ :public object method present args {
if {$::tcl_version<8.3} {
switch -exact -- [lindex $args 0] {
-exact {set pkg [lindex $args 1]}
@@ -1184,7 +1184,7 @@
}
}
- :public class method import {{-into ::} pkg} {
+ :public object method import {{-into ::} pkg} {
:require $pkg
namespace eval $into [subst -nocommands {
#puts stderr "*** package import ${pkg}::* into [namespace current]"
@@ -1199,7 +1199,7 @@
}
}
- :public class method require args {
+ :public object method require args {
#puts "XOTCL package require $args, current=[namespace current]"
set prevComponent ${:component}
if {[catch {set v [package present {*}$args]} msg]} {
Index: library/xotcl/tests/slottest.xotcl
===================================================================
diff -u -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- library/xotcl/tests/slottest.xotcl (.../slottest.xotcl) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2)
+++ library/xotcl/tests/slottest.xotcl (.../slottest.xotcl) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -359,7 +359,7 @@
# redefine setter for foo of class A
#A slot foo method assign {domain var val} ...
-A::slot::foo public method assign {domain var val} {
+A::slot::foo public object method assign {domain var val} {
# Do something with [self] that isn't valid before init
#puts setter-[self proc]
$domain set $var $val
Index: tests/alias.test
===================================================================
diff -u -r59e100d383b22ea1407f5e5c40e303f2c6bb9027 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/alias.test (.../alias.test) (revision 59e100d383b22ea1407f5e5c40e303f2c6bb9027)
+++ tests/alias.test (.../alias.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -2,12 +2,11 @@
package prefer latest
package require nx
package require nx::test
-namespace import ::nx::*
#::nx::configure defaultMethodCallProtection false
-Test parameter count 10
-Test case alias-preliminaries {
+nx::Test parameter count 10
+nx::Test case alias-preliminaries {
# The system methods of nx::VariableSlot are either alias or forwarders
? {lsort [::nx::VariableSlot info methods -methodtype alias]} {assign get}
@@ -17,34 +16,34 @@
# define an alias and retrieve its definition
set cmd "::nx::Object public alias set ::set"
eval $cmd
- ? {Object info method definition set} $cmd
+ ? {nx::Object info method definition set} $cmd
# define an alias and retrieve its definition
set cmd "::nx::Object public alias set -frame method ::set"
eval $cmd
- ? {Object info method definition set} $cmd
+ ? {nx::Object info method definition set} $cmd
# define an alias and retrieve its definition
set cmd "::nx::Object public alias set -frame object ::set"
eval $cmd
- ? {Object info method definition set} $cmd
+ ? {nx::Object info method definition set} $cmd
proc ::foo {} {return foo}
- ? {Object alias foo -frame object ::foo} \
+ ? {nx::Object alias foo -frame object ::foo} \
"cannot use -frame object|method in alias for scripted command '::foo'"
- ? {Object alias foo -frame method ::foo} \
+ ? {nx::Object alias foo -frame method ::foo} \
"cannot use -frame object|method in alias for scripted command '::foo'"
- ? {Object alias foo -frame default ::foo} "::nsf::classes::nx::Object::foo"
+ ? {nx::Object alias foo -frame default ::foo} "::nsf::classes::nx::Object::foo"
}
-Test case alias-simple {
+nx::Test case alias-simple {
# define an alias and retrieve its definition
- Class create Base {
+ nx::Class create Base {
:public method foo {{-x 1}} {return $x}
}
- Class create Foo
+ nx::Class create Foo
? {::nsf::method::alias ::Foo foo ::nsf::classes::Base::foo} "::nsf::classes::Foo::foo"
? {Foo info method definition foo} "::Foo public alias foo ::nsf::classes::Base::foo"
@@ -77,13 +76,13 @@
? {Foo info methods -methodtype alias} {} "removed"
}
-Test case alias-chaining {
+nx::Test case alias-chaining {
#
# chaining aliases
#
- Class create T
- Class create S
+ nx::Class create T
+ nx::Class create S
T create t
S create s
@@ -138,75 +137,75 @@
? {T info methods} {FOO}
T public method foo args { return [current class]->[current method] }
- T public class method bar args { return [current class]->[current method] }
+ T public object method bar args { return [current class]->[current method] }
::nsf::method::alias T -per-object FOO ::nsf::classes::T::foo
::nsf::method::alias T -per-object BAR ::T::FOO
::nsf::method::alias T -per-object ZAP ::T::BAR
#WITH_IMPORT_REFS
#? {T info methods} {foo}
? {T info methods} {foo FOO}
- ? {lsort [T class info methods -methodtype alias]} {BAR FOO ZAP}
- ? {lsort [T class info methods]} {BAR FOO ZAP bar}
+ ? {lsort [T info object methods -methodtype alias]} {BAR FOO ZAP}
+ ? {lsort [T info object methods]} {BAR FOO ZAP bar}
? {t foo} ::T->foo
- ? {T class info method definition ZAP} {::T public class alias ZAP ::T::BAR}
+ ? {T info object method definition ZAP} {::T public object alias ZAP ::T::BAR}
? {T FOO} ->FOO
? {T BAR} ->BAR
? {T ZAP} ->ZAP
? {T bar} ->bar
- T class method FOO {} {}
+ T object method FOO {} {}
#WITH_IMPORT_REFS
#? {T info methods} {foo}
? {T info methods} {foo FOO}
- ? {lsort [T class info methods]} {BAR ZAP bar}
+ ? {lsort [T info object methods]} {BAR ZAP bar}
? {T BAR} ->BAR
? {T ZAP} ->ZAP
rename ::T::BAR ""
#WITH_IMPORT_REFS
#? {T info methods} {foo}
? {T info methods} {foo FOO}
- ? {lsort [T class info methods]} {ZAP bar}
+ ? {lsort [T info object methods]} {ZAP bar}
? {T ZAP} ->ZAP; # is ok, still pointing to 'foo'
#WITH_IMPORT_REFS
#? {T info methods} {foo}
? {T info methods} {foo FOO}
- ? {lsort [T class info methods]} {ZAP bar}
+ ? {lsort [T info object methods]} {ZAP bar}
? {T ZAP} ->ZAP
T public method foo {} {}
#WITH_IMPORT_REFS
#? {T info methods} {}
? {T info methods} {FOO}
#WITH_IMPORT_REFS
- #? {lsort [T class info methods]} {bar}
- ? {lsort [T class info methods]} {ZAP bar}
+ #? {lsort [T info object methods]} {bar}
+ ? {lsort [T info object methods]} {ZAP bar}
}
-Test case alias-per-object {
+nx::Test case alias-per-object {
- Class create T {
- :public class method bar args { return [current class]->[current method] }
+ nx::Class create T {
+ :public object method bar args { return [current class]->[current method] }
:create t
}
proc ::foo args { return [current class]->[current method] }
#
# per-object methods as per-object aliases
#
- T public class method m1 args { return [current class]->[current method] }
+ T public object method m1 args { return [current class]->[current method] }
::nsf::method::alias T -per-object M1 ::T::m1
::nsf::method::alias T -per-object M11 ::T::M1
- ? {lsort [T class info methods]} {M1 M11 bar m1}
+ ? {lsort [T info object methods]} {M1 M11 bar m1}
? {T m1} ->m1
? {T M1} ->M1
? {T M11} ->M11
- T class method M1 {} {}
- ? {lsort [T class info methods]} {M11 bar m1}
+ T object method M1 {} {}
+ ? {lsort [T info object methods]} {M11 bar m1}
? {T m1} ->m1
? {T M11} ->M11
- T class method m1 {} {}
+ T object method m1 {} {}
#WITH_IMPORT_REFS
- #? {lsort [T class info methods]} {bar}
- ? {lsort [T class info methods]} {M11 bar}
+ #? {lsort [T info object methods]} {bar}
+ ? {lsort [T info object methods]} {M11 bar}
#
# a proc as alias
@@ -220,8 +219,8 @@
#
::nsf::method::alias T BAR ::T::FOO2
#WITH_IMPORT_REFS
- #? {lsort [T class info methods]} {FOO2 bar}
- ? {lsort [T class info methods]} {FOO2 M11 bar}
+ #? {lsort [T info object methods]} {FOO2 bar}
+ ? {lsort [T info object methods]} {FOO2 M11 bar}
? {lsort [T info methods]} {BAR FOO1}
? {T FOO2} ->FOO2
? {t FOO1} ::T->FOO1
@@ -231,18 +230,18 @@
#
rename ::foo ""
#WITH_IMPORT_REFS
- #? {lsort [T class info methods]} {bar}
- ? {lsort [T class info methods]} {FOO2 M11 bar}
+ #? {lsort [T info object methods]} {bar}
+ ? {lsort [T info object methods]} {FOO2 M11 bar}
#WITH_IMPORT_REFS
#? {lsort [T info methods]} {}
? {lsort [T info methods]} {BAR FOO1}
}
# namespaced procs + namespace deletion
-Test case alias-namespaced {
- Class create T {
- :public class method bar args { return [current class]->[current method] }
+nx::Test case alias-namespaced {
+ nx::Class create T {
+ :public object method bar args { return [current class]->[current method] }
:create t
}
@@ -268,22 +267,22 @@
# per-object namespaces
- Class create U
+ nx::Class create U
U create u
? {namespace exists ::U} 0
- U public class method zap args { return [current class]->[current method] }
+ U public object method zap args { return [current class]->[current method] }
::nsf::method::alias ::U -per-object ZAP ::U::zap
U require namespace
? {namespace exists ::U} 1
- U public class method bar args { return [current class]->[current method] }
+ U public object method bar args { return [current class]->[current method] }
::nsf::method::alias U -per-object BAR ::U::bar
- ? {lsort [U class info methods]} {BAR ZAP bar zap}
+ ? {lsort [U info object methods]} {BAR ZAP bar zap}
? {U BAR} ->BAR
? {U ZAP} ->ZAP
namespace delete ::U
? {namespace exists ::U} 0
- ? {lsort [U class info methods]} {}
+ ? {lsort [U info object methods]} {}
? {U info lookup methods BAR} ""
? {U info lookup methods ZAP} ""
@@ -292,12 +291,12 @@
# dot-resolver/ dot-dispatcher used in aliased proc
-Test case alias-dot-resolver {
+nx::Test case alias-dot-resolver {
- Class create V {
+ nx::Class create V {
set :z 1
:public method bar {z} { return $z }
- :public class method bar {z} { return $z }
+ :public object method bar {z} { return $z }
:create v {
set :z 2
}
@@ -312,7 +311,7 @@
::nsf::method::alias V FOO1 ::foo
::nsf::method::alias V -per-object FOO2 ::foo
- ? {lsort [V class info methods]} {FOO2 bar}
+ ? {lsort [V info object methods]} {FOO2 bar}
? {lsort [V info methods]} {FOO1 bar}
? {V FOO2} 1-1-1
@@ -321,11 +320,11 @@
? {lsort [V info methods]} {bar}
rename ::foo ""
#WITH_IMPORT_REFS
- #? {lsort [V class info methods]} {bar}
- ? {lsort [V class info methods]} {FOO2 bar}
+ #? {lsort [V info object methods]} {bar}
+ ? {lsort [V info object methods]} {FOO2 bar}
}
-Test case alias-store
+nx::Test case alias-store
#
# Tests for the ::nsf::method::alias store, used for introspection for
# aliases. The alias store (an associative variable) is mostly
@@ -339,10 +338,10 @@
# <object>,<alias_name>,<per_object> -> <aliased_cmd>
#
-Object create o
-Class create C
+nx::Object create o
+nx::Class create C
-o public method bar args {;}
+o public object method bar args {;}
? {info vars ::nsf::alias} ::nsf::alias
? {array exists ::nsf::alias} 1
@@ -354,19 +353,19 @@
? {info exists ::nsf::alias(::C,FOO,0)} 1
? {array get ::nsf::alias ::o,FOO,1} "::o,FOO,1 ::foo"
? {array get ::nsf::alias ::C,FOO,0} "::C,FOO,0 ::foo"
-? {o info method definition FOO} "::o public alias FOO ::foo"
+? {o info object method definition FOO} "::o public object alias FOO ::foo"
? {C info method definition FOO} "::C public alias FOO ::foo"
::nsf::method::alias o FOO ::o::bar
? {info exists ::nsf::alias(::o,FOO,1)} 1
? {array get ::nsf::alias ::o,FOO,1} "::o,FOO,1 ::o::bar"
-? {o info method definition FOO} "::o public alias FOO ::o::bar"
+? {o info object method definition FOO} "::o public object alias FOO ::o::bar"
# AliasDelete in RemoveObjectMethod
-o public method FOO {} {}
+o public object method FOO {} {}
? {info exists ::nsf::alias(::o,FOO,1)} 0
? {array get ::nsf::alias ::o,FOO,1} ""
-? {o info method definition FOO} ""
+? {o info object method definition FOO} ""
# AliasDelete in RemoveClassMethod
C public method FOO {} {}
@@ -379,7 +378,7 @@
# AliasDelete in AddObjectMethod
? {info exists ::nsf::alias(::o,BAR,1)} 1
-::o public method BAR {} {;}
+::o public object method BAR {} {;}
? {info exists ::nsf::alias(::o,BAR,1)} 0
# AliasDelete in AddInstanceMethod
@@ -399,7 +398,7 @@
::nsf::method::alias o BAR ::o::FOO
? {info exists ::nsf::alias(::o,FOO,1)} 1
? {info exists ::nsf::alias(::o,BAR,1)} 1
-o public method bar {} {}
+o public object method bar {} {}
#WITH_IMPORT_REFS
#? {info exists ::nsf::alias(::o,FOO,1)} 0
? {info exists ::nsf::alias(::o,FOO,1)} 1
@@ -459,7 +458,7 @@
# Check resolving of namespace imported classes
# and when a class is aliased via "interp alias"
#
-Test case class-resolve {
+nx::Test case class-resolve {
namespace eval ::ns1 {
nx::Class create A {:public method foo {} {::nx::current class}}
nx::Class create B {:public method foo {} {::nx::current class}}
@@ -484,8 +483,8 @@
}
}
-Test parameter count 10
-Test case proc-alias {
+nx::Test parameter count 10
+nx::Test case proc-alias {
nx::Class create C {
:public method foo {} {upvar x y; info exists y}
@@ -525,13 +524,13 @@
? {d1 bar_} 1
? {d1 bar2} 1
- c1 mixin add M
+ c1 object mixin add M
? {c1 bar} 0 ;# upvar reaches into to mixin method
? {c1 bar_} 0 ;# upvar reaches into to mixin method
? {c1 bar2} 0 ;# upvar reaches into to mixin method
- d1 mixin add M
+ d1 object mixin add M
? {d1 bar} 1
? {d1 bar_} 1
@@ -556,18 +555,18 @@
return ${:z}
}
-Test parameter count 10
-Test case proc-alias-compile {
+nx::Test parameter count 10
+nx::Test case proc-alias-compile {
- Object create o {
+ nx::Object create o {
set :a 100
set :d 1001
#:method foo {-:a:integer :b :c:optional} {
# puts stderr ${:a},${:b},${:c}
#}
- :public alias foo ::foo
- :public alias bar ::bar
- :public alias baz ::baz
+ :public object alias foo ::foo
+ :public object alias bar ::bar
+ :public object alias baz ::baz
}
#
@@ -602,14 +601,14 @@
#
# test redefinition of a target proc
#
-Test parameter count 1
-Test case alias-proc-refetch {
+nx::Test parameter count 1
+nx::Test case alias-proc-refetch {
#
# initial definition
#
proc target {} {return 1}
- nx::Object create o {:public alias foo ::target}
+ nx::Object create o {:public object alias foo ::target}
? {o foo} 1
#
@@ -622,8 +621,8 @@
#
# test registration of a pre-compiled proc
#
-Test parameter count 1
-Test case alias-precompiled-proc {
+nx::Test parameter count 1
+nx::Test case alias-precompiled-proc {
nx::Class create C {
:public method vars {} {
set result [list]
@@ -665,7 +664,7 @@
# call proc from method context; it sets the variable,
# maybe questionable, but not horrible
- c1 public method baz {} {::bar 4}
+ c1 public object method baz {} {::bar 4}
? {c1 baz} 4
? {c1 vars} {a 2 b 4}
}
@@ -683,10 +682,10 @@
# per-object aliases
nx::Object create ::o {
- :alias X ::x
- ? {o info method definition X} "::o protected alias X ::x"
- :alias X ::x
- ? {o info method definition X} "::o protected alias X ::x"
+ :object alias X ::x
+ ? {o info object method definition X} "::o protected object alias X ::x"
+ :object alias X ::x
+ ? {o info object method definition X} "::o protected object alias X ::x"
}
# per-class aliases
@@ -696,10 +695,10 @@
:alias A1 ::x
? {C info method definition A1} "::C protected alias A1 ::x"
- :class alias A2 ::x
- ? {C class info method definition A2} "::C protected class alias A2 ::x"
- :class alias A2 ::x
- ? {C class info method definition A2} "::C protected class alias A2 ::x"
+ :object alias A2 ::x
+ ? {C info object method definition A2} "::C protected object alias A2 ::x"
+ :object alias A2 ::x
+ ? {C info object method definition A2} "::C protected object alias A2 ::x"
}
}
@@ -710,77 +709,77 @@
nx::Object create ::x
::proc ::y {} {}
nx::Object create ::o {
- :alias X ::x
- ? {o info method definition X} "::o protected alias X ::x"
- :alias X ::y
- ? {o info method definition X} "::o protected alias X ::y"
+ :object alias X ::x
+ ? {o info object method definition X} "::o protected object alias X ::x"
+ :object alias X ::y
+ ? {o info object method definition X} "::o protected object alias X ::y"
}
}
nx::Test case refount-destroy-delete1 {
nx::Object create ::x
- nx::Object create ::o {:alias X ::x}
+ nx::Object create ::o {:object alias X ::x}
- ? {o info method definition X} "::o protected alias X ::x"
+ ? {o info object method definition X} "::o protected object alias X ::x"
# destroy the object, make sure it does not exist anymore
? {x destroy} ""
? {nsf::object::exists x} 0
# The alias lookup does still work
- ? {o info method definition X} "::o protected alias X ::x"
+ ? {o info object method definition X} "::o protected object alias X ::x"
# Create the referenced object new
nx::Object create ::x
# Recreation of the alias, must free refcount to the old object
- ? {::o alias X ::x} "::o::X"
+ ? {::o object alias X ::x} "::o::X"
# Recreate the object. On recreation, the object is not freed,
# therefore we test the reference counter is aleady set, and must
# nor be incremented
nx::Object create ::x
- ? {::o alias X ::x} "::o::X"
+ ? {::o object alias X ::x} "::o::X"
}
nx::Test case refount-destroy-delete2 {
nx::Object create ::o
nx::Object create ::baff
nx::Object create ::baff::child
- ::o alias X ::baff::child
+ ::o object alias X ::baff::child
? {nsf::object::exists ::baff::child} 1
- ? {o info method definition X} "::o protected alias X ::baff::child"
+ ? {o info object method definition X} "::o protected object alias X ::baff::child"
nx::Object create ::baff
? {nsf::object::exists ::baff::child} 0
# The alias lookup does still work
- ? {o info method definition X} "::o protected alias X ::baff::child"
+ ? {o info object method definition X} "::o protected object alias X ::baff::child"
# Create the child new
nx::Object create ::baff::child
? {nsf::object::exists ::baff::child} 1
# Recreation of the alias, must free refcount to the old object
- ? {::o alias X ::baff::child} "::o::X"
+ ? {::o object alias X ::baff::child} "::o::X"
}
#
# Testing cylcic alias
#
nx::Test case cyclic-alias {
nx::Object create o {
- set handle [:public method foo {} {return 1}]
+ set handle [:public object method foo {} {return 1}]
# we can define currently the recursive definition
- ? [list [:] public alias foo $handle] "::o::foo"
+ ? [list [:] public object alias foo $handle] "::o::foo"
}
# at runtime, we get an exception
? {o foo} {target "::o::foo" of alias foo apparently disappeared}
# test indirect case
- set handle1 [o public method foo {} {return 1}]
- set handle2 [o public alias bar $handle1]
- set handle3 [o public alias foo $handle2]
+ set handle1 [o public object method foo {} {return 1}]
+ set handle2 [o public object alias bar $handle1]
+ set handle3 [o public object alias foo $handle2]
? {o foo} {target "::o::bar" of alias foo apparently disappeared}
}
Index: tests/cget.test
===================================================================
diff -u -r77f50f6c6304355d638d5bf6f172d404940447de -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/cget.test (.../cget.test) (revision 77f50f6c6304355d638d5bf6f172d404940447de)
+++ tests/cget.test (.../cget.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -55,7 +55,7 @@
#
# configure without arguments
#
- ? {p1 configure} "?-sex value? -famnam value ?-age integer? ?-friends value ...? ?-volatile? ?-noinit? ?-mixin mixinreg ...? ?-class class? ?-filter filterreg ...? ?__initcmd?"
+ ? {p1 configure} "?-sex value? -famnam value ?-age integer? ?-friends value ...? ?-volatile? ?-noinit? ?-object-mixin mixinreg ...? ?-class class? ?-object-filter filterreg ...? ?__initcmd?"
}
#
@@ -70,19 +70,19 @@
# Define a property with a "get" method
:property bar1 {
- :public method get { object property} {
+ :public object method get { object property} {
incr ::count(cget)
nsf::var::set $object $property
}
}
# Define a property with a "get" and "assign" method
:property bar2 {
- :public method get { object property} {
+ :public object method get { object property} {
incr ::count(cget)
nsf::var::set $object $property
}
- :public method assign { object property value } {
+ :public object method assign { object property value } {
incr ::count(assign)
nsf::var::set $object $property $value
}
@@ -95,7 +95,7 @@
#
# configure without arguments
#
- ? {p1 configure} "?-bar1 value? ?-bar2 value? ?-volatile? ?-noinit? ?-mixin mixinreg ...? ?-class class? ?-filter filterreg ...? ?__initcmd?"
+ ? {p1 configure} "?-bar1 value? ?-bar2 value? ?-volatile? ?-noinit? ?-object-mixin mixinreg ...? ?-class class? ?-object-filter filterreg ...? ?__initcmd?"
#
# test gettin/setting via slots
@@ -137,7 +137,7 @@
# class-level lookup
#
? {C info lookup parameter list} \
- "-superclass -object-mixin -mixin -object-filter -filter -volatile -noinit -class __initcmd"
+ "-superclass -mixin -filter -volatile -noinit -object-mixin -class -object-filter __initcmd"
? {C cget -superclass} "::nx::Object"
? {C cget -object-mixin} ""
? {C cget -mixin} ""
@@ -150,16 +150,18 @@
# object-level lookup
#
? {c1 info lookup parameter list} \
- "-foo -bar -volatile -noinit -mixin -class -filter __initcmd"
+ "-foo -bar -volatile -noinit -object-mixin -class -object-filter __initcmd"
#
# query all properties from base classes
#
? {c1 cget -volatile} 0
? {c1 cget -noinit} ""
- ? {c1 cget -mixin} ""
+ #? {c1 cget -mixin} ""
+ ? {c1 cget -object-mixin} ""
? {c1 cget -class} ::C
- ? {c1 cget -filter} ""
+ #? {c1 cget -filter} ""
+ ? {c1 cget -object-filter} ""
#
# query alias and forward
@@ -186,10 +188,10 @@
# Define a property with a "get" and "assign" method
:property bar {
- :public method get { object property } {
+ :public object method get { object property } {
nsf::var::set $object $property
}
- :public method assign { object property value } {
+ :public object method assign { object property value } {
nsf::var::set $object $property $value
}
}
Index: tests/contains.test
===================================================================
diff -u -r59e100d383b22ea1407f5e5c40e303f2c6bb9027 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/contains.test (.../contains.test) (revision 59e100d383b22ea1407f5e5c40e303f2c6bb9027)
+++ tests/contains.test (.../contains.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -2,6 +2,7 @@
package prefer latest
package require nx
+
#
# Intentionally, we do not want to make a "namespace import" in this
# test file. Run this file via a pure tclsh!
@@ -78,7 +79,7 @@
C create c2 {
set :s [self]
set :c [current]
- :public method bar {} {return "[set :s]-[set :c]"}
+ :public object method bar {} {return "[set :s]-[set :c]"}
}
? {c2 bar} "::c2-::c2"
@@ -99,7 +100,7 @@
#puts stderr =====1
set c [Class create C -superclass Class {
- :class method foo {} {;}
+ :object method foo {} {;}
}]
? {set c} ::C
Index: tests/destroy.test
===================================================================
diff -u -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/destroy.test (.../destroy.test) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4)
+++ tests/destroy.test (.../destroy.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -1,5 +1,7 @@
# -*- Tcl -*-
package require nx
+package require nx::plain-object-method
+
::nx::configure defaultMethodCallProtection false
package require nx::test
@@ -439,8 +441,8 @@
? {o a} ::o2 "call object via alias"
? {o info method type a} alias
## the ensemble-object needs per-object methods
- o2 method info args {:info {*}$args}
- o2 method set args {:set {*}$args}
+ o2 object method info args {:info {*}$args}
+ o2 object method set args {:set {*}$args}
::nsf::object::property o2 keepcallerself 1
? {o a info vars} "" "call info on aliased object"
? {o set x 10} 10 "set variable on object"
@@ -466,8 +468,8 @@
? {o info method type a} alias
# In order to avoid recursive calls, we have to provide the
# selector for the method definitions in nx::Object
- o2 method info args {: ::nsf::classes::nx::Object::info {*}$args}
- o2 method set args {: ::nsf::classes::nx::Object::set {*}$args}
+ o2 object method info args {: ::nsf::classes::nx::Object::info {*}$args}
+ o2 object method set args {: ::nsf::classes::nx::Object::set {*}$args}
? {o a info vars} "" "call info on aliased object"
? {o set x 10} 10 "set variable on object o"
@@ -511,9 +513,9 @@
Test case create-alias-and-recreate-obj {
Object create o
Object create o3
- o alias x o3
+ o object alias x o3
Object create o3
- o3 method set args {: ::nsf::classes::nx::Object::set {*}$args}
+ o3 object method set args {: ::nsf::classes::nx::Object::set {*}$args}
o x set a 13
? {o x set a} 13 "aliased object works after recreate"
}
@@ -531,11 +533,11 @@
::nsf::object::property o3 keepcallerself 1
::nsf::object::property o perobjectdispatch 1
::nsf::object::property o3 perobjectdispatch 1
- o alias a o3
+ o object alias a o3
C alias b o
- o3 method set args {: ::nsf::classes::nx::Object::set {*}$args}
- o method set args {: ::nsf::classes::nx::Object::set {*}$args}
+ o3 object method set args {: ::nsf::classes::nx::Object::set {*}$args}
+ o object method set args {: ::nsf::classes::nx::Object::set {*}$args}
C create c1
? {c1 b set B 2} 2 "call 1st level"
@@ -555,7 +557,7 @@
Class create C
Object create o
Object create o3
- o alias a o3
+ o object alias a o3
C alias b o
C create c1
C destroy
@@ -803,7 +805,7 @@
nx::Test case class-object-property {
Class create C {
- :class property -accessor public x
+ :object property -accessor public x
:property a:int
}
@@ -859,7 +861,7 @@
$i eval {
package req nx
nx::Object create o {
- :public method destroy args {
+ :public object method destroy args {
incr ::X
next
}
@@ -928,7 +930,7 @@
#
nx::Test case rename-cached-method {
# Create a class with a namespace
- nx::Class create A {:public class method foo args {}}
+ nx::Class create A {:public object method foo args {}}
#
# Add a proc named "new" to the namespace of the class.
# This is not recommended, but we can't avoid it.
Index: tests/disposition.test
===================================================================
diff -u -r77f50f6c6304355d638d5bf6f172d404940447de -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/disposition.test (.../disposition.test) (revision 77f50f6c6304355d638d5bf6f172d404940447de)
+++ tests/disposition.test (.../disposition.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -1,6 +1,7 @@
# -*- Tcl -*-
package prefer latest
package req nx
+
package require nx::test
#
@@ -10,7 +11,7 @@
nx::Test case basics {
Class create C {
- :class property {inst "::__%&singleton"}
+ :object property {inst "::__%&singleton"}
:method foo {x} {
#puts stderr [current method]
set :[current method] $x
@@ -24,13 +25,13 @@
#
# some testing helpers
#
- :public class method setObjectParams {spec} {
+ :public object method setObjectParams {spec} {
:protected method __objectparameter {} [list return $spec]
::nsf::parameter:invalidate::classcache [current]
}
:setObjectParams ""
- :public class method new args {
+ :public object method new args {
return [:create ${:inst} {*}$args]
}
}
@@ -263,7 +264,7 @@
#
# define a user defined parameter type
#
- ::nx::methodParameterSlot method type=mytype {name value} {
+ ::nx::methodParameterSlot object method type=mytype {name value} {
if {$value < 1 || $value > 3} {
error "Value '$value' of parameter $name is not between 1 and 3"
}
@@ -319,11 +320,11 @@
nx::Test case dispo-multiplicities {
Class create S {
- :public class method setObjectParams {spec} {
+ :public object method setObjectParams {spec} {
:protected method __objectparameter {} [list return $spec]
::nsf::parameter:invalidate::classcache [current]
}
- #:class method __objectparameter {} {
+ #:object method __objectparameter {} {
# return ${:objectparams}
#}
:public method foo {args} {
@@ -382,7 +383,7 @@
nx::Test case dispo-returns {
Class create R {
- :public class method setObjectParams {spec} {
+ :public object method setObjectParams {spec} {
:protected method __objectparameter {} [list return $spec]
::nsf::parameter:invalidate::classcache [current]
}
@@ -391,7 +392,7 @@
#
# Alias/forward dispositions are unavailable as parameter types of return checkers
#
- set methods(raz) [R public class method raz {} {;}]
+ set methods(raz) [R public object method raz {} {;}]
foreach dispoSpec {
alias,noarg
alias,method=xxx
@@ -446,7 +447,7 @@
nx::Test case dispo-callstack {
Class create Callee {
- :public class method setObjectParams {spec} {
+ :public object method setObjectParams {spec} {
:protected method __objectparameter {} [list return $spec]
::nsf::parameter:invalidate::classcache [current]
}
@@ -506,7 +507,7 @@
# uplevel|upvar
#
- Callee public class method run {} {
+ Callee public object method run {} {
set self [self]
set objparams [:__objectparameter]
#
@@ -614,7 +615,7 @@
nx::Test case alias-noarg {
Class create C {
- :public class method setObjectParams {spec} {
+ :public object method setObjectParams {spec} {
:protected method __objectparameter {} [list return $spec]
::nsf::parameter:invalidate::classcache [current]
}
@@ -755,7 +756,7 @@
#
nx::Test case alias-noarg {
Class create C {
- :public class method setObjectParams {spec} {
+ :public object method setObjectParams {spec} {
:protected method __objectparameter {} [list return $spec]
::nsf::parameter:invalidate::classcache [current]
}
@@ -770,7 +771,7 @@
#
nx::Test case alias-args {
Class create C {
- :public class method setObjectParams {spec} {
+ :public object method setObjectParams {spec} {
:protected method __objectparameter {} [list return $spec]
::nsf::parameter:invalidate::classcache [current]
}
@@ -860,7 +861,7 @@
nx::Test case alias-init {
Class create C {
- :public class method setObjectParams {spec} {
+ :public object method setObjectParams {spec} {
:protected method __objectparameter {} [list return $spec]
::nsf::parameter:invalidate::classcache [current]
}
@@ -881,7 +882,7 @@
# Could move to submethods.test?
#
Class create C {
- :public class method setObjectParams {spec} {
+ :public object method setObjectParams {spec} {
:protected method __objectparameter {} [list return $spec]
::nsf::parameter:invalidate::classcache [current]
}
@@ -1026,7 +1027,7 @@
}
}
- C::slot::__FOO mixin M2
+ C::slot::__FOO object mixin M2
? {C::slot::__FOO foo} "::M2--::C::slot::__FOO----foo"
C::slot::__FOO eval {unset :msg}
@@ -1036,11 +1037,11 @@
c1 eval {set :msg}
} "::c1--FOO--foo"
- C::slot::__FOO mixin {}
- C::slot::__FOO public method intercept {} {
+ C::slot::__FOO object mixin {}
+ C::slot::__FOO public object method intercept {} {
return "[current]--[next]"
}
- C::slot::__FOO filter intercept
+ C::slot::__FOO object filter intercept
? {C::slot::__FOO foo} "::C::slot::__FOO--::C::slot::__FOO----foo"
C setObjectParams [list]
@@ -1081,7 +1082,7 @@
nx::Test case dispo-configure-transparency {
Class create C {
- :public class method setObjectParams {spec} {
+ :public object method setObjectParams {spec} {
:protected method __objectparameter {} [list return $spec]
::nsf::parameter:invalidate::classcache [current]
}
@@ -1132,7 +1133,7 @@
Object create ::callee {
::nsf::object::property [self] perobjectdispatch true
- :public method foo {} {
+ :public object method foo {} {
error [::nsf::current]-[::nsf::current methodpath]
}
}
@@ -1143,7 +1144,7 @@
? {C create c} "::c" "Defaultmethod of calle is invoked ..."
C setObjectParams [list [list FOO:alias "foo"]]
? {C create c} "::callee-FOO" "foo leaf method is selected ..."
- ::callee mixin add M
+ ::callee object mixin add M
? {C create c} "::callee-FOO" "With mixin ..."
#
@@ -1174,7 +1175,7 @@
Class create C
Class create T {
- :public class method setObjectParams {spec} {
+ :public object method setObjectParams {spec} {
:protected method __objectparameter {} [list return $spec]
::nsf::parameter:invalidate::classcache [current]
}
@@ -1213,7 +1214,7 @@
}
- ::obj mixin UnknownHandler
+ ::obj object mixin UnknownHandler
? {[T create t] z uff} "CURRENT-::obj-DELEGATOR-::t-UNKNOWNMETHOD-uff-PATH-z" \
"Aliased dispatch to unknown method (custom unknown handler)"
set x [UnknownHandler create handledObj]
@@ -1230,7 +1231,7 @@
#
# a) direct dispatch (non-aliased) with fully qualified selector (::*)
#
- ::obj mixin {}
+ ::obj object mixin {}
T setObjectParams x:alias,method=::obj
? {T create t XXX} "::t: unable to dispatch method '::obj'" "FQ dispatch with default unknown handler"
@@ -1243,7 +1244,7 @@
UnknownHandler method defaultmethod {} {
set :defaultmethod 1
}
- ::obj mixin UnknownHandler
+ ::obj object mixin UnknownHandler
T setObjectParams [list [list z:alias,noarg ""]]
? {T create t; ::obj eval {info exists :defaultmethod}} 1 \
"Calling defaultmethod via alias+noarg combo with empty default"
@@ -1263,29 +1264,29 @@
#
? {T create t XXX} "invalid argument 'XXX', maybe too many arguments; should be \"::t configure ?z?\""
- ::obj mixin {}
+ ::obj object mixin {}
T setObjectParams [list z:alias]
? {T create tt YYY} "::obj: unable to dispatch method 'YYY'" "sending the msg: tt->z(::obj)->YYY()"
- ::obj mixin UnknownHandler
+ ::obj object mixin UnknownHandler
? {T create tt YYY} "CURRENT-::obj-DELEGATOR-::tt-UNKNOWNMETHOD-YYY-PATH-z" \
"sending the msg: tt->z(::obj)->YYY()"
- ::obj mixin {}
+ ::obj object mixin {}
T setObjectParams [list -z:alias]
? {T create tt -z YYY} "::obj: unable to dispatch method 'YYY'" "sending the msg: tt->z(::obj)->YYY()"
- ::obj mixin UnknownHandler
+ ::obj object mixin UnknownHandler
? {T create tt -z YYY} "CURRENT-::obj-DELEGATOR-::tt-UNKNOWNMETHOD-YYY-PATH-z" \
"sending the msg: tt->z(::obj)->YYY()"
#
# [current methodpath] & empty selector strings:
#
- ::obj mixin {}
+ ::obj object mixin {}
T setObjectParams [list z:alias]
? {T create tt ""} "::obj: unable to dispatch method ''" "sending the msg: tt->z->{}()"
- ::obj mixin UnknownHandler
+ ::obj object mixin UnknownHandler
? {T create tt ""} "CURRENT-::obj-DELEGATOR-::tt-UNKNOWNMETHOD--PATH-z" "sending the msg: tt->z->{}()"
T setObjectParams [list -z:alias]
? {T create tt -z ""} "CURRENT-::obj-DELEGATOR-::tt-UNKNOWNMETHOD--PATH-z" "sending the msg: tt->z()"
Index: tests/forward.test
===================================================================
diff -u -ra24e1f836c3126d0a0e9467bde3a9fa8da901711 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/forward.test (.../forward.test) (revision a24e1f836c3126d0a0e9467bde3a9fa8da901711)
+++ tests/forward.test (.../forward.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -9,9 +9,9 @@
Test case delegation {
Object create dog
Object create tail {
- :public method wag args { return $args }
+ :public object method wag args { return $args }
}
- dog public forward wag tail %proc
+ dog public object forward wag tail %proc
? {dog wag 100} 100
}
@@ -38,7 +38,7 @@
###########################################
Test case adding {
Object create obj {
- :public forward addOne expr 1 +
+ :public object forward addOne expr 1 +
}
? {obj addOne 5} 6
@@ -49,15 +49,15 @@
###########################################
Test case multiple-args {
Object create target {
- :public method foo args {return $args}
+ :public object method foo args {return $args}
}
Object create obj {
- :public forward foo target %proc %self a1 a2
+ :public object forward foo target %proc %self a1 a2
}
? {obj foo x1 x2} [list ::obj a1 a2 x1 x2]
- obj public forward foo target %proc %self %%self %%p
+ obj public object forward foo target %proc %self %%self %%p
? {obj foo x1 x2} [list ::obj %self %p x1 x2]
}
@@ -66,17 +66,17 @@
###########################################
Test case mixin-via-forward {
Object create mixin {
- :method unknown {m args} {return [concat [current] $m $args]}
+ :object method unknown {m args} {return [concat [current] $m $args]}
}
Object create obj {
- :public forward Mixin mixin %1 %self
+ :public object forward Mixin mixin %1 %self
}
? {obj Mixin add M1} [list ::mixin add ::obj M1]
? {catch {obj Mixin}} 1
- obj public forward Mixin mixin "%1 {Getter Setter}" %self
+ obj public object forward Mixin mixin "%1 {Getter Setter}" %self
? {obj Mixin add M1} [list ::mixin add ::obj M1]
? {obj Mixin M1} [list ::mixin Setter ::obj M1]
? {obj Mixin} [list ::mixin Getter ::obj]
@@ -88,14 +88,14 @@
###########################################
Test case info-via-forward {
Object create Info {
- :public method @mixin {o} {
+ :public object method @mixin {o} {
$o info mixin
}
- :public method @class {o} { ;# without prefix, doing here a [Info class] wod be wrong
+ :public object method @class {o} { ;# without prefix, doing here a [Info class] wod be wrong
$o info class
}
- :public method @help {o} { ;# define a new subcommand for info
- foreach c [:info methods] {lappend result [string range $c 1 end]}
+ :public object method @help {o} { ;# define a new subcommand for info
+ foreach c [:info object methods] {lappend result [string range $c 1 end]}
return $result
}
}
@@ -114,7 +114,7 @@
Test case incr {
Object create obj {
set :x 1
- :public forward i1 -objframe incr x
+ :public object forward i1 -objframe incr x
}
? {obj i1} 2
@@ -144,17 +144,17 @@
# check introspection for objects
Object create obj {
- :public forward i1 -objframe incr x
- :public forward Mixin mixin %1 %self
- :public forward foo target %proc %self %%self %%p
- :public forward addOne expr 1 +
+ :public object forward i1 -objframe incr x
+ :public object forward Mixin mixin %1 %self
+ :public object forward foo target %proc %self %%self %%p
+ :public object forward addOne expr 1 +
}
- ? {lsort [obj info methods -methodtype forwarder]} "Mixin addOne foo i1"
- ? {obj info method definition Mixin} "::obj public forward Mixin mixin %1 %self"
- ? {obj info method definition addOne} "::obj public forward addOne expr 1 +"
- ? {obj info method definition foo} "::obj public forward foo target %proc %self %%self %%p"
- ? {obj info method definition i1} "::obj public forward i1 -objframe ::incr x"
+ ? {lsort [obj info object methods -methodtype forwarder]} "Mixin addOne foo i1"
+ ? {obj info object method definition Mixin} "::obj public object forward Mixin mixin %1 %self"
+ ? {obj info object method definition addOne} "::obj public object forward addOne expr 1 +"
+ ? {obj info object method definition foo} "::obj public object forward foo target %proc %self %%self %%p"
+ ? {obj info object method definition i1} "::obj public object forward i1 -objframe ::incr x"
}
###########################################
@@ -163,7 +163,7 @@
package require nx::serializer
Test case serializer {
Object create obj {
- :method test {} {puts "i am [current method]"}
+ :object method test {} {puts "i am [current method]"}
}
set ::a [Serializer deepSerialize obj]
#puts <<$::a>>
@@ -177,13 +177,13 @@
Test case optional-target {
Object create obj {
set :x 2
- :public forward append -objframe
+ :public object forward append -objframe
}
? {obj append x y z} 2yz
- Object create n; Object create n::x {:public method current {} {current}}
+ Object create n; Object create n::x {:public object method current {} {current}}
Object create o
- o public forward ::n::x
+ o public object forward ::n::x
? {o x current} ::n::x
}
@@ -193,7 +193,7 @@
Test case percent-cmd {
Object create obj {
set :x 10
- :public forward x* expr {%:eval {set :x}} *
+ :public object forward x* expr {%:eval {set :x}} *
}
? {obj x* 10} "100"
}
@@ -203,56 +203,56 @@
###########################################
Test case positioning-args {
Object create obj
- obj public forward @end-13 list {%@end 13}
+ obj public object forward @end-13 list {%@end 13}
? {obj @end-13 1 2 3 } [list 1 2 3 13]
- obj public forward @-1-13 list {%@-1 13}
+ obj public object forward @-1-13 list {%@-1 13}
? {obj @-1-13 1 2 3 } [list 1 2 13 3]
- obj public forward @1-13 list {%@1 13}
+ obj public object forward @1-13 list {%@1 13}
? {obj @1-13 1 2 3 } [list 13 1 2 3]
? {obj @1-13} [list 13]
- obj public forward @2-13 list {%@2 13}
+ obj public object forward @2-13 list {%@2 13}
? {obj @2-13 1 2 3 } [list 1 13 2 3]
- obj public forward @list 10 {%@0 list} {%@end 99}
+ obj public object forward @list 10 {%@0 list} {%@end 99}
? {obj @list} [list 10 99]
? {obj @list a b c} [list 10 a b c 99]
- obj public forward @list {%@end 99} {%@0 list} 10
+ obj public object forward @list {%@end 99} {%@0 list} 10
? {obj @list} [list 10 99]
? {obj @list a b c} [list 10 a b c 99]
- obj public forward @list {%@2 2} {%@1 1} {%@0 list}
+ obj public object forward @list {%@2 2} {%@1 1} {%@0 list}
? {obj @list} [list 1 2]
? {obj @list a b c} [list 1 2 a b c]
- obj public forward @list x y z {%@0 list} {%@1 1} {%@2 2}
+ obj public object forward @list x y z {%@0 list} {%@1 1} {%@2 2}
? {obj @list} [list 1 2 x y z]
? {obj @list a b c} [list 1 2 x y z a b c]
- obj public forward @list x y z {%@2 2} {%@1 1} {%@0 list}
+ obj public object forward @list x y z {%@2 2} {%@1 1} {%@0 list}
? {obj @list} [list x 1 y 2 z]
? {obj @list a b c} [list x 1 y 2 z a b c]
# adding some test cases which cover the interactions
# between %@POS and %1 substitutions
#
- obj public forward @end-13 list {%@end 13} %1 %self
+ obj public object forward @end-13 list {%@end 13} %1 %self
? {obj @end-13 1 2 3 } [list 1 ::obj 2 3 13]
- obj public forward @end-13 list %1 {%@end 13} %self
+ obj public object forward @end-13 list %1 {%@end 13} %self
? {obj @end-13 1 2 3 } [list 1 ::obj 2 3 13]
- obj public forward @end-13 list {%@end 13} %1 %1 %1 %self
+ obj public object forward @end-13 list {%@end 13} %1 %1 %1 %self
? {obj @end-13 1 2 3 } [list 1 1 1 ::obj 2 3 13]
- obj public forward @end-13 list {%@-1 13} %1 %self
+ obj public object forward @end-13 list {%@-1 13} %1 %self
? {obj @end-13 1 2 3 } [list 1 ::obj 2 13 3]
- obj public forward @end-13 list {%@1 13} %1 %self
+ obj public object forward @end-13 list {%@1 13} %1 %self
? {obj @end-13 1 2 3 } [list 13 1 ::obj 2 3]
}
@@ -261,10 +261,10 @@
###############################################
Test case num-args {
Object create obj {
- :public forward f %self [list %argclindex [list a b c]]
- :method a args {return [list [current method] $args]}
- :method b args {return [list [current method] $args]}
- :method c args {return [list [current method] $args]}
+ :public object forward f %self [list %argclindex [list a b c]]
+ :object method a args {return [list [current method] $args]}
+ :object method b args {return [list [current method] $args]}
+ :object method c args {return [list [current method] $args]}
}
? {obj f} [list a {}]
? {obj f 1 } [list b 1]
@@ -277,8 +277,8 @@
###############################################
Test case earlybinding {
Object create obj {
- #:public forward s -earlybinding ::set ::X
- :public forward s ::set ::X
+ #:public object forward s -earlybinding ::set ::X
+ :public object forward s ::set ::X
}
? {obj s 100} 100
? {obj s} 100
@@ -287,8 +287,8 @@
Class create NS
Class create NS::Main {
- :public class method m1 {} { :m2 }
- :public class method m2 {} {
+ :public object method m1 {} { :m2 }
+ :public object method m2 {} {
? {namespace eval :: {Object create toplevelObj1}} ::toplevelObj1
? [list set _ [namespace current]] ::NS
@@ -367,7 +367,7 @@
Class create C {
:method xx {} {current}
- :public class method t {o expr} {
+ :public object method t {o expr} {
return [$o expr $expr]
}
}
Index: tests/info-method.test
===================================================================
diff -u -r3b5d2f4e0bc018420ebea39e54ad3212ade2a5bd -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/info-method.test (.../info-method.test) (revision 3b5d2f4e0bc018420ebea39e54ad3212ade2a5bd)
+++ tests/info-method.test (.../info-method.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -61,23 +61,23 @@
nx::Test case info-method-base {
nx::Object create o {
- :alias set ::set
+ :object alias set ::set
}
nx::Class create C {
:method m {x} {return proc-[self proc]}
- :class method mpo {} {return instproc-[self proc]}
+ :object method mpo {} {return instproc-[self proc]}
:method m-with-assertions {} {return proc-[self proc]} -precondition 1 -postcondition 2
:forward addOne expr 1 +
- :class forward add1 expr 1 +
- :class forward fpo ::o
+ :object forward add1 expr 1 +
+ :object forward fpo ::o
:property -accessor public s
- :class property -accessor public spo
+ :object property -accessor public spo
:alias a ::set
- :class alias apo ::puts
+ :object alias apo ::puts
}
C create c1
@@ -91,15 +91,15 @@
? {c1 info lookup method addOne} "::nsf::classes::C::addOne"
? {c1 info lookup method m} "::nsf::classes::C::m"
? {c1 info lookup method s} "::nsf::classes::C::s"
- c1 method foo {} {puts foo}
- ? {c1 info method definition foo} "::c1 public method foo {} {puts foo}"
+ c1 object method foo {} {puts foo}
+ ? {c1 info object method definition foo} "::c1 public object method foo {} {puts foo}"
? {c1 info lookup method foo} "::c1::foo"
? {C info method registrationhandle m} "::nsf::classes::C::m"
- ? {C class info method registrationhandle mpo} "::C::mpo"
+ ? {C info object method registrationhandle mpo} "::C::mpo"
? {C info method definition m} {::C public method m x {return proc-[self proc]}}
- ? {C class info method definition mpo} {::C public class method mpo {} {return instproc-[self proc]}}
+ ? {C info object method definition mpo} {::C public object method mpo {} {return instproc-[self proc]}}
if {$::nsf::config(assertions)} {
? {C info method definition m-with-assertions} \
{::C public method m-with-assertions {} {return proc-[self proc]} -precondition 1 -postcondition 2}
@@ -110,26 +110,26 @@
? {C info method parameter m} {x}
? {nx::Class info method parameter method} \
{name arguments:parameter,0..* -returns body -precondition -postcondition}
- ? {nx::Object info method parameter alias} \
+ ? {nx::Class info method parameter alias} \
{methodName -returns {-frame default} cmd}
# raises currently an error
? {catch {C info method parameter a}} 1
? {C info method definition addOne} "::C public forward addOne expr 1 +"
- ? {C class info method definition add1} "::C public class forward add1 expr 1 +"
- ? {C class info method definition fpo} "::C public class forward fpo ::o"
+ ? {C info object method definition add1} "::C public object forward add1 expr 1 +"
+ ? {C info object method definition fpo} "::C public object forward fpo ::o"
? {C info method definition s} "::C public setter s"
- ? {C class info method definition spo} "::C public class setter spo"
+ ? {C info object method definition spo} "::C public object setter spo"
? {C info method definition a} "::C public alias a ::set"
- ? {C class info method definition apo} "::C public class alias apo ::puts"
+ ? {C info object method definition apo} "::C public object alias apo ::puts"
? {::nx::Object info lookup methods -source application} ""
? {::nx::Class info lookup methods -source application} ""
- set object_methods "alias cget configure contains copy delete destroy eval filter forward info method mixin move private property protected public require variable volatile"
- set class_methods "alias cget class configure contains copy create delete destroy eval filter forward info method mixin move new private property protected public require variable volatile"
+ set object_methods "cget configure contains copy delete destroy eval info move object private property protected public require variable volatile"
+ set class_methods "alias cget configure contains copy create delete destroy eval filter forward info method mixin move new object private property protected public require variable volatile"
? {lsort [::nx::Object info lookup methods -source baseclasses]} $class_methods
? {lsort [::nx::Class info lookup methods -source baseclasses]} $class_methods
@@ -152,7 +152,7 @@
:protected method bar1 args {;}
:method bar2 args {;}
:public method foo args {;}
- :public class method foo args {;}
+ :public object method foo args {;}
}
? {lsort [MC info methods -methodtype scripted -callprotection public]} "foo"
@@ -176,15 +176,15 @@
nx::Test case visability-sub-objects {
::nx::Object create o {
::nx::Object create [::nx::self]::sub {
- :method foo {} {;}
+ :object method foo {} {;}
}
- :public alias soAlias ::o::sub
+ :public object alias soAlias ::o::sub
}
#
# per default, we see the alias and the subobject
#
- ? {o info methods} "soAlias sub"
- ? {o info method type soAlias} "alias"
+ ? {o info object methods} "soAlias sub"
+ ? {o info object method type soAlias} "alias"
# the subobject can be hidden via private (see protection.test)
}
@@ -243,34 +243,34 @@
# alias to tcl-cmd (no param defs for in-parameters)
:alias incr -returns integer -frame object ::incr
:forward ++ -returns integer ::expr 1 +
- :public class method instances {} -returns object,1..n {:info instances}
+ :public object method instances {} -returns object,1..n {:info instances}
:create c1 {
- :public method foo {} -returns integer {;}
- :public method "bar baz" {} -returns integer {;}
- :public method "bar boo" {} -returns integer {;}
+ :public object method foo {} -returns integer {;}
+ :public object method "bar baz" {} -returns integer {;}
+ :public object method "bar boo" {} -returns integer {;}
}
}
? {C info method returns bar-ok1} "integer"
? {C info method returns bar-nok} "integer"
? {C info method returns incr} "integer"
? {C info method returns ++} "integer"
- ? {C class info method returns instances} "object,1..n"
- ? {c1 info method returns foo} "integer"
- ? {c1 info method returns "bar baz"} "integer"
- ? {c1 info method returns "bar boo"} "integer"
+ ? {C info object method returns instances} "object,1..n"
+ ? {c1 info object method returns foo} "integer"
+ ? {c1 info object method returns "bar baz"} "integer"
+ ? {c1 info object method returns "bar boo"} "integer"
#
# Ensemble object ...
#
- ? {c1 info method returns bar} ""
+ ? {c1 info object method returns bar} ""
#
# Non-existing method ...
#
- ? {c1 info method returns baf} ""
+ ? {c1 info object method returns baf} ""
#
# Non-existing submethod ...
#
- ? {c1 info method returns "bar baf"} ""
+ ? {c1 info object method returns "bar baf"} ""
}
nx::Test case method-definition-with-returns {
@@ -285,10 +285,10 @@
# alias to tcl-cmd (no param defs for in-parameters)
:alias incr -returns integer -frame object ::incr
:forward ++ -returns integer ::expr 1 +
- :public class method instances {} -returns object,1..n {;}
+ :public object method instances {} -returns object,1..n {;}
:create c1 {
- :public method foo {} -returns integer {;}
- :method "bar baz" {} -returns integer {;}
+ :public object method foo {} -returns integer {;}
+ :object method "bar baz" {} -returns integer {;}
}
}
@@ -298,11 +298,11 @@
? {C info method definition incr} "::C public alias incr -frame object -returns integer ::incr"
? {C info method definition ++} "::C public forward ++ -returns integer ::expr 1 +"
- ? {C class info method definition instances} \
- "::C public class method instances {} -returns object,1..n {;}"
+ ? {C info object method definition instances} \
+ "::C public object method instances {} -returns object,1..n {;}"
- ? {c1 info method definition foo} "::c1 public method foo {} -returns integer {;}"
- ? {c1 info method definition "bar baz"} "::c1 public method {bar baz} {} -returns integer {;}"
+ ? {c1 info object method definition foo} "::c1 public object method foo {} -returns integer {;}"
+ ? {c1 info object method definition "bar baz"} "::c1 public object method {bar baz} {} -returns integer {;}"
}
@@ -315,20 +315,20 @@
# alias to tcl-cmd (no param defs for in-parameters)
:alias incr -returns integer -frame object ::incr
:forward ++ -returns integer ::expr 1 +
- :public class method instances {} -returns object,1..n {;}
+ :public object method instances {} -returns object,1..n {;}
:create c1 {
- :public method foo {} -returns integer {;}
- :method "bar baz" {} -returns integer {;}
+ :public object method foo {} -returns integer {;}
+ :object method "bar baz" {} -returns integer {;}
}
}
c1 copy c2
- ? {c2 info method returns foo} [c1 info method returns foo]
- ? {c2 info method definition foo} [lreplace [c1 info method definition foo] 0 0 ::c2]
- ? {c2 info method returns "bar baz"} [c1 info method returns "bar baz"]
- ? {c2 info method definition "bar baz"} [lreplace [c1 info method definition "bar baz"] 0 0 ::c2]
- ? {c2 info method returns "bar boo"} [c1 info method returns "bar boo"]
+ ? {c2 info object method returns foo} [c1 info object method returns foo]
+ ? {c2 info object method definition foo} [lreplace [c1 info object method definition foo] 0 0 ::c2]
+ ? {c2 info object method returns "bar baz"} [c1 info object method returns "bar baz"]
+ ? {c2 info object method definition "bar baz"} [lreplace [c1 info object method definition "bar baz"] 0 0 ::c2]
+ ? {c2 info object method returns "bar boo"} [c1 info object method returns "bar boo"]
C copy CC
@@ -342,8 +342,8 @@
#
# ? {CC info method returns incr} [C info method returns incr]
# ? {CC info method returns ++} [C info method returns ++]
- ? {CC class info method returns instances} [C class info method returns instances]
- ? {CC class info method definition instances} [lreplace [C class info method definition instances] 0 0 ::CC]
+ ? {CC info object method returns instances} [C info object method returns instances]
+ ? {CC info object method definition instances} [lreplace [C info object method definition instances] 0 0 ::CC]
}
#
@@ -364,36 +364,36 @@
? {o info lookup methods bar} bar
? {o bar} Object.bar
- o mixin ::nx::Class
+ o object mixin ::nx::Class
? {o info precedence} "::nx::Class ::nx::Object"
? {o info lookup method bar} "::nsf::classes::nx::Class::bar"
? {o info lookup methods bar} bar
? {o info lookup methods create} ""
? {o info lookup method create} ""
? {o bar} Class.bar
- ? {o method foo {} {return o.foo}} "::o::foo"
- ? {o alias is ::nsf::is} "::o::is"
- #? {o property x} {variable definition for 'x' (without value and accessor) is useless}
+ ? {o object method foo {} {return o.foo}} "::o::foo"
+ ? {o object alias is ::nsf::is} "::o::is"
+ #? {o object property x} {variable definition for 'x' (without value and accessor) is useless}
? {o property x} "::o::x"
? {o property -accessor public x} "::o::x"
- ? {lsort [o info methods]} "foo is x"
+ ? {lsort [o info object methods]} "foo is x"
#? {o property A} {variable definition for 'A' (without value and accessor) is useless}
? {o property A} ::o::A
? {o property -accessor public A} ::o::A
- ? {o forward fwd ::set} ::o::fwd
- ? {lsort [o info methods]} "A foo fwd is x"
+ ? {o object forward fwd ::set} ::o::fwd
+ ? {lsort [o info object methods]} "A foo fwd is x"
- o method f args ::nx::next
+ o object method f args ::nx::next
? {o info lookup methods create} ""
- ? {o info lookup methods filter} "filter"
- ? {o info lookup method filter} "::nsf::classes::nx::Object::filter"
- ? {o filter f} "f"
- ? {o filter guard f { 1 == 1 }} ""
- ? {o info filter guard f} " 1 == 1 "
- ? {o filter guard f} " 1 == 1 "
- o filter ""
+ ? {o info lookup methods configure} configure
+ ? {o info lookup method configure} "::nsf::classes::nx::Object::configure"
+ ? {o object filter f} "f"
+ ? {o object filter guard f { 1 == 1 }} ""
+ ? {o info object filter guard f} " 1 == 1 "
+ ? {o object filter guard f} " 1 == 1 "
+ o object filter ""
nx::Class create Foo
? {Foo method f args ::nx::next} "::nsf::classes::Foo::f"
@@ -407,26 +407,26 @@
? {Foo info filter methods -guards} "{f -guard {2 == 2}} f2"
? {Foo filter {}} ""
- ? {Foo class method f args ::nx::next} "::Foo::f"
- ? {Foo class method f2 args ::nx::next} "::Foo::f2"
- ? {Foo class filter {f f2}} "f f2"
- ? {Foo class info filter methods} "f f2"
- ? {Foo class filter guard f {2 == 2}} ""
- ? {Foo class info filter guard f} "2 == 2"
- ? {Foo class info filter methods -guards f} "{f -guard {2 == 2}}"
- ? {Foo class info filter methods -guards f2} "f2"
- ? {Foo class info filter methods -guards} "{f -guard {2 == 2}} f2"
- ? {Foo class filter {}} ""
+ ? {Foo object method f args ::nx::next} "::Foo::f"
+ ? {Foo object method f2 args ::nx::next} "::Foo::f2"
+ ? {Foo object filter {f f2}} "f f2"
+ ? {Foo info object filter methods} "f f2"
+ ? {Foo object filter guard f {2 == 2}} ""
+ ? {Foo info object filter guard f} "2 == 2"
+ ? {Foo info object filter methods -guards f} "{f -guard {2 == 2}}"
+ ? {Foo info object filter methods -guards f2} "f2"
+ ? {Foo info object filter methods -guards} "{f -guard {2 == 2}} f2"
+ ? {Foo object filter {}} ""
Foo destroy
nx::Class create Fly
- o mixin add Fly
- ? {o info mixin classes} "::Fly ::nx::Class"
- ? {o mixin guard ::Fly {1}} ""
- ? {o info mixin classes -guards} "{::Fly -guard 1} ::nx::Class"
- ? {o info mixin classes -guards Fly} "{::Fly -guard 1}"
- o mixin delete ::Fly
- ? {o info mixin classes} "::nx::Class"
+ o object mixin add Fly
+ ? {o info object mixin classes} "::Fly ::nx::Class"
+ ? {o object mixin guard ::Fly {1}} ""
+ ? {o info object mixin classes -guards} "{::Fly -guard 1} ::nx::Class"
+ ? {o info object mixin classes -guards Fly} "{::Fly -guard 1}"
+ o object mixin delete ::Fly
+ ? {o info object mixin classes} "::nx::Class"
nx::Class create Foo
Foo mixin add ::nx::Class
@@ -438,20 +438,20 @@
Foo mixin delete ::Fly
? {Foo info mixin classes} "::nx::Class"
- Foo class mixin add ::nx::Class
- Foo class mixin add Fly
- ? {Foo class info mixin classes} "::Fly ::nx::Class"
- ? {Foo class mixin guard ::Fly {1}} ""
- ? {Foo class info mixin classes -guards} "{::Fly -guard 1} ::nx::Class"
- ? {Foo class info mixin classes -guards Fly} "{::Fly -guard 1}"
+ Foo object mixin add ::nx::Class
+ Foo object mixin add Fly
+ ? {Foo info object mixin classes} "::Fly ::nx::Class"
+ ? {Foo object mixin guard ::Fly {1}} ""
+ ? {Foo info object mixin classes -guards} "{::Fly -guard 1} ::nx::Class"
+ ? {Foo info object mixin classes -guards Fly} "{::Fly -guard 1}"
- Foo class mixin delete ::Fly
- ? {Foo class info mixin classes} "::nx::Class"
+ Foo object mixin delete ::Fly
+ ? {Foo info object mixin classes} "::nx::Class"
? {Foo info lookup methods create} "create"
? {Foo info lookup method create} "::nsf::classes::nx::Class::create"
- ? {o mixin ""} ""
+ ? {o object mixin ""} ""
}
@@ -468,7 +468,7 @@
nx::Class create D -superclass C {
:property {b 2}
:property c
- :class property -accessor public {a2 ""}
+ :object property -accessor public {a2 ""}
:method "sub foo" args {;}
:create d1 {
:property -accessor public {a3 ""}
@@ -480,9 +480,9 @@
? {D info slot objects -closure -source application} "::D::slot::b ::D::slot::c ::C::slot::a"
? {d1 info lookup slots -source application} "::d1::per-object-slot::a3 ::D::slot::b ::D::slot::c ::C::slot::a"
- ? {D class info slot objects} "::D::per-object-slot::a2"
+ ? {D info object slot objects} "::D::per-object-slot::a2"
? {d1 info slot objects} "::d1::per-object-slot::a3"
- ? {C class info slot objects} ""
+ ? {C info object slot objects} ""
}
#
@@ -498,28 +498,28 @@
nx::Class create D -superclass C {
:property {b 2}
:property c
- :class property -accessor public a2
+ :object property -accessor public a2
:method "sub foo" args {;}
}
- ? {D info lookup slots} "::D::per-object-slot::a2 ::nx::Class::slot::superclass ::nx::Class::slot::object-mixin ::nx::Class::slot::mixin ::nx::Class::slot::object-filter ::nx::Class::slot::filter ::nx::Object::slot::volatile ::nx::Object::slot::noinit ::nx::Object::slot::__initcmd ::nx::Object::slot::class"
+ ? {D info lookup slots} "::D::per-object-slot::a2 ::nx::Class::slot::superclass ::nx::Class::slot::mixin ::nx::Class::slot::filter ::nx::Object::slot::volatile ::nx::Object::slot::noinit ::nx::Object::slot::object-mixin ::nx::Object::slot::__initcmd ::nx::Object::slot::class ::nx::Object::slot::object-filter"
C create c1
? {c1 info precedence} "::C ::nx::Object"
? {C info heritage} "::nx::Object"
? {C info slot objects -closure -source application} "::C::slot::a ::C::slot::b"
- ? {C info slot objects -closure} "::C::slot::a ::C::slot::b ::nx::Object::slot::volatile ::nx::Object::slot::noinit ::nx::Object::slot::mixin ::nx::Object::slot::__initcmd ::nx::Object::slot::class ::nx::Object::slot::filter"
+ ? {C info slot objects -closure} "::C::slot::a ::C::slot::b ::nx::Object::slot::volatile ::nx::Object::slot::noinit ::nx::Object::slot::object-mixin ::nx::Object::slot::__initcmd ::nx::Object::slot::class ::nx::Object::slot::object-filter"
? {C info slot objects} "::C::slot::a ::C::slot::b"
# Test patterns for "info slot objects"
# Partial name, no metachars
- ? {C info slot objects -closure mixin} "::nx::Object::slot::mixin"
+ ? {C info slot objects -closure object-mixin} "::nx::Object::slot::object-mixin"
# Partial name with metachars
? {C info slot objects -closure *in*} \
- "::nx::Object::slot::noinit ::nx::Object::slot::mixin ::nx::Object::slot::__initcmd"
+ "::nx::Object::slot::noinit ::nx::Object::slot::object-mixin ::nx::Object::slot::__initcmd"
# Fully qualified name, no metachars
- ? {C info slot objects -closure ::nx::Object::slot::mixin} "::nx::Object::slot::mixin"
+ ? {C info slot objects -closure ::nx::Object::slot::object-mixin} "::nx::Object::slot::object-mixin"
# Fully qualified name, with metachars
# The following command returns the same as "C info slot objects"
? {C info slot objects -closure ::C::*} "::C::slot::a ::C::slot::b"
@@ -529,12 +529,12 @@
# Test patterns for "info lookup slots"
# Partial name, no metachars
- ? {c1 info lookup slots mixin} "::nx::Object::slot::mixin"
+ ? {c1 info lookup slots object-mixin} "::nx::Object::slot::object-mixin"
# Partial name with metachars
? {c1 info lookup slots *in*} \
- "::nx::Object::slot::noinit ::nx::Object::slot::mixin ::nx::Object::slot::__initcmd"
+ "::nx::Object::slot::noinit ::nx::Object::slot::object-mixin ::nx::Object::slot::__initcmd"
# Fully qualified name, no metachars
- ? {c1 info lookup slots ::nx::Object::slot::mixin} "::nx::Object::slot::mixin"
+ ? {c1 info lookup slots ::nx::Object::slot::object-mixin} "::nx::Object::slot::object-mixin"
# Fully qualified name, with metachars
? {c1 info lookup slots ::C::*} "::C::slot::a ::C::slot::b"
@@ -545,7 +545,7 @@
? {::nx::Object info method parameter info} ""
? {d1 info precedence} "::D ::C ::nx::Object"
- ? {d1 info lookup slots} "::D::slot::b ::D::slot::c ::C::slot::a ::nx::Object::slot::volatile ::nx::Object::slot::noinit ::nx::Object::slot::mixin ::nx::Object::slot::__initcmd ::nx::Object::slot::class ::nx::Object::slot::filter"
+ ? {d1 info lookup slots} "::D::slot::b ::D::slot::c ::C::slot::a ::nx::Object::slot::volatile ::nx::Object::slot::noinit ::nx::Object::slot::object-mixin ::nx::Object::slot::__initcmd ::nx::Object::slot::class ::nx::Object::slot::object-filter"
# Fully qualified name, with metachars
# The following command returns the slots of D inherited from
@@ -559,8 +559,8 @@
nx::Test case info-submethod {
nx::Object create o {
- :method "foo a" {} {return a}
- :method "foo b" {x:int y:upper} {return b}
+ :object method "foo a" {} {return a}
+ :object method "foo b" {x:int y:upper} {return b}
}
nx::Object create o2
@@ -569,53 +569,53 @@
:method "bar b" {x:int y:upper} {return b}
:method "bar baz x" {x:int y:upper} {return x}
:method "bar baz y" {x:int y:upper} {return y}
- :class method "foo x" {z:int} {return z}
- :class method "foo y" {z:int} {return z}
+ :object method "foo x" {z:int} {return z}
+ :object method "foo y" {z:int} {return z}
}
# query definition on submethod
- ? {o info method definition "foo b"} {::o public method {foo b} {x:int y:upper} {return b}}
+ ? {o info object method definition "foo b"} {::o public object method {foo b} {x:int y:upper} {return b}}
# query definition on submethod with handle
- ? {o info method definition "::o::foo b"} {::o public method {foo b} {x:int y:upper} {return b}}
+ ? {o info object method definition "::o::foo b"} {::o public object method {foo b} {x:int y:upper} {return b}}
# query definition on submethod with handle
- ? {o info method definition "::o::foo b"} {::o public method {foo b} {x:int y:upper} {return b}}
+ ? {o info object method definition "::o::foo b"} {::o public object method {foo b} {x:int y:upper} {return b}}
# query definition on submethod with handle called on different object
- ? {o2 info method definition "::o::foo b"} {::o public method {foo b} {x:int y:upper} {return b}}
+ ? {o2 info object method definition "::o::foo b"} {::o public object method {foo b} {x:int y:upper} {return b}}
# query definition on handle of ensemble object called on different object
- ? {o2 info method definition "::o::foo::b"} {::o::foo public method b {x:int y:upper} {return b}}
+ ? {o2 info object method definition "::o::foo::b"} {::o::foo public object method b {x:int y:upper} {return b}}
# query definition on submethod with handle called on class
- ? {o2 info method definition "::o::foo b"} {::o public method {foo b} {x:int y:upper} {return b}}
+ ? {o2 info object method definition "::o::foo b"} {::o public object method {foo b} {x:int y:upper} {return b}}
# query definition on handle of ensemble object called on class
- ? {o2 info method definition "::o::foo::b"} {::o::foo public method b {x:int y:upper} {return b}}
+ ? {o2 info object method definition "::o::foo::b"} {::o::foo public object method b {x:int y:upper} {return b}}
# query definition on submethod of class
? {::nx::Object info method definition "info lookup methods"} \
{::nx::Object public alias {info lookup methods} ::nsf::methods::object::info::lookupmethods}
# query definition on submethod of class with handle
- ? {o info method definition "::nsf::classes::nx::Object::info lookup methods"} \
+ ? {o info object method definition "::nsf::classes::nx::Object::info lookup methods"} \
{::nx::Object public alias {info lookup methods} ::nsf::methods::object::info::lookupmethods}
# query definition on handle of ensemble object of class
- ? {o info method definition "::nx::Object::slot::__info::lookup::methods"} \
- {::nx::Object::slot::__info::lookup public alias methods ::nsf::methods::object::info::lookupmethods}
+ ? {o info object method definition "::nx::Object::slot::__info::lookup::methods"} \
+ {::nx::Object::slot::__info::lookup public object alias methods ::nsf::methods::object::info::lookupmethods}
- ? {lsort [o info method submethods dummy]} ""
- ? {lsort [o info method submethods foo]} "a b"
- ? {lsort [o info method submethods "foo a"]} ""
+ ? {lsort [o info object method submethods dummy]} ""
+ ? {lsort [o info object method submethods foo]} "a b"
+ ? {lsort [o info object method submethods "foo a"]} ""
? {lsort [C info method submethods "bar"]} "a b baz"
? {lsort [C info method submethods "bar a"]} ""
? {lsort [C info method submethods "bar baz"]} "x y"
? {lsort [C info method submethods "bar baz y"]} ""
- ? {lsort [C class info method submethods "foo"]} "x y"
- ? {lsort [C class info method submethods "foo x"]} ""
+ ? {lsort [C info object method submethods "foo"]} "x y"
+ ? {lsort [C info object method submethods "foo x"]} ""
#
# method handles for ensemble methods
@@ -636,20 +636,20 @@
#
? {C info method definition "bar b"} {::C public method {bar b} {x:int y:upper} {return b}}
? {C info method definition "::nsf::classes::C::bar b"} {::C public method {bar b} {x:int y:upper} {return b}}
- ? {o2 info method definition "::nsf::classes::C::bar b"} {::C public method {bar b} {x:int y:upper} {return b}}
+ ? {o2 info object method definition "::nsf::classes::C::bar b"} {::C public method {bar b} {x:int y:upper} {return b}}
#
# test class modifier on handles
#
- ? {C class info method registrationhandle "foo"} {::C::foo}
- ? {C class info method registrationhandle "foo x"} {::C::foo x}
+ ? {C info object method registrationhandle "foo"} {::C::foo}
+ ? {C info object method registrationhandle "foo x"} {::C::foo x}
#
# info method definition with method paths
#
- ? {C class info method definition "::C::foo x"} {::C public class method {foo x} z:int {return z}}
- ? {C info method definition "::C::foo x"} {::C public class method {foo x} z:int {return z}}
- ? {o2 info method definition "::C::foo x"} {::C public class method {foo x} z:int {return z}}
+ ? {C info object method definition "::C::foo x"} {::C public object method {foo x} z:int {return z}}
+ ? {C info method definition "::C::foo x"} {::C public object method {foo x} z:int {return z}}
+ ? {o2 info object method definition "::C::foo x"} {::C public object method {foo x} z:int {return z}}
? {C info method definition "bar baz y"} \
{::C public method {bar baz y} {x:int y:upper} {return y}}
@@ -664,11 +664,11 @@
? {nx::Object info method syntax "info lookup methods"} \
"?-callprotection all|public|protected|private? ?-incontext? ?-methodtype all|scripted|builtin|alias|forwarder|object|setter|nsfproc? ?-nomixins? ?-path? ?-source all|application|baseclasses? ?pattern?"
- ? {o info method parameter "foo b"} "x:int y:upper"
+ ? {o info object method parameter "foo b"} "x:int y:upper"
? {nx::Object info method parameter ::nx::Object::slot::__info::lookup::methods} \
"-callprotection -incontext:switch -methodtype -nomixins:switch -path:switch -source pattern:optional"
- ? {o info method parameter "::o::foo::b"} "x:int y:upper"
+ ? {o info object method parameter "::o::foo::b"} "x:int y:upper"
? {nx::Object info method registrationhandle "info"} "::nsf::classes::nx::Object::info"
? {nx::Object info method registrationhandle "info lookup methods"} \
@@ -677,7 +677,7 @@
? {nx::Object info method registrationhandle "::nsf::classes::nx::Object::info lookup methods"} \
"::nsf::classes::nx::Object::info lookup methods"
- ? {o info method registrationhandle "foo b"} "::o::foo b"
+ ? {o info object method registrationhandle "foo b"} "::o::foo b"
}
#
@@ -693,28 +693,28 @@
nx::Class create D -superclass C {
:property {b 2}
:property c
- :class property -accessor public a2
+ :object property -accessor public a2
:method "sub foo" args {;}
}
C new
- ? {C info parameter syntax} "?-a value? ?-b value? ?-volatile? ?-noinit? ?-mixin mixinreg ...? ?-class class? ?-filter filterreg ...? ?__initcmd?"
+ ? {C info parameter syntax} "?-a value? ?-b value? ?-volatile? ?-noinit? ?-object-mixin mixinreg ...? ?-class class? ?-object-filter filterreg ...? ?__initcmd?"
? {C info parameter syntax a} "?-a value?"
- ? {C info parameter definitions} "-a {-b 1} -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash"
+ ? {C info parameter definitions} "-a {-b 1} -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -object-mixin:mixinreg,alias,method=::nx::Object::slot::__object::mixin,1..n -class:class,alias,method=::nsf::methods::object::class -object-filter:filterreg,alias,method=::nx::Object::slot::__object::filter,1..n __initcmd:initcmd,optional,noleadingdash"
- ? {C info parameter list} "-a -b -volatile -noinit -mixin -class -filter __initcmd"
- ? {C info parameter names} "a b volatile noinit mixin class filter __initcmd"
- ? {lsort [C info slot objects -closure]} "::C::slot::a ::C::slot::b ::nx::Object::slot::__initcmd ::nx::Object::slot::class ::nx::Object::slot::filter ::nx::Object::slot::mixin ::nx::Object::slot::noinit ::nx::Object::slot::volatile"
+ ? {C info parameter list} "-a -b -volatile -noinit -object-mixin -class -object-filter __initcmd"
+ ? {C info parameter names} "a b volatile noinit object-mixin class object-filter __initcmd"
+ ? {lsort [C info slot objects -closure]} "::C::slot::a ::C::slot::b ::nx::Object::slot::__initcmd ::nx::Object::slot::class ::nx::Object::slot::noinit ::nx::Object::slot::object-filter ::nx::Object::slot::object-mixin ::nx::Object::slot::volatile"
? {C info parameter definitions b} "{-b 1}"
? {D info parameter definitions b} "{-b 2}"
? {D info slot objects -closure b} "::D::slot::b"
? {D info slot objects -closure a} "::C::slot::a"
? {D info slot objects -closure class} "::nx::Object::slot::class"
- ? {D info parameter list} "-b -c -a -volatile -noinit -mixin -class -filter __initcmd"
- ? {D info parameter names} "b c a volatile noinit mixin class filter __initcmd"
+ ? {D info parameter list} "-b -c -a -volatile -noinit -object-mixin -class -object-filter __initcmd"
+ ? {D info parameter names} "b c a volatile noinit object-mixin class object-filter __initcmd"
}
#
@@ -729,13 +729,13 @@
? {lsort [::nx::Object info methods -path "info lookup *"]} \
"{info lookup filter} {info lookup method} {info lookup methods} {info lookup parameter definitions} {info lookup parameter list} {info lookup parameter names} {info lookup parameter syntax} {info lookup slots}"
? {lsort [::nx::Object info methods -path "info *method*"]} \
- "{info filter methods} {info lookup method} {info lookup methods} {info method} {info methods}"
+ "{info lookup method} {info lookup methods} {info object filter methods} {info object method} {info object methods}"
? {lsort [::nx::Object info methods "slots"]} ""
? {lsort [::nx::Object info methods "*slots*"]} ""
? {lsort [::nx::Object info methods -path "*slot*"]} \
"{info lookup slots} {info slot definitions} {info slot names} {info slot objects}"
? {lsort [::nx::Object info methods -path "*filter*"]} \
- "filter {info filter guard} {info filter methods} {info lookup filter}"
+ "{info lookup filter} {info object filter guard} {info object filter methods} {object filter}"
::nx::Class create C {
:public method "string length" {s} {puts length}
@@ -780,12 +780,12 @@
#
nx::Test case parametersyntax {
# a true method
- ? {::nx::Object info method syntax method} "name arguments ?-returns value? body ?-precondition value? ?-postcondition value?"
+ ? {::nx::Class info method syntax method} "name arguments ?-returns value? body ?-precondition value? ?-postcondition value?"
# a forwarder to ::nsf::relation; definition comes via array ::nsf::parametersyntax
- ? {::nx::Object info method syntax mixin} "?classes?|?add class?|?delete class?"
+ ? {::nx::Class info method syntax mixin} "?classes?|?add class?|?delete class?"
- ? {::nx::Object info method syntax ::nx::next} "?arguments?"
- ? {::nx::Object info method syntax ::nsf::xotclnext} "?--noArgs? ?arg ...?"
+ ? {::nx::Class info method syntax ::nx::next} "?arguments?"
+ ? {::nx::Class info method syntax ::nsf::xotclnext} "?--noArgs? ?arg ...?"
}
#
@@ -951,7 +951,7 @@
? {Agent info heritage} "::MovementTest ::nx::Object"
? {a1 info precedence} "::MovementTest ::Agent ::nx::Object"
- a1 mixin {MovementTest MovementLog}
+ a1 object mixin {MovementTest MovementLog}
? {Agent info heritage} "::MovementTest ::nx::Object"
? {a1 info precedence} "::MovementTest ::MovementLog ::Agent ::nx::Object"
@@ -977,9 +977,9 @@
? {B info heritage} "::M1 ::M2 ::A ::nx::Object"
? {b1 info precedence} "::M1 ::M2 ::B ::A ::nx::Object"
- b1 mixin {M1 M1 M4}
+ b1 object mixin {M1 M1 M4}
? {b1 info precedence} "::M1 ::M4 ::M2 ::B ::A ::nx::Object"
- ? {b1 info mixin classes} "::M1 ::M4"
+ ? {b1 info object mixin classes} "::M1 ::M4"
B mixin {M3 M1 M1 M4}
? {B info heritage} "::M3 ::M1 ::M4 ::M2 ::A ::nx::Object"
@@ -999,9 +999,9 @@
? {c1 info precedence} "::C ::nx::Object"
# ::A is an implied class
- c1 mixin B
+ c1 object mixin B
? {c1 info precedence} "::B ::A ::C ::nx::Object"
- ? {c1 info mixin classes -heritage} "::B ::A"
+ ? {c1 info object mixin classes -heritage} "::B ::A"
# ::A is as well implied by ::PCM
C mixin PCM
@@ -1013,7 +1013,7 @@
# ::A is not ordered after ::B but after ::PCM
? {c1 info precedence} "::B ::PCM ::A ::C ::nx::Object"
- ? {c1 info mixin classes -heritage} "::B ::PCM ::A"
+ ? {c1 info object mixin classes -heritage} "::B ::PCM ::A"
}
#
@@ -1121,18 +1121,18 @@
? [list ::nsf::method::registered $h1] ::C
- :class method bar {} {return bar}
- set h2 [:class info method registrationhandle bar]
- ? [list [self] class info method registrationhandle bar] "::C::bar"
+ :object method bar {} {return bar}
+ set h2 [:info object method registrationhandle bar]
+ ? [list [self] info object method registrationhandle bar] "::C::bar"
? [list ::nsf::method::registered $h2] ::C
}
Object create o {
- :method bar {} {return bar}
- set h1 [:info method registrationhandle bar]
+ :object method bar {} {return bar}
+ set h1 [:info object method registrationhandle bar]
? [list set _ $h1] "::o::bar"
- ? [list [self] info method registrationhandle bar] "::o::bar"
+ ? [list [self] info object method registrationhandle bar] "::o::bar"
? [list ::nsf::method::registered $h1] ::o
}
@@ -1150,14 +1150,14 @@
? {set regHandle [C info method registrationhandle "foo bar"]} "::nsf::classes::C::foo bar"
? {set origin [C info method definitionhandle "foo bar"]} "::C::slot::__foo::bar"
- ? {set implHandle [C public class method "foo bar" {x} {;}]} "::C::foo::bar"
- ? {set regHandle [C class info method registrationhandle "foo bar"]} "::C::foo bar"
- ? {set origin [C class info method definitionhandle "foo bar"]} "::C::foo::bar"
+ ? {set implHandle [C public object method "foo bar" {x} {;}]} "::C::foo::bar"
+ ? {set regHandle [C info object method registrationhandle "foo bar"]} "::C::foo bar"
+ ? {set origin [C info object method definitionhandle "foo bar"]} "::C::foo::bar"
Object create o
- ? {set implHandle [o public method "foo bar" {x} {;}]} "::o::foo::bar"
- ? {set regHandle [o info method registrationhandle "foo bar"]} "::o::foo bar"
- ? {set origin [o info method definitionhandle "foo bar"]} "::o::foo::bar"
+ ? {set implHandle [o public object method "foo bar" {x} {;}]} "::o::foo::bar"
+ ? {set regHandle [o info object method registrationhandle "foo bar"]} "::o::foo bar"
+ ? {set origin [o info object method definitionhandle "foo bar"]} "::o::foo::bar"
}
#
Index: tests/interceptor-slot.test
===================================================================
diff -u -r9124d823b4eb4a8b5969b9fa1b6eab7252ba83b4 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/interceptor-slot.test (.../interceptor-slot.test) (revision 9124d823b4eb4a8b5969b9fa1b6eab7252ba83b4)
+++ tests/interceptor-slot.test (.../interceptor-slot.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -49,19 +49,19 @@
#
Test case per-object-mixin {
? {c1 info precedence} "::C ::nx::Object"
- ? {c1 mixin add M} ::M
+ ? {c1 object mixin add M} ::M
? {::nsf::relation c1 object-mixin} ::M
- ? {catch {c1 mixin UNKNOWN}} 1
+ ? {catch {c1 object mixin UNKNOWN}} 1
? {::nsf::relation c1 object-mixin} "::M"
# add again the same mixin
- ? {c1 mixin add M} {::M}
+ ? {c1 object mixin add M} {::M}
? {c1 info precedence} "::M ::C ::nx::Object"
- ? {c1 mixin add M2} "::M2 ::M"
+ ? {c1 object mixin add M2} "::M2 ::M"
? {c1 info precedence} "::M2 ::M ::C ::nx::Object"
- ? {c1 mixin delete M} "::M2"
+ ? {c1 object mixin delete M} "::M2"
? {c1 info precedence} "::M2 ::C ::nx::Object"
- ? {c1 mixin delete M2} ""
+ ? {c1 object mixin delete M2} ""
? {c1 info precedence} "::C ::nx::Object"
}
@@ -72,7 +72,7 @@
Test case object-mixin-relation {
? {::nsf::relation C object-mixin M} ::M
? {C info precedence} "::M ::nx::Class ::nx::Object"
- ? {C class info mixin classes} "::M"
+ ? {C info object mixin classes} "::M"
? {::nsf::relation C object-mixin ""} ""
? {C info precedence} "::nx::Class ::nx::Object"
}
@@ -83,45 +83,45 @@
#
# C object-mixin M
# ? {C info precedence} "::M ::nx::Class ::nx::Object"
- # ? {C class info mixin classes} "::M"
+ # ? {C info object mixin classes} "::M"
# C object-mixin ""
# ? {C info precedence} "::nx::Class ::nx::Object"
#
-# add and remove class mixin for classes via modifier "class" and
+# add and remove object mixin for classes via modifier "object" and
# "mixin"
#
Test case class+mixin {
- ? {C class mixin M} ::M
+ ? {C object mixin M} ::M
? {C info precedence} "::M ::nx::Class ::nx::Object"
- ? {C class info mixin classes} "::M"
- ? {C class mixin ""} ""
+ ? {C info object mixin classes} "::M"
+ ? {C object mixin ""} ""
? {C info precedence} "::nx::Class ::nx::Object"
}
#
-# add and remove class mixin for classes via class mixin add
+# add and remove object mixin for classes via object mixin add
#
Test case class+mixin-add {
- ? {C class mixin add M} ::M
+ ? {C object mixin add M} ::M
? {C info precedence} "::M ::nx::Class ::nx::Object"
- ? {C class info mixin classes} "::M"
- ? {C class mixin ""} ""
+ ? {C info object mixin classes} "::M"
+ ? {C object mixin ""} ""
? {C info precedence} "::nx::Class ::nx::Object"
- ? {C class mixin add M} ::M
+ ? {C object mixin add M} ::M
? {C info precedence} "::M ::nx::Class ::nx::Object"
? {::nsf::relation C object-mixin} ::M
- ? {catch {C class mixin add UNKNOWN}} 1
+ ? {catch {C object mixin add UNKNOWN}} 1
? {::nsf::relation C object-mixin} "::M"
- ? {C class mixin ""} ""
+ ? {C object mixin ""} ""
? {C info precedence} "::nx::Class ::nx::Object"
- ? {C class mixin M} ::M
+ ? {C object mixin M} ::M
? {C info precedence} "::M ::nx::Class ::nx::Object"
# forwarder with 0 arguments + flag
- ? {C class mixin} "::M"
+ ? {C object mixin} "::M"
}
@@ -135,17 +135,17 @@
Class create C1
? {C1 info lookup method mixin} "::nsf::classes::nx::Class::mixin"
- C1 class mixin M1
+ C1 object mixin M1
? {C1 info precedence} "::M1 ::nx::Class ::nx::Object"
C1 create c11
? {c11 info precedence} "::C1 ::nx::Object"
- C1 class mixin add M11
+ C1 object mixin add M11
? {C1 info precedence} "::M11 ::M1 ::nx::Class ::nx::Object"
- Object create o -mixin M1
+ Object create o -object-mixin M1
? {o info precedence} "::M1 ::nx::Object"
Class create O
- O class mixin M1
+ O object mixin M1
? {O info precedence} "::M1 ::nx::Class ::nx::Object"
Class create O -object-mixin M1
? {O info precedence} "::M1 ::nx::Class ::nx::Object"
@@ -155,37 +155,37 @@
nx::Class create CC {
:public method filterA args {next}
:public method filterB args {next}
- :public class method filterC args {next}
+ :public object method filterC args {next}
:create cc {
- :public method filterD args {next}
+ :public object method filterD args {next}
}
}
? {::nsf::relation cc object-filter} ""
- ? {cc info filter methods} ""
+ ? {cc info object filter methods} ""
? {::nsf::relation cc object-filter filterA} filterA
- ? {cc info filter methods} "filterA"
- ? {cc filter filterB} "filterB"
+ ? {cc info object filter methods} "filterA"
+ ? {cc object filter filterB} "filterB"
? {::nsf::relation cc object-filter} "filterB"
- ? {cc info filter methods} "filterB"
- ? {cc filter add filterD} "filterD filterB"
+ ? {cc info object filter methods} "filterB"
+ ? {cc object filter add filterD} "filterD filterB"
? {::nsf::relation cc object-filter} "filterD filterB"
- ? {cc info filter methods} "filterD filterB"
- ? {cc filter delete filterB} "filterD"
+ ? {cc info object filter methods} "filterD filterB"
+ ? {cc object filter delete filterB} "filterD"
? {::nsf::relation cc object-filter} "filterD"
- ? {cc info filter methods} "filterD"
+ ? {cc info object filter methods} "filterD"
? {catch {::nsf::relation cc object-filter UNKNOWN}} 1
? {::nsf::relation cc object-filter} "filterD"
- ? {cc info filter methods} "filterD"
+ ? {cc info object filter methods} "filterD"
? {::nsf::relation CC object-filter} ""
- ? {CC class info filter methods} ""
+ ? {CC info object filter methods} ""
? {::nsf::relation CC object-filter filterC} "filterC"
? {::nsf::relation CC object-filter} "filterC"
- ? {CC class info filter methods} "filterC"
+ ? {CC info object filter methods} "filterC"
? {::nsf::relation CC object-filter ""} ""
? {::nsf::relation CC object-filter} ""
- ? {CC class info filter methods} ""
+ ? {CC info object filter methods} ""
? {::nsf::relation CC class-filter} ""
? {CC info filter methods} ""
@@ -261,7 +261,7 @@
? {ob2 baz} {}
# create with filter
- ? {Foo create ob3 -filter myfilter} ::ob3
+ ? {Foo create ob3 -object-filter myfilter} ::ob3
}
@@ -328,7 +328,7 @@
Class create Y {:public method foo {} {return "Y [next]"}}
Class create Z -superclass Y {:public method foo {} {return "Z [next]"}}
- Z create c1 -mixin {C B A}
+ Z create c1 -object-mixin {C B A}
? {c1 foo} "C B A Z Y "
? {c1 [C info method definitionhandle foo]} "C B A Z Y "
? {c1 [B info method definitionhandle foo]} "B A Z Y "
@@ -383,7 +383,7 @@
Class create Y {:public method foo {} {return "Y [next]"}}
Class create Z -superclass Y {:public method foo {} {return "Z [next]"}}
- Z create c1 -mixin {C B A}
+ Z create c1 -object-mixin {C B A}
? {c1 foo} "C B A Z Y "
? {nsf::dispatch c1 -intrinsic foo} "Z Y "
Index: tests/interp.test
===================================================================
diff -u -r6d831cc09c3eea83a17baa5ef05dfeb79b05836e -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/interp.test (.../interp.test) (revision 6d831cc09c3eea83a17baa5ef05dfeb79b05836e)
+++ tests/interp.test (.../interp.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -31,8 +31,8 @@
# nested objects are not concerned ...
#
$i eval {nx::Object create ::o {
- :public method baz {} { return KO }
- :public method destroy {} {
+ :public object method baz {} { return KO }
+ :public object method destroy {} {
#
# sets a global variable for tracing the processing of the
# app-level destructor!
@@ -84,7 +84,7 @@
? {interp eval $i {::C create ::c}} ::c
# set some relationships to test later ...
? {interp eval $i {::C mixin add ::M}} ::M
- ? {interp eval $i {::C class mixin add ::M}} ::M
+ ? {interp eval $i {::C object mixin add ::M}} ::M
$i hide C
? {interp eval $i {::C create ::c2}} {invalid command name "::C"}
@@ -167,7 +167,7 @@
$i eval {
package req nx
nx::Object create ::o2 {
- :public method destroy {} {
+ :public object method destroy {} {
next
return ok
}
@@ -205,11 +205,11 @@
$i eval {
package req nx
nx::Object create ::o {
- :public method destroy {} {
+ :public object method destroy {} {
incr ::[namespace tail [current]]
return OK
}
- :public method foo {} {
+ :public object method foo {} {
return [list [current object] [current class] [:info class] [[current] info class]]
}
}
@@ -258,11 +258,11 @@
$i eval {
package req nx
nx::Object create ::o {
- :public method destroy {} {
+ :public object method destroy {} {
incr ::[namespace tail [current]]
return OK
}
- :public method foo {} {
+ :public object method foo {} {
catch {[current] info class} msg
return [list [current object] [current class] [:info class] $msg]
}
@@ -317,7 +317,7 @@
package req nx
namespace eval ::ns1 {
nx::Object create o {
- :public method destroy {} {
+ :public object method destroy {} {
incr ::[namespace tail [current]]
return OK
}
@@ -361,15 +361,15 @@
$i eval {
package req nx
nx::Object create ::o {
- :public method destroy {} {
+ :public object method destroy {} {
incr ::[namespace tail [current]]
interp invokehidden {} C destroy
next
}
}
nx::Class create ::C {
- :public class method destroy {} {
+ :public object method destroy {} {
incr ::[namespace tail [current]]
next
}
@@ -398,7 +398,7 @@
$i eval {
package req nx
nx::Object create ::o {
- :public method destroy {} {
+ :public object method destroy {} {
error BAFF!
}
}
@@ -439,7 +439,7 @@
}
nx::Object create ::o {
- :public method destroy {} {
+ :public object method destroy {} {
#
# Would not be an issue in safe interps, as [interp hide] &
# friends are disallowed ...
@@ -478,7 +478,7 @@
$i eval {
package req nx
nx::Object create ::o {
- :public method destroy {} {
+ :public object method destroy {} {
catch {::rename [current] ""} msg
next
return $msg
@@ -514,7 +514,7 @@
package req nx
::proc ::FOO args {return OK}
nx::Object create o {
- :public alias foo ::FOO
+ :public object alias foo ::FOO
}
}
@@ -590,10 +590,10 @@
$i eval {
package req nx
nx::Object create x {
- :public method foo {} {return OK}
+ :public object method foo {} {return OK}
}
nx::Object create dongo {
- :public alias bar ::x
+ :public object alias bar ::x
}
}
@@ -653,14 +653,14 @@
$i eval {
package req nx
nx::Object create x {
- :public method foo {} {return OK}
+ :public object method foo {} {return OK}
}
nx::Class create M {
:public method foo {} {
return <[current class]>[next]<[current class]>
}
}
- x mixin M
+ x object mixin M
}
? {$i eval {x foo}} <::M>OK<::M>
@@ -692,7 +692,7 @@
$i hide MM M
$i eval {nx::Class create ::M2}
- ? {$i eval {x mixin add M2}} {mixin: expected a class as mixin but got "::M"}
+ ? {$i eval {x object mixin add M2}} {mixin: expected a class as mixin but got "::M"}
? {$i invokehidden M mixin add M2} {expected object but got "::M" for parameter "object"}
interp delete $i
@@ -712,11 +712,11 @@
nx::Class create M1
nx::Class create M2
nx::Class create M3
- o mixin {M1 M2}
+ o object mixin {M1 M2}
}
? {$i eval {o info precedence}} "::M1 ::M2 ::nx::Object"
- ? {$i eval {o info mixin classes}} {::M1 ::M2}
+ ? {$i eval {o info object mixin classes}} {::M1 ::M2}
? {$i hidden} ""
$i hide M1
? {$i hidden} M1
@@ -733,7 +733,7 @@
#
$i eval {::M2 destroy}
? {$i eval {o info precedence}} "::M1 ::nx::Object"
- ? {$i eval {o info mixin classes}} "::M1"
+ ? {$i eval {o info object mixin classes}} "::M1"
? {$i invokehidden M1 info mixinof} "::o"
interp delete $i
Index: tests/method-require.test
===================================================================
diff -u -r827f6d934f60d5ea0c02ea68d9e4cb8fc8a2f7ad -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/method-require.test (.../method-require.test) (revision 827f6d934f60d5ea0c02ea68d9e4cb8fc8a2f7ad)
+++ tests/method-require.test (.../method-require.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -45,12 +45,12 @@
# are multiple set methods, we could point to the right one
? [list [self] require method tcl::set] "::nsf::classes::C::set"
- # class methods
- ? [list [self] require class method lappend] "::C::lappend"
+ # object methods
+ ? [list [self] require object method lappend] "::C::lappend"
- # a scripted class method
- ? [list [self] require class method foo] "::C::foo"
- ? [list [self] require class method x] "::nsf::classes::MIX::x"
+ # a scripted object method
+ ? [list [self] require object method foo] "::C::foo"
+ ? [list [self] require object method x] "::nsf::classes::MIX::x"
? [list [self] require method x] "::nsf::classes::MIX::x"
# looks as well ok:
@@ -66,7 +66,7 @@
? {C require protected method lappend} ::nsf::classes::C::lappend
? {::nsf::method::property C lappend call-protected} 1
- ? {C require protected class method set} ::C::set
+ ? {C require protected object method set} ::C::set
? {::nsf::method::property C ::C::set call-protected} 1
#
# call these methods
@@ -82,20 +82,20 @@
# Definitions directly on object
#
Object create o1
- ? {o1 require method set} ::o1::set
- ? {o1 require method x} ::nsf::classes::MIX::x
+ ? {o1 require object method set} ::o1::set
+ ? {o1 require object method x} ::nsf::classes::MIX::x
- ? {o1 require public method lappend} ::o1::lappend
+ ? {o1 require public object method lappend} ::o1::lappend
? {::nsf::method::property o1 lappend call-protected} 0
- ? {o1 require protected method lappend} ::o1::lappend
+ ? {o1 require protected object method lappend} ::o1::lappend
? {::nsf::method::property o1 lappend call-protected} 1
}
nx::Test case parent-require {
- ::nx::Class public class method __unknown {name} {
+ ::nx::Class public object method __unknown {name} {
#puts stderr "***** __unknown called with <$name>"
::nx::Object create $name
}
Index: tests/methods.test
===================================================================
diff -u -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/methods.test (.../methods.test) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4)
+++ tests/methods.test (.../methods.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -1,5 +1,7 @@
# -*- Tcl -*-
package require nx
+#package require nx::plain-object-method
+
::nx::configure defaultMethodCallProtection false
package require nx::test
@@ -27,47 +29,47 @@
:protected alias protected_alias [C info method registrationhandle protected_method]
# class-object
- :class method plain_object_method {} {return [current method]}
- :public class method public_object_method {} {return [current method]}
- :protected class method protected_object_method {} {return [current method]}
- :class forward plain_object_forward %self plain_object_method
- :public class forward public_object_forward %self public_object_method
- :protected class forward protected_object_forward %self protected_object_method
+ :object method plain_object_method {} {return [current method]}
+ :public object method public_object_method {} {return [current method]}
+ :protected object method protected_object_method {} {return [current method]}
+ :object forward plain_object_forward %self plain_object_method
+ :public object forward public_object_forward %self public_object_method
+ :protected object forward protected_object_forward %self protected_object_method
- :class property {plain_object_setter ""}
- :class property -accessor public {public_object_setter ""}
- :class property -accessor protected {protected_object_setter ""}
+ :object property {plain_object_setter ""}
+ :object property -accessor public {public_object_setter ""}
+ :object property -accessor protected {protected_object_setter ""}
- :class alias plain_object_alias [:class info method registrationhandle plain_object_method]
- :public class alias public_object_alias [:class info method registrationhandle public_object_method]
- :protected class alias protected_object_alias [:class info method registrationhandle protected_object_method]
+ :object alias plain_object_alias [:info object method registrationhandle plain_object_method]
+ :public object alias public_object_alias [:info object method registrationhandle public_object_method]
+ :protected object alias protected_object_alias [:info object method registrationhandle protected_object_method]
}
C create c1 {
# methods
- :method plain_object_method {} {return [current method]}
- :public method public_object_method {} {return [current method]}
- :protected method protected_object_method {} {return [current method]}
+ :object method plain_object_method {} {return [current method]}
+ :public object method public_object_method {} {return [current method]}
+ :protected object method protected_object_method {} {return [current method]}
# forwards
- :forward plain_object_forward %self plain_object_method
- :public forward public_object_forward %self public_object_method
- :protected forward protected_object_forward %self protected_object_method
+ :object forward plain_object_forward %self plain_object_method
+ :public object forward public_object_forward %self public_object_method
+ :protected object forward protected_object_forward %self protected_object_method
# setter
:property {plain_object_setter ""}
:property -accessor public {public_object_setter ""}
:property -accessor protected protected_object_setter
# alias
- :alias plain_object_alias [:info method registrationhandle plain_object_method]
- :public alias public_object_alias [:info method registrationhandle public_object_method]
- :protected alias protected_object_alias [:info method registrationhandle protected_object_method]
+ :object alias plain_object_alias [:info object method registrationhandle plain_object_method]
+ :public object alias public_object_alias [:info object method registrationhandle public_object_method]
+ :protected object alias protected_object_alias [:info object method registrationhandle protected_object_method]
}
C property -accessor public s0
C property -accessor protected s1
? {c1 s0 0} 0
? {::nsf::dispatch c1 s1 1} 1
-C class property -accessor public {s3 ""}
+C object property -accessor public {s3 ""}
? {C s3 3} 3
# create a fresh object (different from c1)
@@ -174,23 +176,23 @@
? {catch {c1 protected_object_alias}} 1
? {::nsf::dispatch c1 protected_object_alias} "protected_object_alias"
- #? {lsort [c1 info methods]} \
+ #? {lsort [c1 info object methods]} \
"plain_object_alias plain_object_forward plain_object_method public_object_alias public_object_forward public_object_method public_object_setter"
- ? {lsort [c1 info methods]} \
+ ? {lsort [c1 info object methods]} \
"plain_object_alias plain_object_forward plain_object_method plain_object_setter public_object_alias public_object_forward public_object_method public_object_setter"
- #? {lsort [C class info methods]} \
+ #? {lsort [C info methods]} \
"plain_object_alias plain_object_forward plain_object_method public_object_alias public_object_forward public_object_method public_object_setter s3"
- ? {lsort [C class info methods]} \
+ ? {lsort [C info object methods]} \
"plain_object_alias plain_object_forward plain_object_method plain_object_setter public_object_alias public_object_forward public_object_method public_object_setter s3"
}
C destroy
nx::Test case colondispatch {
nx::Object create ::o {
- #:public method foo args {;}
- :public method bar args {;}
+ #:public object method foo args {;}
+ :public object method bar args {;}
}
? {o :bar} "::o: method name ':bar' must not start with a colon"
? {o eval :bar} ""
@@ -203,31 +205,31 @@
nx::Class create C
nx::Class create M
- # register the mixin on C as a class mixin and define a mixinguard
+ # register the mixin on C as a object mixin and define a mixinguard
C mixin M
C mixin guard M {1 == 1}
? {C info mixin guard M} "1 == 1"
C mixin guard M {}
? {C info mixin guard M} ""
# now the same as class mixin and class mixin guard
- C class mixin M
- C class mixin guard M {1 == 1}
- ? {C class info mixin guard M} "1 == 1"
- C class mixin guard M {}
- ? {C class info mixin guard M} ""
+ C object mixin M
+ C object mixin guard M {1 == 1}
+ ? {C info object mixin guard M} "1 == 1"
+ C object mixin guard M {}
+ ? {C info object mixin guard M} ""
}
nx::Test case mixin-via-objectparam {
# add an object and class mixin via object-parameter and via slots
nx::Class create M1; nx::Class create M2; nx::Class create M3; nx::Class create M4
nx::Class create C -mixin M1 -object-mixin M2 {
:mixin add M3
- :class mixin add M4
+ :object mixin add M4
}
- ? {lsort [C class info mixin classes]} "::M2 ::M4"
- #? {lsort [C class info mixin classes]} "::M2"
+ ? {lsort [C info object mixin classes]} "::M2 ::M4"
+ #? {lsort [C info object mixin classes]} "::M2"
? {lsort [C info mixin classes]} "::M1 ::M3"
#? {lsort [C info mixin classes]} "::M1"
@@ -239,7 +241,7 @@
nx::Test case next-from-nonpos-args {
nx::Object create o {
- :method bar {-y:required -x:required} {
+ :object method bar {-y:required -x:required} {
#puts stderr "+++ o x=$x, y=$y [current args] ... next [current nextmethod]"
return [list x $x y $y [current args]]
}
@@ -251,7 +253,7 @@
}
}
- o mixin M
+ o object mixin M
? {o bar -x 13 -y 14} "x 13 y 14 {-x 13 -y 14} -- x 13 y 14 {-x 13 -y 14}"
? {o bar -y 14 -x 13} "x 13 y 14 {-y 14 -x 13} -- x 13 y 14 {-y 14 -x 13}"
}
@@ -271,13 +273,13 @@
:property -accessor public {c c1}
:property -accessor protected {d d1}
- set X [:class property -accessor public A]
+ set X [:object property -accessor public A]
? [list set _ $X] "::C::A"
- # class property with default
- :class property {B B2}
- :class property -accessor public {C C2}
- :class property -accessor protected {D D2}
+ # object property with default
+ :object property {B B2}
+ :object property -accessor public {C C2}
+ :object property -accessor protected {D D2}
}
C create c1 -a 1
@@ -318,16 +320,16 @@
:method "Info args" {} {return [current object]-[current method]}
:method "Info foo" {} {return [current object]-[current method]}
- :class method "INFO filter guard" {a b} {return [current object]-[current method]}
- :class 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
Foo create f1 {
- :method "list length" {} {return [current object]-[current method]}
- :method "list reverse" {} {return [current object]-[current method]}
+ :object method "list length" {} {return [current object]-[current method]}
+ :object method "list reverse" {} {return [current object]-[current method]}
}
? {f1 Info filter guard x} "::f1-guard"
@@ -342,14 +344,14 @@
package req nx::serializer
nx::Test case class-object-property {
nx::Class create C {
- :class property -accessor public x
+ :object property -accessor public x
:property -accessor public a:int
:create c1
}
? {C x 1} 1
? {C x} 1
? {lsort [C info methods]} "a"
- ? {lsort [C class info methods]} "x"
+ ? {lsort [C info object methods]} "x"
? {c1 a b} {expected integer but got "b" for parameter "a"}
set s(C) [C serialize]
@@ -371,7 +373,7 @@
# tests should work as again
? {C x} 1
? {lsort [C info methods]} "a"
- ? {lsort [C class info methods]} "x"
+ ? {lsort [C info object methods]} "x"
? {c1 a b} {expected integer but got "b" for parameter "a"}
}
@@ -383,7 +385,7 @@
nx::Test case methoddelete {
nx::Class create C {
:public method foo {x} {return $x}
- :public class method bar {x} {return $x}
+ :public object method bar {x} {return $x}
:create c1
}
@@ -404,15 +406,15 @@
nx::Test case errormessage {
nx::Class create C
? {C public method foo {x} {return $x}} "::nsf::classes::C::foo"
- ? {C public object method bar {x} {return $x}} \
- "'object' is not a method defining method"
- ? {C protected object method bar {x} {return $x}} \
- "'object' is not a method defining method"
- ? {C object method bar {x} {return $x}} \
- {method 'object' unknown for ::C; consider '::C create object method bar x {return $x}' instead of '::C object method bar x {return $x}'}
- #? {C public class object method bar {x} {return $x}} "'object' not allowed to be modified by 'class'"
- ? {C public class object method bar {x} {return $x}} \
- {'object' is not a method defining method}
+ ? {C public Object method bar {x} {return $x}} \
+ "'Object' is not a method defining method"
+ ? {C protected Object method bar {x} {return $x}} \
+ "'Object' is not a method defining method"
+ ? {C Object method bar {x} {return $x}} \
+ {method 'Object' unknown for ::C; consider '::C create Object method bar x {return $x}' instead of '::C Object method bar x {return $x}'}
+ #? {C public object Object method bar {x} {return $x}} "'Object' not allowed to be modified by 'class'"
+ #? {C public object Object method bar {x} {return $x}} \
+ {'Object' is not a method defining method}
}
#
@@ -424,12 +426,12 @@
# property defines a setter, we need a current object
:property -accessor public {a v}
# the other methods don't require them as strong
- :forward b ::o2 bar
- :method foo {} {return [nx::self]}
- :alias x ::o::foo
+ :object forward b ::o2 bar
+ :object method foo {} {return [nx::self]}
+ :object alias x ::o::foo
}
nx::Object create o2 {
- :public method bar {} {return [nx::self]}
+ :public object method bar {} {return [nx::self]}
}
# dispatch methods without current object
@@ -453,9 +455,9 @@
#
nx::Test case scopes {
nx::Object create o1 {
- :public method foo {} {return [namespace current]-[namespace which info]}
- :public method "info foo" {} {return [namespace current]-[namespace which info]}
- :public method "info bar foo" {} {return [namespace current]-[namespace which info]}
+ :public object method foo {} {return [namespace current]-[namespace which info]}
+ :public object method "info foo" {} {return [namespace current]-[namespace which info]}
+ :public object method "info bar foo" {} {return [namespace current]-[namespace which info]}
}
? {o1 foo} "::-::info"
@@ -485,9 +487,9 @@
namespace eval ::ns {
nx::Object create o1 {
- :public method foo {} {return [namespace current]-[namespace which info]}
- :public method "info foo" {} {return [namespace current]-[namespace which info]}
- :public method "info bar foo" {} {return [namespace current]-[namespace which info]}
+ :public object method foo {} {return [namespace current]-[namespace which info]}
+ :public object method "info foo" {} {return [namespace current]-[namespace which info]}
+ :public object method "info bar foo" {} {return [namespace current]-[namespace which info]}
}
nx::Class create C {
:public method foo {} {return [namespace current]-[namespace which info]}
@@ -517,9 +519,9 @@
nx::Test case nested-scopes {
nx::Object create o
nx::Object create o::o1 {
- :public method foo {} {return [namespace current]-[namespace which info]}
- :public method "info foo" {} {return [namespace current]-[namespace which info]}
- :public method "info bar foo" {} {return [namespace current]-[namespace which info]}
+ :public object method foo {} {return [namespace current]-[namespace which info]}
+ :public object method "info foo" {} {return [namespace current]-[namespace which info]}
+ :public object method "info bar foo" {} {return [namespace current]-[namespace which info]}
}
? {o::o1 foo} "::o-::info"
@@ -550,12 +552,12 @@
nx::Object create o1 {
:property -accessor public a1
:property -accessor public a2
- :public method foo {} {return [namespace current]-[namespace which info]}
- :public method "info foo" {} {return [namespace current]-[namespace which info]}
- :public method "info bar foo" {} {return [namespace current]-[namespace which info]}
+ :public object method foo {} {return [namespace current]-[namespace which info]}
+ :public object method "info foo" {} {return [namespace current]-[namespace which info]}
+ :public object method "info bar foo" {} {return [namespace current]-[namespace which info]}
}
- ? {o1 info methods -path} "{info foo} {info bar foo} foo a1 a2"
+ ? {o1 info object methods -path} "{info foo} {info bar foo} foo a1 a2"
? {o1 info children} "::o1::info ::o1::per-object-slot"
? {o1 delete method bar} "::o1: object specific method 'bar' does not exist"
@@ -571,18 +573,18 @@
# try to delete the property again:
? {o1 delete property a1} "::o1: cannot delete object specific property 'a1'"
- ? {o1 info methods -path} "{info foo} {info bar foo} foo a2"
+ ? {o1 info object methods -path} "{info foo} {info bar foo} foo a2"
? {o1 delete property a2} ""
- ? {o1 info methods -path} "{info foo} {info bar foo} foo"
+ ? {o1 info object methods -path} "{info foo} {info bar foo} foo"
? {o1 delete method foo} ""
- ? {o1 info methods -path} "{info foo} {info bar foo}"
+ ? {o1 info object methods -path} "{info foo} {info bar foo}"
? {o1 delete method "info foo"} ""
- ? {o1 info methods -path} "{info bar foo}"
+ ? {o1 info object methods -path} "{info bar foo}"
? {o1 delete method "info bar foo"} ""
- ? {o1 info methods -path} ""
+ ? {o1 info object methods -path} ""
}
#
@@ -594,30 +596,30 @@
#
nx::Test case delete-per-object-on-class {
nx::Class create C {
- :class property -accessor public a1
- :public class method foo {} {return [namespace current]-[namespace which info]}
- :public class method "info foo" {} {return [namespace current]-[namespace which info]}
- :public class method "info bar foo" {} {return [namespace current]-[namespace which info]}
+ :object property -accessor public a1
+ :public object method foo {} {return [namespace current]-[namespace which info]}
+ :public object method "info foo" {} {return [namespace current]-[namespace which info]}
+ :public object method "info bar foo" {} {return [namespace current]-[namespace which info]}
:property -accessor public a2
}
- ? {C class info methods -path} "{info foo} {info bar foo} foo a1"
+ ? {C info object methods -path} "{info foo} {info bar foo} foo a1"
? {C info children} "::C::info ::C::slot ::C::per-object-slot"
- ? {C class delete method bar} "::C: object specific method 'bar' does not exist"
+ ? {C delete object method bar} "::C: object specific method 'bar' does not exist"
- ? {C class delete property a1} ""
- ? {C class info methods -path} "{info foo} {info bar foo} foo"
- ? {C class delete property a1} "::C: cannot delete object specific property 'a1'"
+ ? {C delete object property a1} ""
+ ? {C info object methods -path} "{info foo} {info bar foo} foo"
+ ? {C delete object property a1} "::C: cannot delete object specific property 'a1'"
- ? {C class delete method foo} ""
- ? {C class info methods -path} "{info foo} {info bar foo}"
+ ? {C delete object method foo} ""
+ ? {C info object methods -path} "{info foo} {info bar foo}"
- ? {C class delete method "info foo"} ""
- ? {C class info methods -path} "{info bar foo}"
+ ? {C delete object method "info foo"} ""
+ ? {C info object methods -path} "{info bar foo}"
- ? {C class delete method "info bar foo"} ""
- ? {C class info methods -path} ""
+ ? {C delete object method "info bar foo"} ""
+ ? {C info object methods -path} ""
? {C info methods} "a2"
? {C info slot objects} "::C::slot::a2"
@@ -669,23 +671,23 @@
# calling unknown with a plain "method" without arguments
#
::nx::Class create A {
- :class method unknown args {? [list set _ $args] "hello"}
+ :object method unknown args {? [list set _ $args] "hello"}
}
A hello
#
# calling unknown with a plain "method" with arguments
#
::nx::Class create B {
- :class method unknown args {? [list set _ $args] "hello world"}
+ :object method unknown args {? [list set _ $args] "hello world"}
}
B hello world
#
# calling unknown with a method with spaces
#
::nx::Class create C {
- :class method unknown args {? [list set _ $args] "{hello world}"}
+ :object method unknown args {? [list set _ $args] "{hello world}"}
}
C {hello world}
}
@@ -702,17 +704,17 @@
# define various forms of simple dispatches
#
::nx::Object create o {
- :public method foo {} {return ::o}
- :public method bar00 {} {self}
- :public method bar01 {} {:}
- :public method bar02 {} {[self]}
- :public method bar03 {} {[:]}
- :public method bar04 {} {:foo}
- :public method bar05 {} {: foo}
- #:public method bar06 {} {my foo}
- :public method bar07 {} {[self] foo}
- :public method bar08 {} {: -system info methods foo}
- #:public method bar09 {} {my -system info methods foo}
+ :public object method foo {} {return ::o}
+ :public object method bar00 {} {self}
+ :public object method bar01 {} {:}
+ :public object method bar02 {} {[self]}
+ :public object method bar03 {} {[:]}
+ :public object method bar04 {} {:foo}
+ :public object method bar05 {} {: foo}
+ #:public object method bar06 {} {my foo}
+ :public object method bar07 {} {[self] foo}
+ :public object method bar08 {} {: -system info object methods foo}
+ #:public object method bar09 {} {my -system info object methods foo}
}
? {o foo} ::o
@@ -736,7 +738,7 @@
#
nx::Class create C {
set :unknown 0
- :public class method unknown {m args} {
+ :public object method unknown {m args} {
incr :unknown
return unknown-$m
}
Index: tests/mixinof.test
===================================================================
diff -u -r5016c5d2fee323133f57ad401f1aa4f9d927cd2a -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/mixinof.test (.../mixinof.test) (revision 5016c5d2fee323133f57ad401f1aa4f9d927cd2a)
+++ tests/mixinof.test (.../mixinof.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -2,16 +2,17 @@
# testing mixinof
package require nx
package require nx::test
+
namespace import ::nx::*
Test parameter count 100
###########################################
# testing simple per object mixins
###########################################
Class create A
-Object create o -mixin A
-? {o mixin} ::A
-? {o info mixin classes} ::A
+Object create o -object-mixin A
+? {o object mixin} ::A
+? {o info object mixin classes} ::A
? {A info mixinof} ::o
o destroy
@@ -29,8 +30,8 @@
Class create M
B mixin M
-Object create o -mixin C
-Object create o1 -mixin B
+Object create o -object-mixin C
+Object create o1 -object-mixin B
? {C info mixinof} ::o
? {lsort [B info mixinof -closure]} "::o ::o1"
? {lsort [B info mixinof -closure ::o1]} "::o1"
@@ -50,19 +51,19 @@
# testing per object mixins with redefinition
###########################################
Class create M {:method foo args {puts x;next}}
-Object create o -mixin M
+Object create o -object-mixin M
-? {o info mixin classes} ::M
+? {o info object mixin classes} ::M
? {o info precedence} "::M ::nx::Object"
? {o info lookup method foo} "::nsf::classes::M::foo"
Class create M {:method foo args next}
-? {o info mixin classes} ::M
+? {o info object mixin classes} ::M
? {o info precedence} "::M ::nx::Object"
? {o info lookup method foo} "::nsf::classes::M::foo"
M destroy
-? {o info mixin classes} ""
+? {o info object mixin classes} ""
? {o info precedence} "::nx::Object"
? {o info lookup method foo} ""
@@ -490,13 +491,13 @@
Class create M
Class create A
Class create C
- C create c1 -mixin A
+ C create c1 -object-mixin A
C create c2
Class create C2 -mixin A
C2 create c22
- ? {c1 mixin} ::A
- ? {c1 info mixin classes} ::A
+ ? {c1 object mixin} ::A
+ ? {c1 info object mixin classes} ::A
? {lsort [A info mixinof]} "::C2 ::c1"
? {M info mixinof} ""
C mixin M
Index: tests/object-system.test
===================================================================
diff -u -r7a1cdfcb9fbb66d49d824aa1c12547be59f590c2 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/object-system.test (.../object-system.test) (revision 7a1cdfcb9fbb66d49d824aa1c12547be59f590c2)
+++ tests/object-system.test (.../object-system.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -1,5 +1,6 @@
# -*- Tcl -*-
package require nx
+
::nsf::configure dtrace on
#
@@ -161,14 +162,13 @@
# tests for dispatching methods
#
nx::Object create o
-o public method foo {} {return foo}
-o public method bar1 {} {return bar1-[:foo]}
-o public method bar2 {} {return bar2-[: foo]}
-#o public method bar3 {} {return bar3-[my foo]}
-o public method bar4 {} {return bar4-[[self] foo]}
-o public method bar5 {} {return [self]::bar5}
-o public method bar6 {} {return [:]::bar6}
-o public method bar7 {} {return bar7-[lsort [: -system info methods bar7]]}
+o public object method foo {} {return foo}
+o public object method bar1 {} {return bar1-[:foo]}
+o public object method bar2 {} {return bar2-[: foo]}
+o public object method bar4 {} {return bar4-[[self] foo]}
+o public object method bar5 {} {return [self]::bar5}
+o public object method bar6 {} {return [:]::bar6}
+o public object method bar7 {} {return bar7-[lsort [: -system info object methods bar7]]}
# dispatch without colon names
? {o foo} foo "simple method dispatch"
@@ -221,7 +221,7 @@
# actually, we want c1 to test below the recreation of c1 in another
# object system
? {C create c1} ::c1
-? {C create c2 {:method foo {} {;}}} ::c2
+? {C create c2 {:object method foo {} {;}}} ::c2
#
# check low level method creation on classes, and check C-level
@@ -238,8 +238,8 @@
# tests for the dispatch command
#
nx::Object create o
-o method foo {} {return goo}
-o method bar {x} {return goo-$x}
+o object method foo {} {return goo}
+o object method bar {x} {return goo-$x}
# dispatch without colon names
::nsf::dispatch o eval set :x 1
@@ -259,7 +259,7 @@
o destroy
nx::Object create o {
- :public method foo {} {
+ :public object method foo {} {
foreach var [list x1 y1 x2 y2 x3 y3] {
lappend results $var [info exists :$var]
}
@@ -379,7 +379,7 @@
? {catch {nx::Object create foo}} 1
rename foo ""
nx::Object create foo {
- :method bar {} {;}
+ :object method bar {} {;}
#
# Don't allow subobject to overwrite object specific method
#
@@ -390,13 +390,13 @@
#
# Don't allow child-object to be overwritten by object specific cmd
#
- ? {catch {:forward bar somethingelse}} 1
+ ? {catch {:object forward bar somethingelse}} 1
? {nsf::object::exists [self]::bar} 1
#
# Don't allow child-object to be overwritten by object specific
# scripted method
#
- ? {catch {:method bar {} {;}}} 1
+ ? {catch {:object method bar {} {;}}} 1
? {nsf::object::exists [self]::bar} 1
}
Index: tests/parameters.test
===================================================================
diff -u -rf9a705afeb75b5fb944821b3d3da27d969941293 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/parameters.test (.../parameters.test) (revision f9a705afeb75b5fb944821b3d3da27d969941293)
+++ tests/parameters.test (.../parameters.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -1,6 +1,7 @@
# -*- Tcl -*-
package require nx
package require nx::test
+
#::nx::configure defaultMethodCallProtection false
nx::Test case dummy {
@@ -43,7 +44,7 @@
}
C create c1
nx::Class create M
- c1 mixin M
+ c1 object mixin M
? {::nsf::object::exists o1} 1
? {::nsf::object::exists o1000} 0
@@ -148,17 +149,17 @@
nx::Test parameter count 10
nx::Test case multiple-method-checkers {
nx::Object create o {
- :public method foo {} {
+ :public object method foo {} {
::nsf::is metaclass ::XYZ
::nsf::is metaclass ::nx::Object
}
- :public method bar {} {
+ :public object method bar {} {
::nsf::is metaclass ::XYZ
::nsf::is metaclass ::XYZ
}
- :public method bar2 {} {
+ :public object method bar2 {} {
::nsf::is metaclass ::nx::Object
::nsf::is metaclass ::nx::Object
}
@@ -181,7 +182,7 @@
nx::Test case param-manager {
nx::Object create ::paramManager {
- :method type=sex {name value} {
+ :object method type=sex {name value} {
return "agamous"
}
}
@@ -274,7 +275,7 @@
C create c1
? {C eval :__objectparameter} \
- "{-superclass:class,alias,method=::nsf::methods::class::superclass,1..n ::nx::Object} -object-mixin:mixinreg,alias,method=::nsf::classes::nx::Object::mixin -mixin:mixinreg,alias,0..n -object-filter:filterreg,alias,method=::nsf::classes::nx::Object::filter -filter:filterreg,alias,0..n -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -class:class,alias,method=::nsf::methods::object::class __initcmd:initcmd,optional,noleadingdash"
+ "{-superclass:class,alias,method=::nsf::methods::class::superclass,1..n ::nx::Object} -mixin:mixinreg,alias,1..n -filter:filterreg,alias,1..n -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -object-mixin:mixinreg,alias,method=::nx::Object::slot::__object::mixin,1..n -class:class,alias,method=::nsf::methods::object::class -object-filter:filterreg,alias,method=::nx::Object::slot::__object::filter,1..n __initcmd:initcmd,optional,noleadingdash"
#### TOOD: remove or add
#? {c1 eval :__objectparameter} \
@@ -306,7 +307,7 @@
"::D::slot::d ::C::slot::a ::C::slot::b ::C::slot::c"
? {d1 eval :__objectparameter} \
- "-d:required -a -b:boolean {-c 1} -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash"
+ "-d:required -a -b:boolean {-c 1} -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -object-mixin:mixinreg,alias,method=::nx::Object::slot::__object::mixin,1..n -class:class,alias,method=::nsf::methods::object::class -object-filter:filterreg,alias,method=::nx::Object::slot::__object::filter,1..n __initcmd:initcmd,optional,noleadingdash"
}
#######################################################
@@ -335,29 +336,29 @@
D mixin M
? {d1 eval :__objectparameter} \
- "-b -m1 -m2 -d:required -a {-c 1} -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash" \
+ "-b -m1 -m2 -d:required -a {-c 1} -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -object-mixin:mixinreg,alias,method=::nx::Object::slot::__object::mixin,1..n -class:class,alias,method=::nsf::methods::object::class -object-filter:filterreg,alias,method=::nx::Object::slot::__object::filter,1..n __initcmd:initcmd,optional,noleadingdash" \
"mixin added"
M mixin M2
? {d1 eval :__objectparameter} \
- "-b2 -b -m1 -m2 -d:required -a {-c 1} -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash" \
+ "-b2 -b -m1 -m2 -d:required -a {-c 1} -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -object-mixin:mixinreg,alias,method=::nx::Object::slot::__object::mixin,1..n -class:class,alias,method=::nsf::methods::object::class -object-filter:filterreg,alias,method=::nx::Object::slot::__object::filter,1..n __initcmd:initcmd,optional,noleadingdash" \
"transitive mixin added"
D mixin ""
#we should have again the old interface
? {d1 eval :__objectparameter} \
- "-d:required -a -b:boolean {-c 1} -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash"
+ "-d:required -a -b:boolean {-c 1} -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -object-mixin:mixinreg,alias,method=::nx::Object::slot::__object::mixin,1..n -class:class,alias,method=::nsf::methods::object::class -object-filter:filterreg,alias,method=::nx::Object::slot::__object::filter,1..n __initcmd:initcmd,optional,noleadingdash"
C mixin M
? {d1 eval :__objectparameter} \
- "-b2 -b -m1 -m2 -d:required -a {-c 1} -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash" \
+ "-b2 -b -m1 -m2 -d:required -a {-c 1} -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -object-mixin:mixinreg,alias,method=::nx::Object::slot::__object::mixin,1..n -class:class,alias,method=::nsf::methods::object::class -object-filter:filterreg,alias,method=::nx::Object::slot::__object::filter,1..n __initcmd:initcmd,optional,noleadingdash" \
"mixin added"
C mixin ""
#we should have again the old interface
? {d1 eval :__objectparameter} \
- "-d:required -a -b:boolean {-c 1} -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash"
+ "-d:required -a -b:boolean {-c 1} -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -object-mixin:mixinreg,alias,method=::nx::Object::slot::__object::mixin,1..n -class:class,alias,method=::nsf::methods::object::class -object-filter:filterreg,alias,method=::nx::Object::slot::__object::filter,1..n __initcmd:initcmd,optional,noleadingdash"
}
#######################################################
@@ -379,7 +380,7 @@
? {D create d1} \
{required argument 'd' is missing, should be:
- ::d1 __configure -d value ?-a value? ?-b boolean? ?-c value? ?-volatile? ?-noinit? ?-mixin mixinreg ...? ?-class class? ?-filter filterreg ...? ?__initcmd?}
+ ::d1 __configure -d value ?-a value? ?-b boolean? ?-c value? ?-volatile? ?-noinit? ?-object-mixin mixinreg ...? ?-class class? ?-object-filter filterreg ...? ?__initcmd?}
? {D create d2 -d x -b a} \
{expected boolean but got "a" for parameter "-b"} \
@@ -643,7 +644,7 @@
# Create a user-defined value checker for method parameters,
# without extra argument
- ::nx::methodParameterSlot method type=mytype {name value} {
+ ::nx::methodParameterSlot object method type=mytype {name value} {
if {$value < 1 || $value > 3} {
error "value '$value' of parameter $name is not between 1 and 3"
}
@@ -670,7 +671,7 @@
# Create a user-defined value-checker for method parameters,
# with a extra argument
#
- ::nx::methodParameterSlot method type=in {name value arg} {
+ ::nx::methodParameterSlot object method type=in {name value arg} {
if {$value ni [split $arg |]} {
error "value '$value' of parameter $name not in permissible values $arg"
}
@@ -708,7 +709,7 @@
# Create a user-defined value checker for method parameters,
# without extra argument
#
- ::nx::methodParameterSlot method type=commaRange {name value arg} {
+ ::nx::methodParameterSlot object method type=commaRange {name value arg} {
lassign [split $arg ,] min max
if {$value < $min || $value > $max} {
error "value '$value' of parameter $name not between $min and $max"
@@ -740,7 +741,7 @@
#
# Classical range check
#
- ::nx::methodParameterSlot method type=range {name value arg} {
+ ::nx::methodParameterSlot object method type=range {name value arg} {
lassign [split $arg -] min max
if {$value < $min || $value > $max} {
error "value '$value' of parameter $name not between $min and $max"
@@ -765,7 +766,7 @@
#
# handling of arg with spaces/arg as list
#
- ::nx::methodParameterSlot public method type=list {name value arg} {
+ ::nx::methodParameterSlot public object method type=list {name value arg} {
#puts $value/$arg
return $value
}
@@ -789,30 +790,30 @@
nx::Class create M
nx::Class create M2
D create d1 -d 1
- C create c1 -mixin M
- C create c2 -mixin {{M -guard true}}
- C create c3 -mixin {M ::M2}
- C create c4 -mixin {{M -guard 1} M2}
- C create c5 -mixin {M {M2 -guard 2}}
+ C create c1 -object-mixin M
+ C create c2 -object-mixin {{M -guard true}}
+ C create c3 -object-mixin {M ::M2}
+ C create c4 -object-mixin {{M -guard 1} M2}
+ C create c5 -object-mixin {M {M2 -guard 2}}
nx::Object create o
- ? {c1 info mixin classes} ::M
- ? {c1 info mixin guard ::M} ""
+ ? {c1 info object mixin classes} ::M
+ ? {c1 info object mixin guard ::M} ""
- ? {c2 info mixin classes} ::M
- ? {c2 info mixin guard ::M} "true"
+ ? {c2 info object mixin classes} ::M
+ ? {c2 info object mixin guard ::M} "true"
- ? {c3 info mixin classes} {::M ::M2}
- ? {c3 info mixin guard M} ""
- ? {c3 info mixin guard M2} ""
+ ? {c3 info object mixin classes} {::M ::M2}
+ ? {c3 info object mixin guard M} ""
+ ? {c3 info object mixin guard M2} ""
- ? {c4 info mixin classes} {::M ::M2}
- ? {c4 info mixin guard M} "1"
- ? {c4 info mixin guard M2} ""
+ ? {c4 info object mixin classes} {::M ::M2}
+ ? {c4 info object mixin guard M} "1"
+ ? {c4 info object mixin guard M2} ""
- ? {c5 info mixin classes} {::M ::M2}
- ? {c5 info mixin guard M} ""
- ? {c5 info mixin guard M2} "2"
+ ? {c5 info object mixin classes} {::M ::M2}
+ ? {c5 info object mixin guard M} ""
+ ? {c5 info object mixin guard M2} "2"
D public method foo-base {x:baseclass} {return $x}
D public method foo-class {x:class} {return $x}
@@ -864,23 +865,23 @@
:property {z {1 2 3}}
}
S create s1 {
- :public method foo {{y:substdefault ${:x}}} {
+ :public object method foo {{y:substdefault ${:x}}} {
return $y
}
- :public method bar {{y:integer,substdefault ${:x}}} {
+ :public object method bar {{y:integer,substdefault ${:x}}} {
return $y
}
- :public method baz {{x:integer,substdefault ${:y}}} {
+ :public object method baz {{x:integer,substdefault ${:y}}} {
return $x
}
- :public method boz {{x:integer,0..n,substdefault ${:z}}} {
+ :public object method boz {{x:integer,0..n,substdefault ${:z}}} {
return $x
}
}
? {s1 foo} 1
? {s1 foo 2} 2
- ? {S method foo {a:substdefault} {return 1}} \
+ ? {S object method foo {a:substdefault} {return 1}} \
{parameter option substdefault specified for parameter "a" without default value}
? {s1 bar} 1
@@ -899,16 +900,16 @@
? {s1 boz {100 200}} {100 200}
set ::aaa 100
- ? {s1 public method foo {{a:substdefault $::aaa}} {return $a}} ::s1::foo
+ ? {s1 public object method foo {{a:substdefault $::aaa}} {return $a}} ::s1::foo
? {s1 foo} 100
unset ::aaa
? {s1 foo} {can't read "::aaa": no such variable}
- ? {s1 public method foo {{a:substdefault $aaa}} {return $a}} ::s1::foo
+ ? {s1 public object method foo {{a:substdefault $aaa}} {return $a}} ::s1::foo
? {s1 foo} {can't read "aaa": no such variable}
- ? {s1 public method foo {{a:substdefault [current]}} {return $a}} ::s1::foo
+ ? {s1 public object method foo {{a:substdefault [current]}} {return $a}} ::s1::foo
? {s1 foo} ::s1
}
@@ -975,7 +976,7 @@
MC create MC1
nx::Class create M
D create d1 -d 1
- C create c1 -mixin M
+ C create c1 -object-mixin M
nx::Object create o
nx::Class create ParamTest {
@@ -1083,7 +1084,7 @@
#######################################################
nx::Test case multivalued-app-converter {
- ::nx::methodParameterSlot public method type=sex {name value args} {
+ ::nx::methodParameterSlot public object method type=sex {name value args} {
#puts stderr "[current] slot specific converter"
switch -glob $value {
m* {return m}
@@ -1100,7 +1101,7 @@
? {c1 bar {male female mann frau}} "male female mann frau"
nx::Object create tmpObj
- tmpObj method type=mType {name value arg:optional} {
+ tmpObj object method type=mType {name value arg:optional} {
if {$value} {
error "expected false but got $value"
}
@@ -1121,12 +1122,12 @@
nx::Test case shadowing-app-converter {
nx::Object create mySlot {
- :public method type=integer {name value arg:optional} {
+ :public object method type=integer {name value arg:optional} {
return [expr {$value + 1}]
}
}
nx::Object create o {
- :public method foo {x:integer,slot=::mySlot,convert} {
+ :public object method foo {x:integer,slot=::mySlot,convert} {
return $x
}
}
@@ -1146,7 +1147,7 @@
nx::Object create o3
nx::Object create o {
- :public method foo {x:integer,0..1 y:integer os:object,0..*} {
+ :public object method foo {x:integer,0..1 y:integer os:object,0..*} {
return $x
}
}
@@ -1156,9 +1157,9 @@
? {o foo 1 "" {o1 o2}} {expected integer but got "" for parameter "y"} "second is empty"
? {o foo 1 2 {}} 1 "empty list"
- ? {o info method parameter foo} "x:integer,0..1 y:integer os:object,0..*"
+ ? {o info object method parameter foo} "x:integer,0..1 y:integer os:object,0..*"
- o public method foo {x:integer,0..1 y:integer os:object,1..*} {return $x}
+ o public object method foo {x:integer,0..1 y:integer os:object,1..*} {return $x}
? {o foo 1 2 {o1 "" o2}} {invalid value in "o1 "" o2": expected object but got "" for parameter "os"} \
"list contains empty value"
? {o foo "" 2 {}} {invalid value for parameter 'os': list is not allowed to be empty} \
@@ -1173,7 +1174,7 @@
:property sex {
:type "sex"
:convert true
- :method type=sex {name value} {
+ :object method type=sex {name value} {
#puts stderr "[self] slot specific converter"
switch -glob $value {
m* {return m}
@@ -1201,25 +1202,25 @@
? {::nsf::method::setter ::o :a} {invalid setter name ":a" (must not start with a dash or colon)}
? {::nsf::method::setter o a} "::o::a"
? {::nsf::method::setter C c} "::nsf::classes::C::c"
- ? {o info method definition a} "::o public setter a"
- ? {o info method parameter a} "a"
- ? {o info method args a} "a"
+ ? {o info object method definition a} "::o public object setter a"
+ ? {o info object method parameter a} "a"
+ ? {o info object method args a} "a"
? {C info method definition c} "::C public setter c"
? {o a 1} "1"
? {::nsf::method::setter o a:integer} "::o::a"
? {::nsf::method::setter o ints:integer,1..*} "::o::ints"
? {::nsf::method::setter o o:object} "::o::o"
- ? {o info method registrationhandle ints} "::o::ints"
- ? {o info method definition ints} "::o public setter ints:integer,1..*"
- ? {o info method parameter ints} "ints:integer,1..*"
- ? {o info method args ints} "ints"
+ ? {o info object method registrationhandle ints} "::o::ints"
+ ? {o info object method definition ints} "::o public object setter ints:integer,1..*"
+ ? {o info object method parameter ints} "ints:integer,1..*"
+ ? {o info object method args ints} "ints"
- ? {o info method registrationhandle o} "::o::o"
- ? {o info method definition o} "::o public setter o:object"
- ? {o info method parameter o} "o:object"
- ? {o info method args o} "o"
+ ? {o info object method registrationhandle o} "::o::o"
+ ? {o info object method definition o} "::o public object setter o:object"
+ ? {o info object method parameter o} "o:object"
+ ? {o info object method args o} "o"
? {o a 2} 2
? {o a hugo} {expected integer but got "hugo" for parameter "a"}
@@ -1512,13 +1513,13 @@
nx::Test case checktype {
nx::Object create o {
- :public method f01 {} {::nsf::dispatch o ::nsf::methods::object::info::hastype ::nx::Object}
- :public method f02 {} {::nsf::dispatch o ::nsf::methods::object::info::hastype nx::Object}
- :public method f03 {} {::nsf::dispatch o ::nsf::methods::object::info::hastype nx::Object}
+ :public object method f01 {} {::nsf::dispatch o ::nsf::methods::object::info::hastype ::nx::Object}
+ :public object method f02 {} {::nsf::dispatch o ::nsf::methods::object::info::hastype nx::Object}
+ :public object method f03 {} {::nsf::dispatch o ::nsf::methods::object::info::hastype nx::Object}
- :public method f11 {} {::nsf::is object,type=::nx::Object o}
- :public method f12 {} {::nsf::is object,type=nx::Object o}
- :public method f13 {} {::nsf::is object,type=Object o}
+ :public object method f11 {} {::nsf::is object,type=::nx::Object o}
+ :public object method f12 {} {::nsf::is object,type=nx::Object o}
+ :public object method f13 {} {::nsf::is object,type=Object o}
}
? {o f01} 1
@@ -1543,17 +1544,17 @@
}
nx::Object create o {
- :public method f01 {} {::nsf::dispatch c1 ::nsf::methods::object::info::hastype ::nx::Object}
- :public method f02 {} {::nsf::dispatch c1 ::nsf::methods::object::info::hastype nx::Object}
- :public method f03 {} {::nsf::dispatch c1 ::nsf::methods::object::info::hastype nx::Object}
- :public method f04 {} {::nsf::dispatch c1 ::nsf::methods::object::info::hastype foo::C}
- :public method f05 {} {::nsf::dispatch c1 ::nsf::methods::object::info::hastype C}
+ :public object method f01 {} {::nsf::dispatch c1 ::nsf::methods::object::info::hastype ::nx::Object}
+ :public object method f02 {} {::nsf::dispatch c1 ::nsf::methods::object::info::hastype nx::Object}
+ :public object method f03 {} {::nsf::dispatch c1 ::nsf::methods::object::info::hastype nx::Object}
+ :public object method f04 {} {::nsf::dispatch c1 ::nsf::methods::object::info::hastype foo::C}
+ :public object method f05 {} {::nsf::dispatch c1 ::nsf::methods::object::info::hastype C}
- :public method f11 {} {::nsf::is object,type=::nx::Object c1}
- :public method f12 {} {::nsf::is object,type=nx::Object c1}
- :public method f13 {} {::nsf::is object,type=Object c1}
- :public method f14 {} {::nsf::is object,type=foo::C c1}
- :public method f15 {} {::nsf::is object,type=C c1}
+ :public object method f11 {} {::nsf::is object,type=::nx::Object c1}
+ :public object method f12 {} {::nsf::is object,type=nx::Object c1}
+ :public object method f13 {} {::nsf::is object,type=Object c1}
+ :public object method f14 {} {::nsf::is object,type=foo::C c1}
+ :public object method f15 {} {::nsf::is object,type=C c1}
}
? {o f01} 1
@@ -1843,13 +1844,13 @@
nx::Class create M1 {:property b1:required}
nx::Class create M2 {:property b2:required}
- ? {c1 eval :__objectparameter} "-a1 -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash"
+ ? {c1 eval :__objectparameter} "-a1 -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -object-mixin:mixinreg,alias,method=::nx::Object::slot::__object::mixin,1..n -class:class,alias,method=::nsf::methods::object::class -object-filter:filterreg,alias,method=::nx::Object::slot::__object::filter,1..n __initcmd:initcmd,optional,noleadingdash"
- c1 mixin M1
+ c1 object mixin M1
? {c1 info precedence} "::M1 ::C ::nx::Object"
- ? {c1 eval :__objectparameter} "-b1:required -a1 -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash"
+ ? {c1 eval :__objectparameter} "-b1:required -a1 -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -object-mixin:mixinreg,alias,method=::nx::Object::slot::__object::mixin,1..n -class:class,alias,method=::nsf::methods::object::class -object-filter:filterreg,alias,method=::nx::Object::slot::__object::filter,1..n __initcmd:initcmd,optional,noleadingdash"
#
# Invalidate the object parameter and expect that the per-class
@@ -1886,32 +1887,32 @@
# we have now per-object mixin of M1, we should have "-b1" but no
# "-b2"
#
- ? {c1 info mixin classes} ::M1
- ? {c1 cget -mixin} ::M1
+ ? {c1 info object mixin classes} ::M1
+ ? {c1 cget -object-mixin} ::M1
? {c1 info lookup parameter names b*} "b1"
#
# add one more mixin.
#
- c1 mixin add ::M2
- ? {c1 info mixin classes} {::M2 ::M1}
- ? {c1 cget -mixin} {::M2 ::M1}
+ c1 object mixin add ::M2
+ ? {c1 info object mixin classes} {::M2 ::M1}
+ ? {c1 cget -object-mixin} {::M2 ::M1}
? {c1 info lookup parameter syntax b1} "-b1 value"
? {c1 info lookup parameter syntax b2} "-b2 value"
? {lsort [c1 info lookup parameter names b*]} "b1 b2"
#
# drop the mixins, the b* properties should be gone.
#
- c1 mixin ""
- ? {c1 info mixin classes} {}
+ c1 object mixin ""
+ ? {c1 info object mixin classes} {}
? {lsort [c1 info lookup parameter names b*]} ""
#
# add M1 again
#
- c1 mixin add ::M1
- ? {c1 info mixin classes} {::M1}
+ c1 object mixin add ::M1
+ ? {c1 info object mixin classes} {::M1}
? {c1 info lookup parameter syntax b1} "-b1 value"
? {lsort [c1 info lookup parameter names b*]} "b1"
#
@@ -1944,13 +1945,13 @@
nx::Class create D -superclass C
nx::Class create M {:property b1:required}
- c1 mixin M
+ c1 object mixin M
? {c1 info precedence} "::M ::C ::nx::Object"
- ? {C info slot objects -closure} "::C::slot::a1 ::nx::Object::slot::volatile ::nx::Object::slot::noinit ::nx::Object::slot::mixin ::nx::Object::slot::__initcmd ::nx::Object::slot::class ::nx::Object::slot::filter"
+ ? {C info slot objects -closure} "::C::slot::a1 ::nx::Object::slot::volatile ::nx::Object::slot::noinit ::nx::Object::slot::object-mixin ::nx::Object::slot::__initcmd ::nx::Object::slot::class ::nx::Object::slot::object-filter"
- ? {c1 eval :__objectparameter} "-a2 -b1:required -a1 -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash"
+ ? {c1 eval :__objectparameter} "-a2 -b1:required -a1 -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -object-mixin:mixinreg,alias,method=::nx::Object::slot::__object::mixin,1..n -class:class,alias,method=::nsf::methods::object::class -object-filter:filterreg,alias,method=::nx::Object::slot::__object::filter,1..n __initcmd:initcmd,optional,noleadingdash"
#
# invalidate object parameter and expect that the per-class mixin
@@ -1962,9 +1963,9 @@
? {c1 info precedence} "::M ::C ::nx::Object"
- ? {C info slot objects -closure} "::C::slot::a1 ::nx::Object::slot::volatile ::nx::Object::slot::noinit ::nx::Object::slot::mixin ::nx::Object::slot::__initcmd ::nx::Object::slot::class ::nx::Object::slot::filter"
+ ? {C info slot objects -closure} "::C::slot::a1 ::nx::Object::slot::volatile ::nx::Object::slot::noinit ::nx::Object::slot::object-mixin ::nx::Object::slot::__initcmd ::nx::Object::slot::class ::nx::Object::slot::object-filter"
- ? {c1 eval :__objectparameter} "-a2 -b1:required -a1 -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -mixin:mixinreg,alias,0..n -class:class,alias,method=::nsf::methods::object::class -filter:filterreg,alias,0..n __initcmd:initcmd,optional,noleadingdash"
+ ? {c1 eval :__objectparameter} "-a2 -b1:required -a1 -volatile:alias,slot=::nx::Object::slot::volatile,slotassign,noarg -noinit:alias,method=::nsf::methods::object::noinit,noarg -object-mixin:mixinreg,alias,method=::nx::Object::slot::__object::mixin,1..n -class:class,alias,method=::nsf::methods::object::class -object-filter:filterreg,alias,method=::nx::Object::slot::__object::filter,1..n __initcmd:initcmd,optional,noleadingdash"
# should not require b1
? {C create c2} ::c2
@@ -1980,10 +1981,10 @@
nx::Test case bignums {
::nx::Object create o {
- :public method foo {x:int} { return $x }
- :public method foo32 {x:int32} { return $x }
- :public method bar {x:wideinteger} { return $x }
- :public method baz {x:double} { return $x }
+ :public object method foo {x:int} { return $x }
+ :public object method foo32 {x:int32} { return $x }
+ :public object method bar {x:wideinteger} { return $x }
+ :public object method baz {x:double} { return $x }
}
#
@@ -2218,16 +2219,16 @@
nx::Class create C {
# set 2 class variables, one via variable, one via property
- ? [list [self] class variable -nocomplain v "v0"] ""
- ? [list [self] class property -nocomplain [list a "a0"]] "::C::a"
+ ? [list [self] object variable -nocomplain v "v0"] ""
+ ? [list [self] object property -nocomplain [list a "a0"]] "::C::a"
# in both cases, we expect instance variables
? [list [self] eval {set :v}] "v0"
? [list [self] eval {set :a}] "a0"
# check variable with value constraint
- ? [list [self] class variable -nocomplain x:int "0"] ""
- ? [list [self] class variable -nocomplain y:int "a0"] {expected integer but got "a0"}
+ ? [list [self] object variable -nocomplain x:int "0"] ""
+ ? [list [self] object variable -nocomplain y:int "a0"] {expected integer but got "a0"}
}
}
@@ -2267,8 +2268,8 @@
? {C create c2 -a 10} ::c2
? {C create c2 -v 10} \
- {invalid non-positional argument '-v', valid are : -a, -volatile, -noinit, -mixin, -class, -filter;
- should be "::c2 configure ?-a value? ?-volatile? ?-noinit? ?-mixin mixinreg ...? ?-class class? ?-filter filterreg ...? ?__initcmd?"}
+ {invalid non-positional argument '-v', valid are : -a, -volatile, -noinit, -object-mixin, -class, -object-filter;
+ should be "::c2 configure ?-a value? ?-volatile? ?-noinit? ?-object-mixin mixinreg ...? ?-class class? ?-object-filter filterreg ...? ?__initcmd?"}
#
# We expect a setter for "a" but not for "v".
@@ -2436,8 +2437,8 @@
}
# "v" does NOT show up in "info parameter"
- ? {C info parameter list} "-volatile -noinit -mixin -class -filter __initcmd"
- ? {C info parameter names} "volatile noinit mixin class filter __initcmd"
+ ? {C info parameter list} "-volatile -noinit -object-mixin -class -object-filter __initcmd"
+ ? {C info parameter names} "volatile noinit object-mixin class object-filter __initcmd"
# "v" does show up in "info slot ..."
? {C info slot objects} "::C::slot::v"
@@ -2451,8 +2452,8 @@
}
# "p2" and "p3" do NOT show up in "info parameter"
- ? {D info parameter list} "-p0 -p1 -volatile -noinit -mixin -class -filter __initcmd"
- ? {D info parameter names} "p0 p1 volatile noinit mixin class filter __initcmd"
+ ? {D info parameter list} "-p0 -p1 -volatile -noinit -object-mixin -class -object-filter __initcmd"
+ ? {D info parameter names} "p0 p1 volatile noinit object-mixin class object-filter __initcmd"
# "p1" and "p2" do NOT show up in "info methods"
? {D info methods} "p0 p3"
@@ -2490,7 +2491,7 @@
}
# "p1" and "p2" do NOT show up in "info methods"
- ? {o2 info methods} "p0 p3"
+ ? {o2 info object methods} "p0 p3"
# all properties with slots show up in "info slot"
? {o2 info slot objects} "::o2::per-object-slot::p0 ::o2::per-object-slot::p1 ::o2::per-object-slot::p3"
@@ -2550,7 +2551,7 @@
nx::Test case side-effect-set-value {
nx::Class create C {
- :public class method setObjectParams {spec} {
+ :public object method setObjectParams {spec} {
:protected method __objectparameter {} [list return $spec]
::nsf::parameter:invalidate::classcache [self]
}
@@ -2588,7 +2589,7 @@
set ::slotcalls 0
nx::Class create Foo {
:property bar {
- :public method assign { object property value } {
+ :public object method assign { object property value } {
incr ::slotcalls 1
nsf::var::set $object $property $value
}
@@ -2612,7 +2613,7 @@
set ::slotcalls 0
nx::Class create Foo {
:property {baz 1} {
- :public method assign { object property value } {
+ :public object method assign { object property value } {
incr ::slotcalls 1
nsf::var::set $object $property $value
}
@@ -2644,7 +2645,7 @@
? {nx::Class create Foo {
:property -accessor none bar {
- :public method assign { object property value } {
+ :public object method assign { object property value } {
incr ::slotcalls 1
nsf::var::set $object $property $value
}
@@ -2658,7 +2659,7 @@
# test cases for default
nx::Class create Foo {
:property -accessor none {baz 1} {
- :public method assign { object property value } {
+ :public object method assign { object property value } {
incr ::slotcalls 1
nsf::var::set $object $property $value
}
@@ -2684,7 +2685,7 @@
? {nx::Class create Foo {
:property bar {
- :public method initialize { object property } {
+ :public object method initialize { object property } {
incr ::slotcalls 1
}
}}
@@ -2706,10 +2707,10 @@
nx::Class create Test2 {
:property list {
- :public method assign { obj var val } {
+ :public object method assign { obj var val } {
nsf::var::set $obj $var [list $obj $var $val]
}
- :method unknown { val obj var args } {
+ :object method unknown { val obj var args } {
return unknown
}
}
@@ -2735,7 +2736,7 @@
? {objekt eval {info exists :a}} 0
? {catch {
objekt variable -accessor public -initblock {
- :public method assign args {
+ :public object method assign args {
incr :assignCalled
next
}
Index: tests/plain-object-method.test
===================================================================
diff -u
--- tests/plain-object-method.test (revision 0)
+++ tests/plain-object-method.test (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -0,0 +1,41 @@
+# -*- Tcl -*-
+package require nx::test
+
+nx::Test case plain-methods-0 {
+ nx::Class create M1
+ nx::Object create o {
+ ? {o public method foo {} {return foo}} "::o: unable to dispatch method 'method'"
+ :public object method f args {next}
+ }
+ ? {o mixin M1} "::o: unable to dispatch method 'mixin'"
+ ? {o filter f} "::o: unable to dispatch method 'filter'"
+
+ ? {lsort [o info object methods]} "f"
+ ? {lsort [o info]} "valid submethods of ::o info: children class has info is lookup name object parent precedence slot vars"
+}
+
+package require nx::plain-object-method
+nx::Test case plain-methods-1 {
+ nx::Class create M1
+ nx::Object create o {
+ :public method foo {} {return foo}
+ :public method f args {next}
+ #:mixin M1
+ #
+ # public, protected, private
+ # alias, forward
+ #
+ }
+ ? {o mixin M1} ::M1
+ ? {o info mixin classes} ::M1
+ ? {o mixin ""} ""
+ ? {o info mixin classes} ""
+
+ ? {o filter f} f
+ ? {o info filter methods} f
+ ? {o filter ""} ""
+ ? {o info filter methods} ""
+
+ ? {lsort [o info object methods]} "f foo"
+ ? {lsort [o info]} "valid submethods of ::o info: children class filter has info is lookup method methods mixin name object parent precedence slot vars"
+}
Index: tests/properties.test
===================================================================
diff -u -ra866226c4ca39c65f5f98539c140326c617da884 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/properties.test (.../properties.test) (revision a866226c4ca39c65f5f98539c140326c617da884)
+++ tests/properties.test (.../properties.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -40,7 +40,7 @@
#
# just the public properties are accessible via the configure interface
#
- ? {c1 configure} { ?-e value? ?-a value? ?-b value? ?-volatile? ?-noinit? ?-mixin mixinreg ...? ?-class class? ?-filter filterreg ...? ?__initcmd?}
+ ? {c1 configure} { ?-e value? ?-a value? ?-b value? ?-volatile? ?-noinit? ?-object-mixin mixinreg ...? ?-class class? ?-object-filter filterreg ...? ?__initcmd?}
? {lsort [C info slot definitions]} {{::C property -accessor none {a a1}} {::C property -accessor none {e e1}} {::C property {b b1}} {::C variable -accessor private d d1} {::C variable -accessor private vd vd1} {::C variable -accessor protected c c1} {::C variable -accessor protected vc vc1} {::C variable -accessor public vb vb1} {::C variable va va1} {::C variable ve ve1} {::C variable vf vf1}}
@@ -215,7 +215,7 @@
#
# The use of "-incremental" implies multivalued
#
- ? {c1 configure} { ?-e value ...? ?-a value ...? ?-b value ...? ?-volatile? ?-noinit? ?-mixin mixinreg ...? ?-class class? ?-filter filterreg ...? ?__initcmd?}
+ ? {c1 configure} { ?-e value ...? ?-a value ...? ?-b value ...? ?-volatile? ?-noinit? ?-object-mixin mixinreg ...? ?-class class? ?-object-filter filterreg ...? ?__initcmd?}
? {c1 cget -a} a1
? {c1 cget -b} b1
@@ -377,7 +377,7 @@
:variable -accessor private vd vd1
:variable -accessor none ve ve1
- :public method call-local {v} {: -local $v}
+ :public object method call-local {v} {: -local $v}
}
@@ -390,7 +390,7 @@
# just the public properties are accessible via the configure interface
#
- ? {o1 configure} { ?-e value? ?-a value? ?-b value? ?-volatile? ?-noinit? ?-mixin mixinreg ...? ?-class class? ?-filter filterreg ...? ?__initcmd?}
+ ? {o1 configure} { ?-e value? ?-a value? ?-b value? ?-volatile? ?-noinit? ?-object-mixin mixinreg ...? ?-class class? ?-object-filter filterreg ...? ?__initcmd?}
#
# just the public properties are accessible via the cget interface
@@ -511,14 +511,14 @@
:variable -accessor private -incremental vd vd1
:variable -accessor none -incremental ve ve1
- :public method call-local {v} {: -local $v}
- :public method add-local {var value} {: -local $var add $value}
+ :public object method call-local {v} {: -local $v}
+ :public object method add-local {var value} {: -local $var add $value}
}
#
# The use of "-incremental" implies multivalued
#
- ? {o1 configure} { ?-e value ...? ?-a value ...? ?-b value ...? ?-volatile? ?-noinit? ?-mixin mixinreg ...? ?-class class? ?-filter filterreg ...? ?__initcmd?}
+ ? {o1 configure} { ?-e value ...? ?-a value ...? ?-b value ...? ?-volatile? ?-noinit? ?-object-mixin mixinreg ...? ?-class class? ?-object-filter filterreg ...? ?__initcmd?}
? {o1 cget -a} a1
? {o1 cget -b} b1
@@ -644,7 +644,7 @@
# The accessor should be a forwarder due to incremental
#
- ? {o1 info method definition b} {::o1 public forward b ::o1::per-object-slot::b {%1 {get assign}} %self b}
+ ? {o1 info object method definition b} {::o1 public object forward b ::o1::per-object-slot::b {%1 {get assign}} %self b}
#
# check error message
@@ -655,7 +655,7 @@
# The accessor is deleted due to the error
#
- ? {o1 info method definition b} {}
+ ? {o1 info object method definition b} {}
}
@@ -672,8 +672,8 @@
:property {a a1}
:variable va va1
- :class property {b b1}
- :class variable vb b1
+ :object property {b b1}
+ :object variable vb b1
:create c1
}
@@ -682,12 +682,12 @@
# just the public properties are accessible via the configure interface
#
- ? {c1 configure} {?-a value? ?-volatile? ?-noinit? ?-mixin mixinreg ...? ?-class class? ?-filter filterreg ...? ?__initcmd?}
+ ? {c1 configure} {?-a value? ?-volatile? ?-noinit? ?-object-mixin mixinreg ...? ?-class class? ?-object-filter filterreg ...? ?__initcmd?}
? {c1 cget -a} a1
? {c1 configure -a a2} ""
- ? {C configure} {?-b value? ?-superclass class ...? ?-object-mixin mixinreg? ?-mixin mixinreg ...? ?-object-filter filterreg? ?-filter filterreg ...? ?-volatile? ?-noinit? ?-class class? ?__initcmd?}
+ ? {C configure} {?-b value? ?-superclass class ...? ?-mixin mixinreg ...? ?-filter filterreg ...? ?-volatile? ?-noinit? ?-object-mixin mixinreg ...? ?-class class? ?-object-filter filterreg ...? ?__initcmd?}
? {C cget -b} b1
? {C configure -b b2} ""
@@ -719,8 +719,9 @@
:create c1
}
+
nx::Class create D {
- :class property {cp 101}
+ :object property {cp 101}
:property {a a1}
:property -accessor public {b b1}
:property -accessor protected {c c1}
@@ -740,7 +741,7 @@
# just the public properties are accessible via the configure interface
#
- ? {c1 configure} { ?-e value? ?-a value? ?-b value? ?-volatile? ?-noinit? ?-mixin mixinreg ...? ?-class class? ?-filter filterreg ...? ?__initcmd?}
+ ? {c1 configure} { ?-e value? ?-a value? ?-b value? ?-volatile? ?-noinit? ?-object-mixin mixinreg ...? ?-class class? ?-object-filter filterreg ...? ?__initcmd?}
set e [C eval :__objectparameter]
? {C eval :__objectparameter} $e
@@ -759,7 +760,7 @@
#
# check influence of class-level per-object properties
#
- ? {d1 configure} { ?-e value? ?-a value? ?-b value? ?-volatile? ?-noinit? ?-mixin mixinreg ...? ?-class class? ?-filter filterreg ...? ?__initcmd?}
+ ? {d1 configure} { ?-e value? ?-a value? ?-b value? ?-volatile? ?-noinit? ?-object-mixin mixinreg ...? ?-class class? ?-object-filter filterreg ...? ?__initcmd?}
set e [D eval :__objectparameter]
? {D eval :__objectparameter} $e
@@ -799,7 +800,7 @@
# just the public properties are accessible via the configure interface
#
- ? {o1 configure} { ?-e value? ?-a value? ?-b value? ?-volatile? ?-noinit? ?-mixin mixinreg ...? ?-class class? ?-filter filterreg ...? ?__initcmd?}
+ ? {o1 configure} { ?-e value? ?-a value? ?-b value? ?-volatile? ?-noinit? ?-object-mixin mixinreg ...? ?-class class? ?-object-filter filterreg ...? ?__initcmd?}
set e [o1 eval :__objectparameter]
Index: tests/protected.test
===================================================================
diff -u -re884c2b0d63fa1b5a691e866ccff8d4094a2a8e4 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/protected.test (.../protected.test) (revision e884c2b0d63fa1b5a691e866ccff8d4094a2a8e4)
+++ tests/protected.test (.../protected.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -93,11 +93,11 @@
? {c1 foo} foo
# add a protected filter
- c1 filter add f1
+ c1 object filter add f1
? {c1 foo} foo
# add a private filter
- c1 filter add f2
+ c1 object filter add f2
? {c1 foo} foo
}
@@ -143,9 +143,9 @@
# redefine-protect object specific method
nx::Object create o
- o method foo {} {return 13}
+ o object method foo {} {return 13}
::nsf::method::property o foo redefine-protected true
- ? {o method foo {} {return 14}} \
+ ? {o object method foo {} {return 14}} \
{refuse to overwrite protected method 'foo'; derive e.g. a sub-class!}
}
@@ -160,14 +160,14 @@
:public method bar {} {return "B.bar [next]"}
:public method baz {} {return "B.baz [next]"}
:create b1 {
- :public method baz {} {return "b1.baz [next]"}
+ :public object method baz {} {return "b1.baz [next]"}
}
}
nx::Class create C -superclass B {
:public method bar {} {return "C.bar [next]"}
:public method baz {} {return "C.baz [next]"}
:create c1 {
- :public method baz {} {return "c1.baz [next]"}
+ :public object method baz {} {return "c1.baz [next]"}
}
}
@@ -214,18 +214,18 @@
:public method bar {} {return "B.bar [next]"}
:public method baz {} {return "B.baz [next]"}
:create b1 {
- :public method foo {} {: -local bar}
- :private method bar {} {: -local baz}
- :private method baz {} {return "b1.baz"}
+ :public object method foo {} {: -local bar}
+ :private object method bar {} {: -local baz}
+ :private object method baz {} {return "b1.baz"}
}
}
nx::Class create C -superclass B {
:public method bar {} {return "C.bar [next]"}
:public method baz {} {return "C.baz [next]"}
:create c1 {
- :public method foo {} {: -local bar}
- :private method bar {} {: -local baz}
- :private method baz {} {return "c1.baz"}
+ :public object method foo {} {: -local bar}
+ :private object method bar {} {: -local baz}
+ :private object method baz {} {return "c1.baz"}
}
}
@@ -280,13 +280,13 @@
# add a filter; be sure that we still can call the private -local
# method
- d1 filter add f1
+ d1 object filter add f1
? {d1 baz} "f1 D.baz C.baz "
? {d1 foo} "f1 C.foo f1 bar"
? {d1 bar} "::d1: unable to dispatch method 'bar'"
# remove the filter
- d1 filter ""
+ d1 object filter ""
# define call to private method via method handle
C public method foo {} { return "C.foo [[self] [C info method registrationhandle bar]]"}
@@ -296,7 +296,7 @@
? {d1 bar} "::d1: unable to dispatch method 'bar'"
# add a filter; be sure that we still can call the private method
- d1 filter add f1
+ d1 object filter add f1
? {d1 baz} "f1 D.baz C.baz "
? {d1 foo} "f1 C.foo f1 bar"
? {d1 bar} "::d1: unable to dispatch method 'bar'"
@@ -420,16 +420,16 @@
:public method foo2 {} {return "M2 [next]"}
}
nx::Object create o1 {
- :protected method foo {} {return o1}
- :public method foo2 {} {:foo}
- :public method bar {} {: -local foo}
+ :protected object method foo {} {return o1}
+ :public object method foo2 {} {:foo}
+ :public object method bar {} {: -local foo}
}
? {o1 foo} {::o1: unable to dispatch method 'foo'}
? {o1 bar} o1
? {o1 foo2} o1
- o1 mixin add M
+ o1 object mixin add M
? {o1 foo} "M o1"
? {o1 bar} "o1"
@@ -488,9 +488,9 @@
# create an object, which overloads some system behavior
#
nx::Object create o1 {
- :public method info {} {return "overloads system info"}
- :public method destroy {} {return "overloads system destroy"}
- :public method method args {return "overloads method method"}
+ :public object method info {} {return "overloads system info"}
+ :public object method destroy {} {return "overloads system destroy"}
+ :public object method "object method" args {return "overloads method 'object method'"}
:variable v 1
}
@@ -502,8 +502,8 @@
#? {o1 -system} "no method name specified"
- ? {o1 method foo {} {return foo}} "overloads method method"
- ? {nx::dispatch o1 -system public method foo {} {return foo}} "::o1::foo"
+ ? {o1 object method foo {} {return foo}} "overloads method 'object method'"
+ ? {nx::dispatch o1 -system public object method foo {} {return foo}} "::o1::foo"
? {o1 destroy} "overloads system destroy"
? {nsf::object::exists o1} 1
@@ -559,7 +559,7 @@
:public method foo {a b} {: -local baz $a $b}
}
- b1 mixin add Mix
+ b1 object mixin add Mix
# we can call Mix.baz only through Mix.foo
? {b1 foo 4 5} 1024
@@ -648,44 +648,44 @@
#
nx::Test case private-subobject {
nx::Object create obj {
- :public method foo {} {return foo-[self]}
+ :public object method foo {} {return foo-[self]}
nx::Object create [self]::child {
- :public method bar {} {return bar-[self]}
+ :public object method bar {} {return bar-[self]}
}
}
? {obj child bar} "bar-::obj::child"
? {obj foo} "foo-::obj"
- ? {obj info methods} "child foo"
+ ? {obj info object methods} "child foo"
? {::nsf::method::property obj foo call-private 1} 1
? {obj child bar} "bar-::obj::child"
? {obj foo} {::obj: unable to dispatch method 'foo'}
- ? {obj info methods} "child"
+ ? {obj info object methods} "child"
? {::nsf::method::property obj child call-private 1} 1
? {obj child bar} {::obj: unable to dispatch method 'child'}
? {obj foo} {::obj: unable to dispatch method 'foo'}
- ? {obj info methods} ""
+ ? {obj info object methods} ""
? {::nsf::method::property obj foo call-protected 0} 0
? {obj child bar} {::obj: unable to dispatch method 'child'}
? {obj foo} "foo-::obj"
- ? {obj info methods} "foo"
+ ? {obj info object methods} "foo"
? {::nsf::method::property obj child call-protected 0} 0
? {obj child bar} "bar-::obj::child"
? {obj foo} "foo-::obj"
- ? {obj info methods} "child foo"
+ ? {obj info object methods} "child foo"
}
#
-# Test protected and private class properties
+# Test protected and private object properties
#
nx::Test case protected-priv-class-property {
nx::Class create C {
@@ -758,7 +758,7 @@
:public method bard {p} {return [: -local $p]}
:create d1 {
:property -accessor private {c c1o}
- :public method bard1 {p} {return [: -local $p]}
+ :public object method bard1 {p} {return [: -local $p]}
}
}
@@ -800,9 +800,9 @@
:property -accessor protected {b b1}
:property -accessor private {c c1}
:property -accessor private {d:integer 1}
- :public method foo {p} {return [: $p]}
- :public method bar {p} {return [: -local $p]}
- :public method baz {p v} {return [: -local $p $v]}
+ :public object method foo {p} {return [: $p]}
+ :public object method bar {p} {return [: -local $p]}
+ :public object method baz {p v} {return [: -local $p $v]}
}
? {o a} a1
@@ -832,13 +832,13 @@
#
nx::Test case protected-priv-class-object-property {
nx::Class create C {
- :class property -accessor public {a a1}
- :class property -accessor protected {b b1}
- :class property -accessor private {c c1}
- :class property -accessor private {d:integer 1}
- :public class method foo {p} {return [: $p]}
- :public class method bar {p} {return [: -local $p]}
- :public class method baz {p v} {return [: -local $p $v]}
+ :object property -accessor public {a a1}
+ :object property -accessor protected {b b1}
+ :object property -accessor private {c c1}
+ :object property -accessor private {d:integer 1}
+ :public object method foo {p} {return [: $p]}
+ :public object method bar {p} {return [: -local $p]}
+ :public object method baz {p v} {return [: -local $p $v]}
}
? {C a} a1
@@ -863,7 +863,7 @@
? {C baz d x} {expected integer but got "x" for parameter "value"}
- ? {C public class property {d:integer 1}} {'property' is not a method defining method}
- ? {C protected class property {d:integer 1}} {'property' is not a method defining method}
- ? {C private class property {d:integer 1}} {'property' is not a method defining method}
+ ? {C public object property {d:integer 1}} {'property' is not a method defining method}
+ ? {C protected object property {d:integer 1}} {'property' is not a method defining method}
+ ? {C private object property {d:integer 1}} {'property' is not a method defining method}
}
\ No newline at end of file
Index: tests/returns.test
===================================================================
diff -u -re02cb00ae815bd6f8561a6a03fceacc13fd91903 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/returns.test (.../returns.test) (revision e02cb00ae815bd6f8561a6a03fceacc13fd91903)
+++ tests/returns.test (.../returns.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -1,5 +1,6 @@
# -*- Tcl -*-
package require nx
+
::nx::configure defaultMethodCallProtection false
package require nx::test
@@ -57,14 +58,14 @@
# query returns "", if there is no returns checking
? {::nsf::method::property C lappend returns} ""
- ? {::nsf::method::property ::nx::Object method returns} ""
+ ? {::nsf::method::property ::nx::Class method returns} ""
}
nx::Test parameter count 10
nx::Test case app-specific-returns {
- ::nx::methodParameterSlot method type=range {name value arg} {
+ ::nx::methodParameterSlot object method type=range {name value arg} {
foreach {min max} [split $arg -] break
if {$value < $min || $value > $max} {
error "Value '$value' of parameter $name not between $min and $max"
@@ -100,7 +101,7 @@
nx::Test parameter count 1000
nx::Test case converting-returns {
- ::nx::methodParameterSlot method type=sex {name value args} {
+ ::nx::methodParameterSlot object method type=sex {name value args} {
#puts stderr "[current] slot specific converter"
switch -glob $value {
m* {return m}
@@ -194,13 +195,13 @@
# query returns "", if there is no returns checking
? {::nsf::method::property C lappend returns} ""
- ? {::nsf::method::property ::nx::Object method returns} ""
+ ? {::nsf::method::property ::nx::Class method returns} ""
}
::nx::Test parameter count 10
::nx::Test case app-specific-returns-nocheck {
- ::nx::methodParameterSlot method type=range {name value arg} {
+ ::nx::methodParameterSlot object method type=range {name value arg} {
foreach {min max} [split $arg -] break
if {$value < $min || $value > $max} {
error "Value '$value' of parameter $name not between $min and $max"
@@ -236,7 +237,7 @@
::nx::Test parameter count 1000
::nx::Test case converting-returns-nocheck {
- ::nx::methodParameterSlot method type=sex {name value args} {
+ ::nx::methodParameterSlot object method type=sex {name value args} {
#puts stderr "[current] slot specific converter"
switch -glob $value {
m* {return m}
@@ -305,12 +306,13 @@
:alias lappend -returns integer -frame object ::lappend
:forward ++ -returns integer ::expr 1 +
:forward | -returns integer ::append _
- :public class method instances {} -returns object,1..n {:info instances}
+ :public object method instances {} -returns object,1..n {:info instances}
:create c1
}
package req nx::serializer
set s [C serialize]
+ puts $s
? [list set _ [regsub -all returns $s returns s]] 8 "occurances of returns"
? {c1 bar-ok1 1 2} 1
@@ -348,27 +350,27 @@
# query returns "", if there is no returns checking
? {::nsf::method::property C lappend returns} ""
- ? {::nsf::method::property ::nx::Object method returns} ""
+ ? {::nsf::method::property ::nx::Class method returns} ""
}
::nx::Test case empty-paramdefs-robustedness {
::nx::Object create ku {
# 1: Create an empty or checker-free parameter spec
- :method foo {} {;}
- ? [:info method parameter foo] ""
+ :object method foo {} {;}
+ ? [:info object method parameter foo] ""
# 2: A call to ::nsf::method::property which might require NsfParamDefs
? [list ::nsf::method::property [::nx::current] foo returns] ""
# 3: Check, if "info method parameter" still works
- ? [:info method parameter foo] ""
+ ? [:info object method parameter foo] ""
? [list ::nsf::method::property [::nx::current] foo returns] ""
# 4: Set methodproperty to some value and check again
::nsf::method::property [::nx::current] foo returns int
? [list ::nsf::method::property [::nx::current] foo returns] "int"
- ? [:info method parameter foo] ""
+ ? [:info object method parameter foo] ""
# 5: Reset methodproperty and query again
::nsf::method::property [::nx::current] foo returns ""
? [list ::nsf::method::property [::nx::current] foo returns] ""
- ? [:info method parameter foo] ""
+ ? [:info object method parameter foo] ""
}
}
\ No newline at end of file
Index: tests/serialize.test
===================================================================
diff -u -r5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/serialize.test (.../serialize.test) (revision 5d1617640ad71fd52b069f81cfcadbe4cbb6f2a2)
+++ tests/serialize.test (.../serialize.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -53,8 +53,8 @@
nx::Test case deepSerialize-ignoreVarsRE-filter {
nx::Class create C {
- :class property x
- :class property y
+ :object property x
+ :object property y
:property a:int
:property b:int
:create c1
@@ -66,7 +66,7 @@
? {C y} 1
? {lsort [C info methods]} "a b"
- ? {lsort [C class info methods]} "x y"
+ ? {lsort [C info object methods]} "x y"
? {c1 a b} {expected integer but got "b" for parameter "a"}
? {c1 a 1} 1
? {c1 b 1} 1
@@ -97,7 +97,7 @@
set C(One2) [list [::Serializer deepSerialize -ignoreVarsRE {::x$} C] "y"]
set C(IgnoreAll) [list [::Serializer deepSerialize -ignoreVarsRE "." C] ""]
set C(None2) [list [::Serializer deepSerialize \
- -ignoreVarsRE [join [C class info slot names] |] C] ""]
+ -ignoreVarsRE [join [C info object slot names] |] C] ""]
C destroy
@@ -144,7 +144,7 @@
nx::Test case serialize-slotContainer {
nx::Class create C {
- :class property x
+ :object property x
:property a
}
Index: tests/submethods.test
===================================================================
diff -u -r3b5d2f4e0bc018420ebea39e54ad3212ade2a5bd -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/submethods.test (.../submethods.test) (revision 3b5d2f4e0bc018420ebea39e54ad3212ade2a5bd)
+++ tests/submethods.test (.../submethods.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -2,10 +2,10 @@
package req nx
::nx::configure defaultMethodCallProtection false
package require nx::test
-namespace import ::nx::*
+#namespace import ::nx::*
-Test parameter count 100
-Test case submethods {
+nx::Test parameter count 100
+nx::Test case submethods {
#Object method unknown {} {}
Object create o1
? {o1 foo} "::o1: unable to dispatch method 'foo'"
@@ -16,15 +16,15 @@
# - names equal to helper methods of the ensemble object
#
Object create o {
- :method "string length" x {return [current method]}
- :method "string tolower" x {return [current method]}
- :method "string info" x {return [current method]}
- :method "foo a x" {} {return [current method]}
- :method "foo a y" {} {return [current method]}
- :method "foo a subcmdName" {} {return [current method]}
- :method "foo a defaultmethod" {} {return [current method]}
- :method "foo a unknown" args {return [current method]}
- :method "foo b" {} {return [current method]}
+ :object method "string length" x {return [current method]}
+ :object method "string tolower" x {return [current method]}
+ :object method "string info" x {return [current method]}
+ :object method "foo a x" {} {return [current method]}
+ :object method "foo a y" {} {return [current method]}
+ :object method "foo a subcmdName" {} {return [current method]}
+ :object method "foo a defaultmethod" {} {return [current method]}
+ :object method "foo a unknown" args {return [current method]}
+ :object method "foo b" {} {return [current method]}
}
Class create Foo {
:method "bar m1" {a:integer -flag} {;}
@@ -46,7 +46,7 @@
? {o foo a z} \
{unable to dispatch sub-method "z" of ::o foo a; valid are: foo a defaultmethod, foo a subcmdName, foo a unknown, foo a x, foo a y}
- ? {o info method type string} object
+ ? {o info object method type string} object
# the following is a problem, when string has subcmd "info"
#? {o::string info class} ::nx::EnsembleObject
@@ -63,18 +63,18 @@
#unable to dispatch method <obj> baz a m3; valid subcommands of a: m1 m2}
#
-Test parameter count 1
-Test case defaultmethod {
+nx::Test parameter count 1
+nx::Test case defaultmethod {
Object create o {
- :method "string length" x {return [current method]}
- :method "string tolower" x {return [current method]}
- :method "string info" x {return [current method]}
- :method "foo a x" {} {return [current method]}
- :method "foo a y" {} {return [current method]}
- :method "foo a subcmdName" {} {return [current method]}
- :method "foo a defaultmethod" {} {return [current method]}
- :method "foo a unknown" args {return [current method]}
- :method "foo b" {} {return [current method]}
+ :object method "string length" x {return [current method]}
+ :object method "string tolower" x {return [current method]}
+ :object method "string info" x {return [current method]}
+ :object method "foo a x" {} {return [current method]}
+ :object method "foo a y" {} {return [current method]}
+ :object method "foo a subcmdName" {} {return [current method]}
+ :object method "foo a defaultmethod" {} {return [current method]}
+ :object method "foo a unknown" args {return [current method]}
+ :object method "foo b" {} {return [current method]}
}
Class create Foo {
:method "bar m1" {a:integer -flag} {;}
@@ -96,8 +96,8 @@
#
# testing ensemble objects with next
#
-Test parameter count 1
-Test case ensemble-next {
+nx::Test parameter count 1
+nx::Test case ensemble-next {
nx::Class create FOO {
# reduced ensemble
@@ -179,7 +179,7 @@
? {f1 l1 l2 l3a 100} "{M1.l1 l2 l3a//l3a (100)} {l1 l2//l2 (l3a 100)} {FOO.l1 l2 l3a//l3a (100)}"
}
-Test case ensemble-partial-next {
+nx::Test case ensemble-partial-next {
nx::Class create M {
:public method "info has namespace" {} {
nx::next
@@ -229,7 +229,7 @@
# defaultcmd has to return also subcmds of other shadowed ensembles
? {lsort [o1 info has]} "valid submethods of ::o1 info has: mixin namespace something type"
- ? {lsort [o1 info]} "valid submethods of ::o1 info: children class filter has info is lookup method methods mixin name parent precedence slot vars"
+ ? {lsort [o1 info]} "valid submethods of ::o1 info: children class has info is lookup name object parent precedence slot vars"
# returning methodpath in ensemble
? {o1 info has something path} "info has something path"
@@ -241,7 +241,7 @@
#
# Check behavior of upvars in ensemble methods
#
-Test case ensemble-upvar {
+nx::Test case ensemble-upvar {
nx::Class create FOO {
:method "bar0 x" {varname} {upvar $varname v; return [info exists v]}
@@ -264,13 +264,13 @@
#
# Check behavior of next with arguments within an ensemble
#
-Test case ensemble-next-with-args {
+nx::Test case ensemble-next-with-args {
nx::Object create o {
- :method foo {x} {return $x}
- :method "e1 sm" {x} {return $x}
- :method "e2 sm1 sm2" {x} {return $x}
- :method "e2 e2 e2" {x} {return $x}
- :method "e1 e1 e1" args {return $args}
+ :object method foo {x} {return $x}
+ :object method "e1 sm" {x} {return $x}
+ :object method "e2 sm1 sm2" {x} {return $x}
+ :object method "e2 e2 e2" {x} {return $x}
+ :object method "e1 e1 e1" args {return $args}
}
nx::Class create M {
:method foo {} {next 1}
@@ -279,7 +279,7 @@
:method "e2 e2 e2" {} {next 4}
:method "e1 e1 e1" args {next {e1 e1 e1}}
}
- o mixin add M
+ o object mixin add M
# case without ensemble
? {o foo} 1
@@ -297,12 +297,12 @@
? {o e1 e1 e1} {e1 e1 e1}
}
-Test parameter count 1
-Test case ensemble-next-with-colon-prefix
+nx::Test parameter count 1
+nx::Test case ensemble-next-with-colon-prefix
namespace eval ::ns1 {
- Object create obj {
- :public method foo {} { return [:info class] }
- :public method ifoo {} { [current] ::nsf::methods::object::info::lookupmethod info}
+ nx::Object create obj {
+ :public object method foo {} { return [:info class] }
+ :public object method ifoo {} { [current] ::nsf::methods::object::info::lookupmethod info}
}
? {obj info class} ::nx::Object
@@ -317,17 +317,17 @@
? [list obj $infolookup info] ::nsf::classes::nx::Object::info
? [list obj $infomethod type ::nsf::classes::nx::Object::info] alias
- obj method info {} {;}
+ obj object method info {} {;}
? [list obj $infolookup info] ::ns1::obj::info
? [list obj $infomethod type ::ns1::obj::info] scripted
? {obj ifoo} ::ns1::obj::info
? {obj foo} {wrong # args: should be ":info"}
# Now we try to overwrite the object specific method with an object
# named "info"
- ? {Object create obj::info} "refuse to overwrite cmd ::ns1::obj::info; delete/rename it before overwriting"
+ ? {nx::Object create obj::info} "refuse to overwrite cmd ::ns1::obj::info; delete/rename it before overwriting"
rename obj::info ""
- ? {Object create obj::info} ::ns1::obj::info
+ ? {nx::Object create obj::info} ::ns1::obj::info
? [list obj $infolookup info] ::ns1::obj::info
? [list obj $infomethod type ::ns1::obj::info] object
@@ -348,15 +348,15 @@
# NextSearchAndInvoke())
#
nx::Test case leaf-next-in-submethods {
- Object create container {
+ nx::Object create container {
set :x 0
- :public method "FOO bar" {} {
+ :public object method "FOO bar" {} {
incr :x; next; # a "leaf next"
}
- :public method intercept args {
+ :public object method intercept args {
incr :x; next; # a "filter next"
}
- :filter intercept
+ :object filter intercept
:FOO bar
# Rationale: A call count > 2 would indicate that the leaf next
# triggers a further call into filter ...
@@ -379,8 +379,8 @@
#
# [current] & [current class]
#
- Object create o
- o public method "FOO foo" {} {
+ nx::Object create o
+ o public object method "FOO foo" {} {
return "-[current]-[current class]-"
}
? {o FOO foo} -::o--
@@ -400,18 +400,18 @@
? {c FOO foo} -::c-::M1-::c-::C-
- o mixin ::M1
+ o object mixin ::M1
? {o FOO foo} -::o-::M1-::o--
- o mixin {}
+ o object mixin {}
C mixin {}
#
# limit [current methodpath] to collect only ensemble methods?
#
o eval {
- :public method faz {} {return [concat [current methodpath] [current method]]}
+ :public object method faz {} {return [concat [current methodpath] [current method]]}
? [list set _ [:faz]] "faz"
}
@@ -421,33 +421,33 @@
o eval {
set body {? [list set _ [:bar]] [current class]-[current]-[concat [current methodpath] [current method]]}
- :public method "FOO foo" {} $body
- :public method "BAR BUU boo" {} $body
- :public method baz {} $body
+ :public object method "FOO foo" {} $body
+ :public object method "BAR BUU boo" {} $body
+ :public object method baz {} $body
set calleeBody {return "[current callingclass]-[current callingobject]-[current callingmethod]"}
- :method bar {} $calleeBody
+ :public object method bar {} $calleeBody
:FOO foo
:BAR BUU boo
:baz
- :method "a b" {} $calleeBody
+ :object method "a b" {} $calleeBody
set body {? [list set _ [:a b]] [current class]-[current]-[concat [current methodpath] [current method]]}
- :public method "FOO foo" {} $body
- :public method "BAR BUU boo" {} $body
- :public method baz {} $body
+ :public object method "FOO foo" {} $body
+ :public object method "BAR BUU boo" {} $body
+ :public object method baz {} $body
:FOO foo
:BAR BUU boo
:baz
# TODO: :method "a b c" {} $calleeBody; FAILS -> "can't append to scripted"
- :method "x y z" {} $calleeBody;
+ :object method "x y z" {} $calleeBody;
set body {? [list set _ [:x y z]] [current class]-[current]-[concat [current methodpath] [current method]]}
- :public method "FOO foo" {} $body
- :public method "BAR BUU boo" {} $body
- :public method baz {} $body
+ :public object method "FOO foo" {} $body
+ :public object method "BAR BUU boo" {} $body
+ :public object method baz {} $body
:FOO foo
:BAR BUU boo
@@ -492,7 +492,7 @@
# filter-local argv.
Class create Z {
- :class property -accessor public msg
+ :object property -accessor public msg
:method intercept args {
[current class] eval [list set :msg [list [current methodpath] \
[current calledmethod] \
@@ -546,16 +546,16 @@
:public method foo {} {return foo-[self]}
:public method baz {} {return [c1::1 baz]}
:create c1 {
- :public method bar {} {return bar-[self]}
+ :public object method bar {} {return bar-[self]}
}
}
? {c1 foo} "foo-::c1"
? {c1 bar} "bar-::c1"
C create c1::1 {
- :public method bar {} {return bar-[self]}
- :public method baz {} {return baz-[self]}
+ :public object method bar {} {return bar-[self]}
+ :public object method baz {} {return baz-[self]}
}
#
@@ -622,13 +622,13 @@
nx::Object create obj {
nx::Object create [self]::child {
- :public method foo {} {return [self]}
+ :public object method foo {} {return [self]}
}
- :public forward link1 {%[self]::child}
- :public forward link2 :child
- :public method link3 args {[self]::child {*}$args}
- :public alias link4 [self]::child
- :public forward link5 [self]::child
+ :public object forward link1 {%[self]::child}
+ :public object forward link2 :child
+ :public object method link3 args {[self]::child {*}$args}
+ :public object alias link4 [self]::child
+ :public object forward link5 [self]::child
}
#
@@ -648,12 +648,12 @@
? {obj link5 foo} {::obj::child}
? {obj child foo} {::obj::child}
- #? {lsort [obj info methods child]} {}
- #? {lsort [obj info methods]} {link1 link2 link3 link4 link5}
+ #? {lsort [obj info object methods child]} {}
+ #? {lsort [obj info object methods]} {link1 link2 link3 link4 link5}
#? {lsort [obj info lookup methods child]} {}
#? {lsort [obj info lookup methods child*]} {}
- ? {lsort [obj info methods child]} {child}
- ? {lsort [obj info methods]} {child link1 link2 link3 link4 link5}
+ ? {lsort [obj info object methods child]} {child}
+ ? {lsort [obj info object methods]} {child link1 link2 link3 link4 link5}
? {lsort [obj info lookup methods child]} {child}
? {lsort [obj info lookup methods child*]} {child}
@@ -671,12 +671,12 @@
? {obj link5 foo} {::obj::child}
? {obj child foo} {::obj}
- #? {lsort [obj info methods child]} {}
- #? {lsort [obj info methods]} {link1 link2 link3 link4 link5}
+ #? {lsort [obj info object methods child]} {}
+ #? {lsort [obj info object methods]} {link1 link2 link3 link4 link5}
#? {lsort [obj info lookup methods child]} {}
#? {lsort [obj info lookup methods child*]} {}
- ? {lsort [obj info methods child]} {child}
- ? {lsort [obj info methods]} {child link1 link2 link3 link4 link5}
+ ? {lsort [obj info object methods child]} {child}
+ ? {lsort [obj info object methods]} {child link1 link2 link3 link4 link5}
? {lsort [obj info lookup methods child]} {child}
? {lsort [obj info lookup methods child*]} {child}
@@ -694,8 +694,8 @@
? {obj link5 foo} {::obj::child}
? {obj child foo} {::obj::child}
- ? {lsort [obj info methods child]} {child}
- ? {lsort [obj info methods]} {child link1 link2 link3 link4 link5}
+ ? {lsort [obj info object methods child]} {child}
+ ? {lsort [obj info object methods]} {child link1 link2 link3 link4 link5}
? {lsort [obj info lookup methods child]} {child}
? {lsort [obj info lookup methods child*]} {child}
@@ -715,8 +715,8 @@
#? {obj child foo} {::obj: unable to dispatch method 'foo'}
? {obj child foo} {::obj}
- ? {lsort [obj info methods child]} {child}
- ? {lsort [obj info methods]} {child link1 link2 link3 link4 link5}
+ ? {lsort [obj info object methods child]} {child}
+ ? {lsort [obj info object methods]} {child link1 link2 link3 link4 link5}
? {lsort [obj info lookup methods child]} {child}
? {lsort [obj info lookup methods child*]} {child}
}
@@ -734,13 +734,13 @@
C create c1 {
::nsf::object::property [self] keepcallerself true
- :public method bar {} {return c1-[self]}
- :public method baz {} {return c1-[self]}
+ :public object method bar {} {return c1-[self]}
+ :public object method baz {} {return c1-[self]}
}
D create d1 {
- :public method bar {} {return d1-[self]}
- :public alias c1 ::c1
+ :public object method bar {} {return d1-[self]}
+ :public object alias c1 ::c1
}
# The normal dispatch ignores the keepcallerself completely
@@ -770,12 +770,12 @@
C create c1 {
::nsf::object::property [self] keepcallerself true
::nsf::object::property [self] perobjectdispatch true
- :public method bar {} {return c1-[self]}
- :public method baz {} {return c1-[self]}
+ :public object method bar {} {return c1-[self]}
+ :public object method baz {} {return c1-[self]}
}
D create d1 {
- :public method bar {} {return d1-[self]}
- :public alias c1 ::c1
+ :public object method bar {} {return d1-[self]}
+ :public object alias c1 ::c1
}
# The normal dispatch ignores the keepcallerself and
Index: tests/tcloo.test
===================================================================
diff -u -r5ce68a42506fcc981cea2431afa1b09b476e667a -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/tcloo.test (.../tcloo.test) (revision 5ce68a42506fcc981cea2431afa1b09b476e667a)
+++ tests/tcloo.test (.../tcloo.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -91,7 +91,7 @@
#
set o [nx::Object new]
- $o method Foo {} { return [::nsf::current method]}
+ $o object method Foo {} { return [::nsf::current method]}
? [list $o Foo] "$o: unable to dispatch method 'Foo'"
? [list $o eval {:Foo}] Foo
$o export Foo
@@ -164,7 +164,7 @@
nx::Object create bran {
:export foo
- :public method foo {} {return ok}
+ :public object method foo {} {return ok}
}
? {bran foo} ok
@@ -191,7 +191,7 @@
# oo.test/oo-4.2)
#
set o [nx::Object new]
- $o public method foo {} { return [::nsf::current method]}
+ $o public object method foo {} { return [::nsf::current method]}
? [list $o foo] foo
? [list $o eval {:foo}] foo
$o unexport foo
Index: tests/var-access.test
===================================================================
diff -u -re3487a745ff8d03bff82959c8fb0852e9ae23b36 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/var-access.test (.../var-access.test) (revision e3487a745ff8d03bff82959c8fb0852e9ae23b36)
+++ tests/var-access.test (.../var-access.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -12,9 +12,9 @@
}
::nx::Object create ::nx::var2 {
- :alias exists ::nsf::var::exists
- :alias import ::nsf::var::import
- :alias set ::nsf::var::set
+ :object alias exists ::nsf::var::exists
+ :object alias import ::nsf::var::import
+ :object alias set ::nsf::var::set
}
@@ -68,21 +68,21 @@
}
nx::Object create p {
set :y 1
- :method foo0 {} {
+ :object method foo0 {} {
incr :y
}
- :method foo1 {} {
+ :object method foo1 {} {
o eval {incr :x}
}
- :method foo2 {} {
+ :object method foo2 {} {
::nsf::var::import o x
incr x
}
- :method foo3 {} {
+ :object method foo3 {} {
::nx::var1 import o x
incr x
}
- :method foo4 {} {
+ :object method foo4 {} {
::nx::var2 import o x
incr x
}
@@ -115,4 +115,4 @@
? {::nsf::var::set o x} 40005
}
-puts stderr =====END
+
Index: tests/varresolution.test
===================================================================
diff -u -r537b7cd99b6bc0a28b0f73c2691e08b8bd319147 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/varresolution.test (.../varresolution.test) (revision 537b7cd99b6bc0a28b0f73c2691e08b8bd319147)
+++ tests/varresolution.test (.../varresolution.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -61,25 +61,25 @@
? {::nsf::var::import o2 j} \
"importvar cannot import variable 'j' into method scope; not called from a method frame"
-o method foo {} {::nsf::var::import [current] :a}
+o object method foo {} {::nsf::var::import [current] :a}
? {o foo} "variable name \":a\" must not contain namespace separator or colon prefix"
-o method foo {} {::nsf::var::import [current] ::a}
+o object method foo {} {::nsf::var::import [current] ::a}
? {o foo} "variable name \"::a\" must not contain namespace separator or colon prefix"
-o method foo {} {::nsf::var::import [current] a(:b)}
+o object method foo {} {::nsf::var::import [current] a(:b)}
? {o foo} "can't make instance variable a(:b) on ::o: Variable cannot be an element in an array; use e.g. an alias."
-o method foo {} {::nsf::var::import [current] {a(:b) ab}}
+o object method foo {} {::nsf::var::import [current] {a(:b) ab}}
? {o foo} ""
-o method foo {} {::nsf::var::exists [current] ::a}
+o object method foo {} {::nsf::var::exists [current] ::a}
? {o foo} "variable name \"::a\" must not contain namespace separator or colon prefix"
-o method foo {} {::nsf::var::exists [current] a(:b)}
+o object method foo {} {::nsf::var::exists [current] a(:b)}
? {o foo} 1
-o method foo {} {::nsf::var::exists [current] a(::c)}
+o object method foo {} {::nsf::var::exists [current] a(::c)}
? {o foo} 1
set ::o::Y 5
@@ -141,8 +141,8 @@
set y 1
Object create o {set :x 1}
- o method foo {} {info exists :x}
- o method bar {} {info exists :y}
+ o object method foo {} {info exists :x}
+ o object method bar {} {info exists :y}
? {o eval {info exists :x}} 1
? {o eval {info exists :y}} 0
? {o eval {info exists x}} 0
@@ -260,8 +260,8 @@
###############################################
Test case var-resolver-object
Object create o
-o method foo {x} {set :y 2; return ${:x},${:y}}
-o method bar {} {return ${:x},${:y}}
+o object method foo {x} {set :y 2; return ${:x},${:y}}
+o object method bar {} {return ${:x},${:y}}
o set x 1
? {o foo 1} "1,2" "create var y and fetch var x"
? {o bar} "1,2" "fetch two instance variables"
@@ -270,7 +270,7 @@
# we have to recreate bar, so no problem
Object create o
o set x 1
-o method bar {} {return ${:x},${:y}}
+o object method bar {} {return ${:x},${:y}}
? {catch {o bar}} "1" "compiled var y should not exist"
o destroy
@@ -672,8 +672,8 @@
#
Object create o {
set :x 0
- :public method foo {} {incr :x}
- :public method vwait {varName} {
+ :public object method foo {} {incr :x}
+ :public object method vwait {varName} {
if {[regexp {:[^:]*} $varName]} {
error "invalid varName '$varName'; only plain or fully qualified variable names allowed"
}
@@ -742,7 +742,7 @@
set :Z 1
set ZZZ 1
:method bar {z} { return $z }
- :class method bar {z} { return $z }
+ :object method bar {z} { return $z }
:create v {
set zzz 2
set :z 2
@@ -759,7 +759,7 @@
set :Z 1
set ZZZ 1
:method bar {z} { return $z }
- :class method bar {z} { return $z }
+ :object method bar {z} { return $z }
:create v {
set :z 2
set zzz 2
@@ -788,8 +788,8 @@
#
Test case tcl-variable-cmd {
Object create o {
- :public method ? {varname} {info exists :$varname}
- :public method bar args {
+ :public object method ? {varname} {info exists :$varname}
+ :public object method bar args {
variable :a
set a 3
variable b
@@ -821,7 +821,7 @@
# script execution
Object create ::o {
- :public method bar {} {
+ :public object method bar {} {
# 1. creates a proc-local, compiled var "type"
set type 1
# 2. at compile time: create a proc-local, compiled link-var ":type"
@@ -881,7 +881,7 @@
}
# compiled execution
- o public method baz {} $script
+ o public object method baz {} $script
o eval {set :x 1; unset -nocomplain :v}
? {o baz} :u-:v-:x--0-0-0-0-1-1|:u-:v-:x--0-0-1-1-0-0 ; #:u-:v-:x--1-1-0-0-0-1-0-:u-:v-:x
@@ -913,7 +913,7 @@
namespace eval ::ns1 {
Object create o {
- :public method foo {} {
+ :public object method foo {} {
set _ [join [list {*}[lsort [info vars :*]] [info locals :*] \
[info exists w] [::nsf::var::exists [::nsf::current] w] \
[info exists :x] [::nsf::var::exists [::nsf::current] x]] "-"]
@@ -929,7 +929,7 @@
? {::ns1::o foo} ":x--0-0-0-0|:x--0-0-0-0"
o eval {
- :public method faz {} {
+ :public object method faz {} {
set _ [join [list {*}[lsort [info vars :*]] [info locals :*] \
[namespace which -variable [namespace current]::w] \
[info exists [namespace current]::w] \
@@ -974,7 +974,7 @@
o eval {
set :aaa 1
- :public method caz {} {
+ :public object method caz {} {
set _ "[info exists :aaa]-${:aaa}-[set :aaa]"
variable :aaa
append _ "-[info exists :aaa]"
@@ -1036,7 +1036,7 @@
#
Object create p {
- :public method foo {var} {
+ :public object method foo {var} {
set :x XXX
set _ ${:x}
upvar $var :x
@@ -1049,7 +1049,7 @@
[[current] eval {set :x}]] "-"]
}
- :method bar {var1 var2 var3 var4 var5 var6} {
+ :object method bar {var1 var2 var3 var4 var5 var6} {
upvar $var1 xx $var2 :yy $var3 :zz $var4 q $var5 :el1 $var6 :el2
set _ [join [list {*}[lsort [:info vars]] {*}[lsort [info vars :*]] \
[info exists xx] $xx \
@@ -1065,7 +1065,7 @@
return $_
}
- :public method baz {} {
+ :public object method baz {} {
set :x 10
set y 20
set :z 30
@@ -1097,7 +1097,7 @@
# [namespace current]:::XXX]
o eval {
- :public method bar {} {
+ :public object method bar {} {
set :XXX 1
return [join [list ${:XXX} [set :XXX] [namespace which -variable :XXX] \
[namespace which -variable [namespace current]:::XXX]] -]
@@ -1155,22 +1155,22 @@
nx::Object create o1 {
set :a o1.a
- :public method foo {} {return ${:a}}
- :public method bar {} {o2 foo}
- :public method bar2 {} {o2 foo2}
+ :public object method foo {} {return ${:a}}
+ :public object method bar {} {o2 foo}
+ :public object method bar2 {} {o2 foo2}
}
nx::Object create o2 {
set :a o2.a
set :cmd {set :a}
- :public method foo {} {eval ${:cmd}}
- :public method foo2 {} {uplevel ${:cmd}}
- :public method foo3 {} {uplevel 2 ${:cmd}}
- :public method bar {} {:foo}
- :public method bar2 {} {:foo2}
- :public method bar3a {} {:foo3}
- :public method bar3 {} {:bar3a}
+ :public object method foo {} {eval ${:cmd}}
+ :public object method foo2 {} {uplevel ${:cmd}}
+ :public object method foo3 {} {uplevel 2 ${:cmd}}
+ :public object method bar {} {:foo}
+ :public object method bar2 {} {:foo2}
+ :public object method bar3a {} {:foo3}
+ :public object method bar3 {} {:bar3a}
}
#
@@ -1195,15 +1195,15 @@
nx::Object create o3 {
set :a o3.a
- :public method set {var} {set :$var}
- :public method foo-m {} {:set a}
- :public method foo-r {} {::set :a}
- :public method foo-m-u {} {x {:set a}}
- :public method foo-r-u {} {x {::set :a}}
- :public method foo-a-m {} {::apply [list {} {:set a} [self]]}
- :public method foo-a-r {} {::apply [list {} {::set :a} [self]]}
- :public method foo-a-m-u {} {::apply [list {} {x {:set a}} [self]]}
- :public method foo-a-r-u {} {::apply [list {} {x {::set :a}} [self]]}
+ :public object method set {var} {set :$var}
+ :public object method foo-m {} {:set a}
+ :public object method foo-r {} {::set :a}
+ :public object method foo-m-u {} {x {:set a}}
+ :public object method foo-r-u {} {x {::set :a}}
+ :public object method foo-a-m {} {::apply [list {} {:set a} [self]]}
+ :public object method foo-a-r {} {::apply [list {} {::set :a} [self]]}
+ :public object method foo-a-m-u {} {::apply [list {} {x {:set a}} [self]]}
+ :public object method foo-a-r-u {} {::apply [list {} {x {::set :a}} [self]]}
}
#
Index: tests/volatile.test
===================================================================
diff -u -r9a0b8bb0992be0561d8187c275fc1d9b7e0bbcd0 -rf858f142f5fab4f88996b3eb709c3afa55114be9
--- tests/volatile.test (.../volatile.test) (revision 9a0b8bb0992be0561d8187c275fc1d9b7e0bbcd0)
+++ tests/volatile.test (.../volatile.test) (revision f858f142f5fab4f88996b3eb709c3afa55114be9)
@@ -1,5 +1,6 @@
# -*- Tcl -*-
package req nx::test
+
package prefer latest
package req XOTcl 2.0
@@ -18,11 +19,11 @@
#
proc foon {} {
#puts stderr ====2
- set c [bar C create c1 -volatile {:method destroy {} {#puts "[self] destroy";next}}]
+ set c [bar C create c1 -volatile {:object method destroy {} {#puts "[self] destroy";next}}]
? [list info command $c] "" "foon: $c destroyed too late"
#puts stderr ====3
- set c [bar C new -volatile {:method destroy {} {#puts "[self] destroy";next}}]
+ set c [bar C new -volatile {:object method destroy {} {#puts "[self] destroy";next}}]
? [list info command $c] "" "foon: $c destroyed too late"
}