summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclOOScript.h5
-rw-r--r--tests/oo.test58
-rw-r--r--tools/tclOOScript.tcl5
3 files changed, 44 insertions, 24 deletions
diff --git a/generic/tclOOScript.h b/generic/tclOOScript.h
index ed8d2dd..ae58ccb 100644
--- a/generic/tclOOScript.h
+++ b/generic/tclOOScript.h
@@ -258,6 +258,11 @@ static const char *tclOOSetupScript =
"\t\t\t\t\t\t-errorcode {TCLOO PROPERTY_FORMAT} \\\n"
"\t\t\t\t\t\t\"bad property name \\\"$prop\\\"; must not begin with -\"\n"
"\t\t\t\t}\n"
+"\t\t\t\tif {$prop ne [list $prop]} {\n"
+"\t\t\t\t\treturn -code error -level 2 \\\n"
+"\t\t\t\t\t\t-errorcode {TCLOO PROPERTY_FORMAT} \\\n"
+"\t\t\t\t\t\t\"bad property name \\\"$prop\\\"; must be a simple word\"\n"
+"\t\t\t\t}\n"
"\t\t\t\tset realprop [string cat \"-\" $prop]\n"
"\t\t\t\tset getter [format {::set [my varname %s]} $prop]\n"
"\t\t\t\tset setter [format {::set [my varname %s] $value} $prop]\n"
diff --git a/tests/oo.test b/tests/oo.test
index e869a3c..673b941 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -5792,7 +5792,7 @@ test oo-45.8 {TIP 558: properties: configurable class system} -setup {
parent destroy
} -result {{-x 0 -y 123} 123 1 {property "-y" is read only}}
-test oo-46.1 {ITP 558: properties: declaration semantics} -setup {
+test oo-46.1 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
unset -nocomplain result
set result {}
@@ -5816,7 +5816,7 @@ test oo-46.1 {ITP 558: properties: declaration semantics} -setup {
} -cleanup {
parent destroy
} -result {{set 5} get {>15 15 15<}}
-test oo-46.2 {ITP 558: properties: declaration semantics} -setup {
+test oo-46.2 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
unset -nocomplain result
set result {}
@@ -5840,7 +5840,7 @@ test oo-46.2 {ITP 558: properties: declaration semantics} -setup {
} -cleanup {
parent destroy
} -result {{set 5} get {>15 15 15<} 15}
-test oo-46.2 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.3 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {superclass parent}
@@ -5851,7 +5851,17 @@ test oo-46.2 {TIP 558: properties: declaration semantics} -setup {
} -returnCodes error -cleanup {
parent destroy
} -result {bad property name "-x"; must not begin with -}
-test oo-46.3 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.4 {TIP 558: properties: declaration semantics} -setup {
+ oo::class create parent
+} -body {
+ oo::configurable create Point {superclass parent}
+ oo::define Point {
+ property "x y"
+ }
+} -returnCodes error -cleanup {
+ parent destroy
+} -result {bad property name "x y"; must be a simple word}
+test oo-46.5 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {superclass parent}
@@ -5861,7 +5871,7 @@ test oo-46.3 {TIP 558: properties: declaration semantics} -setup {
} -returnCodes error -cleanup {
parent destroy
} -result {missing body to go with -get option}
-test oo-46.4 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.6 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {superclass parent}
@@ -5871,7 +5881,7 @@ test oo-46.4 {TIP 558: properties: declaration semantics} -setup {
} -returnCodes error -cleanup {
parent destroy
} -result {missing body to go with -set option}
-test oo-46.5 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.7 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {superclass parent}
@@ -5881,7 +5891,7 @@ test oo-46.5 {TIP 558: properties: declaration semantics} -setup {
} -returnCodes error -cleanup {
parent destroy
} -result {missing kind value to go with -kind option}
-test oo-46.6 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.8 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {superclass parent}
@@ -5891,7 +5901,7 @@ test oo-46.6 {TIP 558: properties: declaration semantics} -setup {
} -returnCodes error -cleanup {
parent destroy
} -result {missing body to go with -set option}
-test oo-46.7 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.9 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {
@@ -5902,7 +5912,7 @@ test oo-46.7 {TIP 558: properties: declaration semantics} -setup {
} -cleanup {
parent destroy
} -result ok
-test oo-46.8 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.10 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {
@@ -5912,7 +5922,7 @@ test oo-46.8 {TIP 558: properties: declaration semantics} -setup {
} -returnCodes error -cleanup {
parent destroy
} -result {bad kind "gorp": must be readable, readwrite, or writable}
-test oo-46.9 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.11 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {
@@ -5923,7 +5933,7 @@ test oo-46.9 {TIP 558: properties: declaration semantics} -setup {
} -cleanup {
parent destroy
} -result ok
-test oo-46.10 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.12 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {
@@ -5937,7 +5947,7 @@ test oo-46.10 {TIP 558: properties: declaration semantics} -setup {
} -cleanup {
parent destroy
} -result ok
-test oo-46.11 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.13 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
unset -nocomplain msg
} -body {
@@ -5958,7 +5968,7 @@ test oo-46.11 {TIP 558: properties: declaration semantics} -setup {
} -cleanup {
parent destroy
} -result {0 {} 1 {property "-x" is write only} 1 {bad property "-y": must be -x}}
-test oo-46.12 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.14 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {
@@ -5972,7 +5982,7 @@ test oo-46.12 {TIP 558: properties: declaration semantics} -setup {
} -returnCodes error -cleanup {
parent destroy
} -result {property getter for -x did a break}
-test oo-46.13 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.15 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {
@@ -5986,7 +5996,7 @@ test oo-46.13 {TIP 558: properties: declaration semantics} -setup {
} -returnCodes error -cleanup {
parent destroy
} -result {property getter for -x did a break}
-test oo-46.14 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.16 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {
@@ -6000,7 +6010,7 @@ test oo-46.14 {TIP 558: properties: declaration semantics} -setup {
} -returnCodes error -cleanup {
parent destroy
} -result boo
-test oo-46.15 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.17 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {
@@ -6014,7 +6024,7 @@ test oo-46.15 {TIP 558: properties: declaration semantics} -setup {
} -returnCodes error -cleanup {
parent destroy
} -result boo
-test oo-46.16 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.18 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {
@@ -6028,7 +6038,7 @@ test oo-46.16 {TIP 558: properties: declaration semantics} -setup {
} -returnCodes error -cleanup {
parent destroy
} -result {property getter for -x did a continue}
-test oo-46.17 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.19 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {
@@ -6042,7 +6052,7 @@ test oo-46.17 {TIP 558: properties: declaration semantics} -setup {
} -cleanup {
parent destroy
} -result ok
-test oo-46.18 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.20 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {
@@ -6056,7 +6066,7 @@ test oo-46.18 {TIP 558: properties: declaration semantics} -setup {
} -cleanup {
parent destroy
} -result ok
-test oo-46.19 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.21 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {
@@ -6070,7 +6080,7 @@ test oo-46.19 {TIP 558: properties: declaration semantics} -setup {
} -returnCodes error -cleanup {
parent destroy
} -result {property setter for -x did a break}
-test oo-46.20 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.22 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {
@@ -6084,7 +6094,7 @@ test oo-46.20 {TIP 558: properties: declaration semantics} -setup {
} -returnCodes error -cleanup {
parent destroy
} -result {property setter for -x did a continue}
-test oo-46.21 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.23 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {
@@ -6098,7 +6108,7 @@ test oo-46.21 {TIP 558: properties: declaration semantics} -setup {
} -returnCodes error -cleanup {
parent destroy
} -result boo
-test oo-46.22 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.24 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {
@@ -6112,7 +6122,7 @@ test oo-46.22 {TIP 558: properties: declaration semantics} -setup {
} -cleanup {
parent destroy
} -result ok
-test oo-46.23 {TIP 558: properties: declaration semantics} -setup {
+test oo-46.25 {TIP 558: properties: declaration semantics} -setup {
oo::class create parent
} -body {
oo::configurable create Point {
diff --git a/tools/tclOOScript.tcl b/tools/tclOOScript.tcl
index 12288e4..e10eda2 100644
--- a/tools/tclOOScript.tcl
+++ b/tools/tclOOScript.tcl
@@ -485,6 +485,11 @@
-errorcode {TCLOO PROPERTY_FORMAT} \
"bad property name \"$prop\"; must not begin with -"
}
+ if {$prop ne [list $prop]} {
+ return -code error -level 2 \
+ -errorcode {TCLOO PROPERTY_FORMAT} \
+ "bad property name \"$prop\"; must be a simple word"
+ }
set realprop [string cat "-" $prop]
set getter [format {::set [my varname %s]} $prop]
set setter [format {::set [my varname %s] $value} $prop]
generated by cgit v0.12 at 2025-12-04 09:53:59 (GMT)