Artifact
6a5c35438c29cf2588f0a8c0e71d2562cc80016a40445ac975722fc82a776d9e:
Attachment "obj5-bad.tcl" to
ticket [929a918ec1]
added by
mnsummerfield
2024-07-10 07:18:20.
(unpublished)
0000: 23 21 2f 75 73 72 2f 62 69 6e 2f 65 6e 76 20 74 #!/usr/bin/env t
0010: 63 6c 73 68 39 0a 0a 6f 6f 3a 3a 63 6c 61 73 73 clsh9..oo::class
0020: 20 63 72 65 61 74 65 20 56 20 7b 0a 20 20 20 20 create V {.
0030: 6d 65 74 68 6f 64 20 76 61 6c 69 64 5f 69 6e 74 method valid_int
0040: 20 7b 69 7d 20 7b 0a 20 20 20 20 20 20 20 20 69 {i} {. i
0050: 66 20 7b 21 5b 73 74 72 69 6e 67 20 69 73 20 69 f {![string is i
0060: 6e 74 65 67 65 72 20 2d 73 74 72 69 63 74 20 24 nteger -strict $
0070: 69 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 i]} {.
0080: 20 20 74 68 72 6f 77 20 4e 4f 54 5f 41 4e 5f 49 throw NOT_AN_I
0090: 4e 54 20 22 6d 75 73 74 20 62 65 20 61 6e 20 69 NT "must be an i
00a0: 6e 74 20 6e 6f 74 20 5c 22 24 69 5c 22 22 0a 20 nt not \"$i\"".
00b0: 20 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20 20 }.
00c0: 20 72 65 74 75 72 6e 20 24 69 0a 20 20 20 20 7d return $i. }
00d0: 0a 20 20 20 20 75 6e 65 78 70 6f 72 74 20 76 61 . unexport va
00e0: 6c 69 64 5f 69 6e 74 0a 7d 0a 0a 6f 6f 3a 3a 63 lid_int.}..oo::c
00f0: 6f 6e 66 69 67 75 72 61 62 6c 65 20 63 72 65 61 onfigurable crea
0100: 74 65 20 51 20 7b 0a 20 20 20 20 6d 69 78 69 6e te Q {. mixin
0110: 20 56 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 V. variable
0120: 78 20 79 0a 0a 20 20 20 20 63 6f 6e 73 74 72 75 x y.. constru
0130: 63 74 6f 72 20 61 72 67 73 20 7b 0a 20 20 20 20 ctor args {.
0140: 20 20 20 20 6d 79 20 63 6f 6e 66 69 67 75 72 65 my configure
0150: 20 2d 78 20 30 20 2d 79 20 30 20 7b 2a 7d 24 61 -x 0 -y 0 {*}$a
0160: 72 67 73 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 rgs. }.. p
0170: 72 6f 70 65 72 74 79 20 78 20 2d 73 65 74 20 7b roperty x -set {
0180: 20 73 65 74 20 78 20 5b 6d 79 20 76 61 6c 69 64 set x [my valid
0190: 5f 69 6e 74 20 24 76 61 6c 75 65 5d 20 7d 0a 20 _int $value] }.
01a0: 20 20 20 70 72 6f 70 65 72 74 79 20 79 20 2d 73 property y -s
01b0: 65 74 20 7b 20 73 65 74 20 79 20 5b 6d 79 20 76 et { set y [my v
01c0: 61 6c 69 64 5f 69 6e 74 20 24 76 61 6c 75 65 5d alid_int $value]
01d0: 20 7d 0a 7d 0a 0a 70 75 74 73 20 22 51 22 0a 73 }.}..puts "Q".s
01e0: 65 74 20 71 31 20 5b 51 20 6e 65 77 5d 0a 70 75 et q1 [Q new].pu
01f0: 74 73 20 22 71 31 20 78 3d 5b 24 71 31 20 63 6f ts "q1 x=[$q1 co
0200: 6e 66 69 67 75 72 65 20 2d 78 5d 20 79 3d 5b 24 nfigure -x] y=[$
0210: 71 31 20 63 6f 6e 66 69 67 75 72 65 20 2d 79 5d q1 configure -y]
0220: 22 0a 24 71 31 20 63 6f 6e 66 69 67 75 72 65 20 ".$q1 configure
0230: 2d 78 20 35 0a 70 75 74 73 20 22 71 31 20 5b 24 -x 5.puts "q1 [$
0240: 71 31 20 63 6f 6e 66 69 67 75 72 65 5d 22 0a 74 q1 configure]".t
0250: 72 79 20 7b 24 71 31 20 63 6f 6e 66 69 67 75 72 ry {$q1 configur
0260: 65 20 2d 78 20 22 69 6e 76 61 6c 69 64 22 7d 20 e -x "invalid"}
0270: 74 72 61 70 20 7b 7d 20 65 72 72 20 7b 20 70 75 trap {} err { pu
0280: 74 73 20 24 65 72 72 20 7d 0a 73 65 74 20 71 32 ts $err }.set q2
0290: 20 5b 51 20 6e 65 77 20 2d 78 20 30 20 2d 79 20 [Q new -x 0 -y
02a0: 2d 38 5d 0a 70 75 74 73 20 22 71 32 20 5b 24 71 -8].puts "q2 [$q
02b0: 32 20 63 6f 6e 66 69 67 75 72 65 5d 22 0a 24 71 2 configure]".$q
02c0: 32 20 63 6f 6e 66 69 67 75 72 65 20 2d 78 20 31 2 configure -x 1
02d0: 37 0a 70 75 74 73 20 22 71 32 20 5b 24 71 32 20 7.puts "q2 [$q2
02e0: 63 6f 6e 66 69 67 75 72 65 5d 22 0a 70 75 74 73 configure]".puts
02f0: 20 22 71 31 20 5b 24 71 31 20 63 6f 6e 66 69 67 "q1 [$q1 config
0300: 75 72 65 5d 22 0a 74 72 79 20 7b 24 71 31 20 76 ure]".try {$q1 v
0310: 61 6c 69 64 5f 69 6e 74 20 35 7d 20 74 72 61 70 alid_int 5} trap
0320: 20 7b 7d 20 65 72 72 20 7b 20 70 75 74 73 20 24 {} err { puts $
0330: 65 72 72 20 7d 0a err }.
