From 92e4f94605891677aa7a8930d05c63eb220add80 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 29 May 2023 12:11:30 +0000
Subject: Basic implementation of TIP 670

---
 library/foreachline.tcl | 22 ++++++++++++++++++++++
 library/readfile.tcl    | 23 +++++++++++++++++++++++
 library/tclIndex        |  3 +++
 library/writefile.tcl   | 36 ++++++++++++++++++++++++++++++++++++
 4 files changed, 84 insertions(+)
 create mode 100644 library/foreachline.tcl
 create mode 100644 library/readfile.tcl
 create mode 100644 library/writefile.tcl

diff --git a/library/foreachline.tcl b/library/foreachline.tcl
new file mode 100644
index 0000000..d619104
--- /dev/null
+++ b/library/foreachline.tcl
@@ -0,0 +1,22 @@
+# foreachLine:
+# Iterate over the contents of a file, a line at a time.
+# The body script is run for each, with variable varName set to the line
+# contents.
+#
+# Copyright © 2023 Donal K Fellows.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc foreachLine {filename varName body} {
+    upvar 1 $varName line
+    set f [open $filename "r"]
+    try {
+	while {[gets $f line] >= 0} {
+	    uplevel 1 $body
+	}
+    } finally {
+	close $f
+    }
+}
diff --git a/library/readfile.tcl b/library/readfile.tcl
new file mode 100644
index 0000000..350bcd4
--- /dev/null
+++ b/library/readfile.tcl
@@ -0,0 +1,23 @@
+# readFile:
+# Read the contents of a file.
+#
+# Copyright © 2023 Donal K Fellows.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc readFile {filename {mode text}} {
+    # Parse the arguments
+    set MODES {binary text}
+    set ERR [list -level 1 -errorcode [list TCL LOOKUP MODE $mode]]
+    set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode]
+
+    # Read the file
+    set f [open $filename [expr {$mode eq "text" ? "r" : "rb"}]]
+    try {
+	return [read $f]
+    } finally {
+	close $f
+    }
+}
diff --git a/library/tclIndex b/library/tclIndex
index a8db3cb..8fd5a89 100644
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -19,6 +19,7 @@ set auto_index(::auto_mkindex_parser::childhook) [list ::tcl::Pkg::source [file
 set auto_index(::auto_mkindex_parser::command) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
 set auto_index(::auto_mkindex_parser::commandInit) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
 set auto_index(::auto_mkindex_parser::fullname) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
+set auto_index(foreachLine) [list ::tcl::Pkg::source [file join $dir foreachline.tcl]]
 set auto_index(history) [list ::tcl::Pkg::source [file join $dir history.tcl]]
 set auto_index(::tcl::HistAdd) [list ::tcl::Pkg::source [file join $dir history.tcl]]
 set auto_index(::tcl::HistKeep) [list ::tcl::Pkg::source [file join $dir history.tcl]]
@@ -34,6 +35,7 @@ set auto_index(tclPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.t
 set auto_index(::tcl::MacOSXPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.tcl]]
 set auto_index(::pkg::create) [list ::tcl::Pkg::source [file join $dir package.tcl]]
 set auto_index(parray) [list ::tcl::Pkg::source [file join $dir parray.tcl]]
+set auto_index(readFile) [list ::tcl::Pkg::source [file join $dir readfile.tcl]]
 set auto_index(::safe::InterpStatics) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
 set auto_index(::safe::InterpNested) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
 set auto_index(::safe::interpCreate) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
@@ -67,6 +69,7 @@ set auto_index(tcl_wordBreakBefore) [list ::tcl::Pkg::source [file join $dir wor
 set auto_index(tcl_endOfWord) [list ::tcl::Pkg::source [file join $dir word.tcl]]
 set auto_index(tcl_startOfNextWord) [list ::tcl::Pkg::source [file join $dir word.tcl]]
 set auto_index(tcl_startOfPreviousWord) [list ::tcl::Pkg::source [file join $dir word.tcl]]
+set auto_index(writeFile) [list ::tcl::Pkg::source [file join $dir writefile.tcl]]
 set auto_index(::tcl::tm::add) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
 set auto_index(::tcl::tm::remove) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
 set auto_index(::tcl::tm::list) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
diff --git a/library/writefile.tcl b/library/writefile.tcl
new file mode 100644
index 0000000..ca3bbcc
--- /dev/null
+++ b/library/writefile.tcl
@@ -0,0 +1,36 @@
+# writeFile:
+# Write the contents of a file.
+#
+# Copyright © 2023 Donal K Fellows.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc writeFile {args} {
+    # Parse the arguments
+    switch [llength $args] {
+	2 {
+	    lassign $args filename data
+	    set mode text
+	}
+	3 {
+	    lassign $args filename mode data
+	    set MODES {binary text}
+	    set ERR [list -level 1 -errorcode [list TCL LOOKUP MODE $mode]]
+	    set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode]
+	}
+	default {
+	    return -code error -errorcode {TCL WRONGARGS} \
+		"wrong # args: should be \"[lindex [info level 0] 0] filename ?mode? data\""
+	}
+    }
+
+    # Write the file
+    set f [open $filename [expr {$mode eq "text" ? "w" : "wb"}]]
+    try {
+	puts -nonewline $f $data
+    } finally {
+	close $f
+    }
+}
-- 
cgit v0.12


From 07f73b212befdc5ca59e4c7c7582f86fbc2b50aa Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 30 May 2023 08:39:23 +0000
Subject: Added docs

---
 doc/library.n | 37 +++++++++++++++++++++++++++++++++++++
 1 file changed, 37 insertions(+)

diff --git a/doc/library.n b/doc/library.n
index 8aa8af7..ce1174c 100644
--- a/doc/library.n
+++ b/doc/library.n
@@ -25,6 +25,11 @@ auto_execok, auto_import, auto_load, auto_mkindex, auto_qualify, auto_reset, tcl
 \fBtcl_startOfPreviousWord \fIstr start\fR
 \fBtcl_wordBreakAfter \fIstr start\fR
 \fBtcl_wordBreakBefore \fIstr start\fR
+.VS "Tcl 8.7, TIP 670"
+\fBforeachLine \fIfilename varName body\fR
+\fBreadFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR?
+\fBwriteFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR? \fIcontents\fR
+.VE "Tcl 8.7, TIP 670"
 .BE
 .SH INTRODUCTION
 .PP
@@ -240,6 +245,38 @@ Returns the index of the first word boundary before the starting index
 boundaries before the starting point in the given string.  The index
 returned refers to the second character of the pair that comprises a
 boundary.
+.TP
+\fBforeachLine \fIfilename varName body\fR
+.VS "Tcl 8.7, TIP 670"
+This reads in the text file named \fIfilename\fR one line at a time
+(using system defaults for reading text files). It writes that line to the
+variable named by \fIvarName\fR and then executes \fIbody\fR for that line.
+The result value of \fIbody\fR is ignored, but \fBerror\fR, \fBreturn\fR,
+\fBbreak\fR and \fBcontinue\fR may be used within it.
+The overall result of \fBforeachLine\fR is the empty string; the file will be
+closed prior to the procedure returning.
+.VE "Tcl 8.7, TIP 670"
+.TP
+\fBreadFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR?
+.VS "Tcl 8.7, TIP 670"
+Reads in the file named in \fIfilename\fR and returns its contents.
+The second argument says how to read in the file, either as \fBtext\fR
+(using the system defaults for reading text files) or as \fBbinary\fR
+(as uninterpreted bytes). The default is \fBtext\fR. When read as text, this
+will include any trailing newline.
+The file will be closed prior to the procedure returning.
+.VE "Tcl 8.7, TIP 670"
+.TP
+\fBwriteFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR? \fIcontents\fR
+.VS "Tcl 8.7, TIP 670"
+Writes the \fIcontents\fR to the file named in \fIfilename\fR.
+The optional second argument says how to write to the file, either as
+\fBtext\fR (using the system defaults for writing text files) or as
+\fBbinary\fR (as uninterpreted bytes). The default is \fBtext\fR.
+If a trailing newline is required, it will need to be provided in
+\fIcontents\fR. The result of this command is the empty string; the file will
+be closed prior to the procedure returning.
+.VE "Tcl 8.7, TIP 670"
 .SH "VARIABLES"
 .PP
 The following global variables are defined or used by the procedures in
-- 
cgit v0.12


From b98da201c52dbb581e9c9604e2f9d81ed0ec73af Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 30 May 2023 11:59:21 +0000
Subject: start of test cases

---
 tests/ioCmd.test | 197 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 196 insertions(+), 1 deletion(-)

diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 678700f..1eedcb1 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -1,6 +1,7 @@
 # -*- tcl -*-
 # Commands covered: open, close, gets, read, puts, seek, tell, eof, flush,
-#		    fblocked, fconfigure, open, channel, fcopy
+#		    fblocked, fconfigure, open, channel, fcopy,
+#		    readFile, writeFile, foreachLine
 #
 # This file contains a collection of tests for one or more of the Tcl
 # built-in commands.  Sourcing this file into Tcl runs the tests and
@@ -3927,6 +3928,200 @@ test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -mat
 } -constraints {testchannel thread notValgrind} \
     -result {Owner lost}
 
+# Tests of readFile
+
+set BIN_DATA "\u0000\u0001\u0002\u0003\u0004\u001a\u001b\u000d\u000a\u0000"
+
+test iocmd.readFile-1.1 "readFile procedure: syntax" -body {
+    readFile
+} -returnCodes error -result {wrong # args: should be "readFile filename ?mode?"}
+test iocmd.readFile-1.2 "readFile procedure: syntax" -body {
+    readFile a b c
+} -returnCodes error -result {wrong # args: should be "readFile filename ?mode?"}
+test iocmd.readFile-1.3 "readFile procedure: syntax" -body {
+    readFile gorp gorp2
+} -returnCodes error -result {bad mode "gorp2": must be binary or text}
+
+test iocmd.readFile-2.1 "readFile procedure: behaviour" -setup {
+    set f [makeFile readFile21.txt "File\nContents"]
+} -body {
+    readFile $f
+} -cleanup {
+    removeFile $f
+} -result "File\nContents\n"
+test iocmd.readFile-2.2 "readFile procedure: behaviour" -setup {
+    set f [makeFile readFile22.txt "File\nContents"]
+} -body {
+    readFile $f text
+} -cleanup {
+    removeFile $f
+} -result "File\nContents\n"
+test iocmd.readFile-2.3 "readFile procedure: behaviour" -setup {
+    set f [makeFile readFile23.bin ""]
+    apply {filename {
+	set ff [open $filename wb]
+	puts -nonewline $ff $BIN_DATA
+	close $ff
+    }} $f
+} -body {
+    list [binary scan [readFile $f binary] c* x] $x
+} -cleanup {
+    removeFile $f
+} -result {1 {0 1 2 3 4 26 27 13 10 0}}
+# Need to set up ahead of the test
+set f [makeFile readFile24.txt ""]
+removeFile $f
+test iocmd.readFile-2.4 "readFile procedure: behaviour" -body {
+    readFile $f
+} -returnCodes error -result "couldn't open \"$f\": no such file or directory"
+
+# Tests of writeFile
+
+test iocmd.writeFile-1.1 "writeFile procedure: syntax" -body {
+    writeFile
+} -returnCodes error -result {wrong # args: should be "writeFile filename ?mode? data"}
+test iocmd.writeFile-1.2 "writeFile procedure: syntax" -body {
+    writeFile a b c d
+} -returnCodes error -result {wrong # args: should be "writeFile filename ?mode? data"}
+test iocmd.writeFile-1.3 "writeFile procedure: syntax" -body {
+    writeFile gorp gorp2 gorp3
+} -returnCodes error -result {bad mode "gorp2": must be binary or text}
+
+test iocmd.writeFile-2.1 "readFile procedure: behaviour" -setup {
+    set f [makeFile writeFile21.txt ""]
+    removeFile $f
+} -body {
+    list [writeFile $f "File\nContents\n"] [apply {filename {
+	set f [open $filename]
+	set text [read $f]
+	close $f
+	return $text
+    }} $f]
+} -cleanup {
+    removeFile $f
+} -result [list {} "File\nContents\n"]
+test iocmd.writeFile-2.2 "readFile procedure: behaviour" -setup {
+    set f [makeFile writeFile22.txt ""]
+    removeFile $f
+} -body {
+    writeFile $f text "File\nContents\n"
+    apply {filename {
+	set f [open $filename]
+	set text [read $f]
+	close $f
+	return $text
+    }} $f
+} -cleanup {
+    removeFile $f
+} -result "File\nContents\n"
+test iocmd.writeFile-2.3 "readFile procedure: behaviour" -setup {
+    set f [makeFile writeFile23.txt ""]
+    removeFile $f
+} -body {
+    writeFile $f binary $BIN_DATA
+    apply {filename {
+	set f [open $filename rb]
+	set bytes [read $f]
+	close $f
+	binary scan $bytes c* x
+	return $x
+    }} $f
+} -cleanup {
+    removeFile $f
+} -result {0 1 2 3 4 26 27 13 10 0}
+
+# Tests of foreachLine
+
+test iocmd.foreachLine-1.1 "foreachLine procedure: syntax" -returnCodes error -body {
+    foreachLine
+} -result {wrong # args: should be "foreachLine filename varName body"}
+test iocmd.foreachLine-1.2 "foreachLine procedure: syntax" -returnCodes error -body {
+    foreachLine a b c d
+} -result {wrong # args: should be "foreachLine filename varName body"}
+test iocmd.foreachLine-1.3 "foreachLine procedure: syntax" -setup {
+    set f [makeFile foreachLine13.txt ""]
+} -body {
+    apply {filename {
+	array set b {1 1}
+        foreachLine $filename b {}
+    }} $f
+} -cleanup {
+    removeFile $f
+} -returnCodes error -result {can't set "line": variable is array}
+
+test iocmd.foreachLine-2.1 "foreachLine procedure: behaviour" -setup {
+    set f [makeFile foreachLine21.txt "a\nb\nc"]
+} -body {
+    apply {filename {
+	set lines {}
+	foreachLine $filename v {
+	    lappend lines $v
+	}
+    }} $f
+} -cleanup {
+    removeFile $f
+} -result {a b c}
+test iocmd.foreachLine-2.2 "foreachLine procedure: behaviour" -setup {
+    set f [makeFile foreachLine22.txt "a\nbb\nc\ndd"]
+} -body {
+    apply {filename {
+	set lines {}
+	foreachLine $filename v {
+	    if {[string length $v] == 1} continue
+	    lappend lines $v
+	}
+	return $lines
+    }} $f
+} -cleanup {
+    removeFile $f
+} -result {bb dd}
+test iocmd.foreachLine-2.3 "foreachLine procedure: behaviour" -setup {
+    set f [makeFile foreachLine23.txt "a\nbb\nccc\ndd\ne"]
+} -body {
+    apply {filename {
+	set lines {}
+	foreachLine $filename v {
+	    if {[string length $v] > 2} break
+	    lappend lines $v
+	}
+	return $lines
+    }} $f
+} -cleanup {
+    removeFile $f
+} -result {a bb}
+test iocmd.foreachLine-2.4 "foreachLine procedure: behaviour" -setup {
+    set f [makeFile foreachLine24.txt "a\nbb\nccc\ndd\ne"]
+} -body {
+    apply {filename {
+    	set lines {}
+	foreachLine $filename v {
+	    if {[string length $v] > 2} {
+		return $v
+	    }
+	    lappend lines $v
+	}
+	return $lines
+    }} $f
+} -cleanup {
+    removeFile $f
+} -result {ccc}
+test iocmd.foreachLine-2.5 "foreachLine procedure: behaviour" -setup {
+    set f [makeFile foreachLine25.txt "a\nbb\nccc\ndd\ne"]
+} -body {
+    apply {filename {
+	    set lines {}
+	foreachLine $filename v {
+	    if {[string length $v] > 2} {
+		error "line too long"
+	    }
+	    lappend lines $v
+	}
+	return $lines
+    }} $f
+} -cleanup {
+    removeFile $f
+} -returnCodes error -result {line too long}
+
 # ### ### ### ######### ######### #########
 
 # ### ### ### ######### ######### #########
-- 
cgit v0.12


From cc0a37c8b15ef75df258cd833823dae892c69507 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 30 May 2023 12:41:58 +0000
Subject: fix whitespace

---
 tests/ioCmd.test | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 1eedcb1..c7f58e6 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -4109,7 +4109,7 @@ test iocmd.foreachLine-2.5 "foreachLine procedure: behaviour" -setup {
     set f [makeFile foreachLine25.txt "a\nbb\nccc\ndd\ne"]
 } -body {
     apply {filename {
-	    set lines {}
+	set lines {}
 	foreachLine $filename v {
 	    if {[string length $v] > 2} {
 		error "line too long"
-- 
cgit v0.12


From d3acda84955821249bc38d697afe3cc890ac1bf2 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 30 May 2023 13:48:53 +0000
Subject: Get return stack correct when doing [return -code error] in the body

---
 library/foreachline.tcl | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/library/foreachline.tcl b/library/foreachline.tcl
index d619104..06ad62a 100644
--- a/library/foreachline.tcl
+++ b/library/foreachline.tcl
@@ -16,6 +16,9 @@ proc foreachLine {filename varName body} {
 	while {[gets $f line] >= 0} {
 	    uplevel 1 $body
 	}
+    } on return {msg opt} {
+	dict incr opt -level
+	return -options $opt $msg
     } finally {
 	close $f
     }
-- 
cgit v0.12


From 38c9c34398bc61793d4794a1c4dadb3a36f23847 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 31 May 2023 10:33:01 +0000
Subject: Swapped foreachLine arg order, improved docs

---
 doc/library.n           | 9 ++++++---
 library/foreachline.tcl | 2 +-
 library/readfile.tcl    | 2 +-
 library/writefile.tcl   | 5 +++--
 4 files changed, 11 insertions(+), 7 deletions(-)

diff --git a/doc/library.n b/doc/library.n
index ce1174c..984dc8a 100644
--- a/doc/library.n
+++ b/doc/library.n
@@ -246,14 +246,17 @@ boundaries before the starting point in the given string.  The index
 returned refers to the second character of the pair that comprises a
 boundary.
 .TP
-\fBforeachLine \fIfilename varName body\fR
+\fBforeachLine \fIvarName filename body\fR
 .VS "Tcl 8.7, TIP 670"
 This reads in the text file named \fIfilename\fR one line at a time
 (using system defaults for reading text files). It writes that line to the
 variable named by \fIvarName\fR and then executes \fIbody\fR for that line.
 The result value of \fIbody\fR is ignored, but \fBerror\fR, \fBreturn\fR,
-\fBbreak\fR and \fBcontinue\fR may be used within it.
-The overall result of \fBforeachLine\fR is the empty string; the file will be
+\fBbreak\fR and \fBcontinue\fR may be used within it to produce an error,
+return from the calling context, stop the loop, or go to the next line
+respectively.
+The overall result of \fBforeachLine\fR is the empty string (assuming no
+errors from I/O or from evaluating the body of the loop); the file will be
 closed prior to the procedure returning.
 .VE "Tcl 8.7, TIP 670"
 .TP
diff --git a/library/foreachline.tcl b/library/foreachline.tcl
index 06ad62a..aacbd5b 100644
--- a/library/foreachline.tcl
+++ b/library/foreachline.tcl
@@ -9,7 +9,7 @@
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
 
-proc foreachLine {filename varName body} {
+proc foreachLine {varName filename body} {
     upvar 1 $varName line
     set f [open $filename "r"]
     try {
diff --git a/library/readfile.tcl b/library/readfile.tcl
index 350bcd4..c1d5b84 100644
--- a/library/readfile.tcl
+++ b/library/readfile.tcl
@@ -14,7 +14,7 @@ proc readFile {filename {mode text}} {
     set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode]
 
     # Read the file
-    set f [open $filename [expr {$mode eq "text" ? "r" : "rb"}]]
+    set f [open $filename [dict get {text r binary rb} $mode]]
     try {
 	return [read $f]
     } finally {
diff --git a/library/writefile.tcl b/library/writefile.tcl
index ca3bbcc..fbd9138 100644
--- a/library/writefile.tcl
+++ b/library/writefile.tcl
@@ -21,13 +21,14 @@ proc writeFile {args} {
 	    set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode]
 	}
 	default {
+	    set COMMAND [lindex [info level 0] 0]
 	    return -code error -errorcode {TCL WRONGARGS} \
-		"wrong # args: should be \"[lindex [info level 0] 0] filename ?mode? data\""
+		"wrong # args: should be \"$COMMAND filename ?mode? data\""
 	}
     }
 
     # Write the file
-    set f [open $filename [expr {$mode eq "text" ? "w" : "wb"}]]
+    set f [open $filename [dict get {text w binary wb} $mode]]
     try {
 	puts -nonewline $f $data
     } finally {
-- 
cgit v0.12


From 18961ef11c430806656055c71158e9ac2e39e13e Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 31 May 2023 10:39:28 +0000
Subject: swap foreachLine argument order in tests

---
 tests/ioCmd.test | 45 ++++++++++++++++++++++++++-------------------
 1 file changed, 26 insertions(+), 19 deletions(-)

diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index c7f58e6..7138ecd 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -4034,28 +4034,35 @@ test iocmd.writeFile-2.3 "readFile procedure: behaviour" -setup {
 
 test iocmd.foreachLine-1.1 "foreachLine procedure: syntax" -returnCodes error -body {
     foreachLine
-} -result {wrong # args: should be "foreachLine filename varName body"}
+} -result {wrong # args: should be "foreachLine varName filename body"}
 test iocmd.foreachLine-1.2 "foreachLine procedure: syntax" -returnCodes error -body {
     foreachLine a b c d
-} -result {wrong # args: should be "foreachLine filename varName body"}
-test iocmd.foreachLine-1.3 "foreachLine procedure: syntax" -setup {
+} -result {wrong # args: should be "foreachLine varName filename body"}
+test iocmd.foreachLine-1.3 "foreachLine procedure: basic errors" -setup {
     set f [makeFile foreachLine13.txt ""]
 } -body {
     apply {filename {
 	array set b {1 1}
-        foreachLine $filename b {}
+        foreachLine b $filename {}
     }} $f
 } -cleanup {
     removeFile $f
 } -returnCodes error -result {can't set "line": variable is array}
+set f [makeFile foreachLine14.txt ""]
+removeFile $f
+test iocmd.foreachLine-1.4 "foreachLine procedure: basic errors" -body {
+    apply {filename {
+	foreachLine var $filename {}
+    }} $f
+} -returnCodes error -result "couldn't open \"$f\": no such file or directory"
 
 test iocmd.foreachLine-2.1 "foreachLine procedure: behaviour" -setup {
     set f [makeFile foreachLine21.txt "a\nb\nc"]
 } -body {
     apply {filename {
 	set lines {}
-	foreachLine $filename v {
-	    lappend lines $v
+	foreachLine var $filename {
+	    lappend lines $var
 	}
     }} $f
 } -cleanup {
@@ -4066,9 +4073,9 @@ test iocmd.foreachLine-2.2 "foreachLine procedure: behaviour" -setup {
 } -body {
     apply {filename {
 	set lines {}
-	foreachLine $filename v {
-	    if {[string length $v] == 1} continue
-	    lappend lines $v
+	foreachLine var $filename {
+	    if {[string length $var] == 1} continue
+	    lappend lines $var
 	}
 	return $lines
     }} $f
@@ -4080,9 +4087,9 @@ test iocmd.foreachLine-2.3 "foreachLine procedure: behaviour" -setup {
 } -body {
     apply {filename {
 	set lines {}
-	foreachLine $filename v {
-	    if {[string length $v] > 2} break
-	    lappend lines $v
+	foreachLine var $filename {
+	    if {[string length $var] > 2} break
+	    lappend lines $var
 	}
 	return $lines
     }} $f
@@ -4094,11 +4101,11 @@ test iocmd.foreachLine-2.4 "foreachLine procedure: behaviour" -setup {
 } -body {
     apply {filename {
     	set lines {}
-	foreachLine $filename v {
-	    if {[string length $v] > 2} {
-		return $v
+	foreachLine var $filename {
+	    if {[string length $var] > 2} {
+		return $var
 	    }
-	    lappend lines $v
+	    lappend lines $var
 	}
 	return $lines
     }} $f
@@ -4110,11 +4117,11 @@ test iocmd.foreachLine-2.5 "foreachLine procedure: behaviour" -setup {
 } -body {
     apply {filename {
 	set lines {}
-	foreachLine $filename v {
-	    if {[string length $v] > 2} {
+	foreachLine var $filename {
+	    if {[string length $var] > 2} {
 		error "line too long"
 	    }
-	    lappend lines $v
+	    lappend lines $var
 	}
 	return $lines
     }} $f
-- 
cgit v0.12


From 323c70e2f7d531aa7305d0ffaa3b9ed3087ea178 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 13 Nov 2023 14:16:41 +0000
Subject: Remnants from TIP 567's implementation. The feature was done ages
 ago.

---
 generic/tclOODefineCmds.c | 42 +++++++++++++++++++++++++----
 tests/oo.test             | 69 ++++++++++++++++++++++++++++++-----------------
 tests/ooUtil.test         | 23 ++++++++++++++++
 3 files changed, 105 insertions(+), 29 deletions(-)

diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 034c877..a88a27e 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -2455,9 +2455,13 @@ ClassMixinSet(
     Tcl_Obj *const *objv)
 {
     Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    int mixinc, i;
+    int mixinc, i, isNew;
     Tcl_Obj **mixinv;
-    Class **mixins;
+    Class **mixins;;		/* The references to the classes to actually
+				 * install. */
+    Tcl_HashTable uniqueCheck;	/* Note that this hash table is just used as a
+				 * set of class references; it has no payload
+				 * values and keys are always pointers. */
 
     if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
 	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
@@ -2479,6 +2483,7 @@ ClassMixinSet(
     }
 
     mixins = (Class **)TclStackAlloc(interp, sizeof(Class *) * mixinc);
+    Tcl_InitHashTable(&uniqueCheck, TCL_ONE_WORD_KEYS);
 
     for (i = 0; i < mixinc; i++) {
 	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
@@ -2487,6 +2492,13 @@ ClassMixinSet(
 	    i--;
 	    goto freeAndError;
 	}
+	(void) Tcl_CreateHashEntry(&uniqueCheck, (void *) mixins[i], &isNew);
+	if (!isNew) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "class should only be a direct mixin once", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL);
+	    goto freeAndError;
+	}
 	if (TclOOIsReachable(oPtr->classPtr, mixins[i])) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "may not mix a class into itself", -1));
@@ -2496,10 +2508,12 @@ ClassMixinSet(
     }
 
     TclOOClassSetMixins(interp, oPtr->classPtr, mixinc, mixins);
+    Tcl_DeleteHashTable(&uniqueCheck);
     TclStackFree(interp, mixins);
     return TCL_OK;
 
   freeAndError:
+    Tcl_DeleteHashTable(&uniqueCheck);
     TclStackFree(interp, mixins);
     return TCL_ERROR;
 }
@@ -2906,10 +2920,15 @@ ObjMixinSet(
     Tcl_Obj *const *objv)
 {
     Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    int mixinc;
+    int mixinc, i, isNew;
     Tcl_Obj **mixinv;
     Class **mixins;
     int i;
+    Class **mixins;		/* The references to the classes to actually
+				 * install. */
+    Tcl_HashTable uniqueCheck;	/* Note that this hash table is just used as a
+				 * set of class references; it has no payload
+				 * values and keys are always pointers. */
 
     if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
 	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
@@ -2925,19 +2944,32 @@ ObjMixinSet(
     }
 
     mixins = (Class **)TclStackAlloc(interp, sizeof(Class *) * mixinc);
+    Tcl_InitHashTable(&uniqueCheck, TCL_ONE_WORD_KEYS);
 
     for (i = 0; i < mixinc; i++) {
 	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
 		"may only mix in classes");
 	if (mixins[i] == NULL) {
-	    TclStackFree(interp, mixins);
-	    return TCL_ERROR;
+	    goto freeAndError;
+	}
+	(void) Tcl_CreateHashEntry(&uniqueCheck, (void *) mixins[i], &isNew);
+	if (!isNew) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "class should only be a direct mixin once", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL);
+	    goto freeAndError;
 	}
     }
 
     TclOOObjectSetMixins(oPtr, mixinc, mixins);
     TclStackFree(interp, mixins);
+    Tcl_DeleteHashTable(&uniqueCheck);
     return TCL_OK;
+
+  freeAndError:
+    TclStackFree(interp, mixins);
+    Tcl_DeleteHashTable(&uniqueCheck);
+    return TCL_ERROR;
 }
 
 /*
diff --git a/tests/oo.test b/tests/oo.test
index 291060d..cf8b710 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -1685,9 +1685,7 @@ test oo-11.5 {OO: cleanup} {
     return done
 } done
 
-test oo-11.6.1 {
-    OO: cleanup of when an class is mixed into itself
-} -constraints memory -body {
+test oo-11.6.1 {OO: cleanup of when an class is mixed into itself} -constraints memory -body {
     leaktest {
 	interp create interp1
 	oo::class create obj1
@@ -1695,13 +1693,8 @@ test oo-11.6.1 {
 	rename obj1 {}
 	interp delete interp1
     }
-} -result 0 -cleanup {
-}
-
-test oo-11.6.2 {
-    OO: cleanup ReleaseClassContents() where class is mixed into one of its
-    instances
-} -constraints memory -body {
+} -result 0
+test oo-11.6.2 {OO: cleanup ReleaseClassContents() where class is mixed into one of its instances} -constraints memory -body {
     leaktest {
 	interp create interp1
 	interp1 eval {
@@ -1712,13 +1705,8 @@ test oo-11.6.2 {
 	}
 	interp delete interp1
     }
-} -result 0 -cleanup {
-}
-
-test oo-11.6.3 {
-    OO: cleanup ReleaseClassContents() where class is mixed into one of its
-    instances
-} -constraints memory -body {
+} -result 0
+test oo-11.6.3 {OO: cleanup ReleaseClassContents() where class is mixed into one of its instances} -constraints memory -body {
     leaktest {
 	interp create interp1
 	interp1 eval {
@@ -1731,13 +1719,8 @@ test oo-11.6.3 {
 	}
 	interp delete interp1
     }
-} -result 0 -cleanup {
-}
-
-test oo-11.6.4 {
-    OO: cleanup ReleaseClassContents() where class is mixed into one of its
-    instances
-} -body {
+} -result 0
+test oo-11.6.4 {OO: cleanup ReleaseClassContents() where class is mixed into one of its instances} -body {
     oo::class create obj1
     ::oo::define obj1 {self mixin [self]}
 
@@ -2218,6 +2201,31 @@ test oo-14.8 {OO: class mixin order - Bug 1998221} -setup {
     }
     [cls new] test
 } -result {mix cls}
+test oo-14.9 {OO: class mixins must be unique in list} -setup {
+    oo::class create parent
+} -body {
+    oo::class create A {superclass parent}
+    oo::class create B {
+	superclass parent
+	mixin A
+    }
+    oo::define B mixin -append A
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {class should only be a direct mixin once}
+test oo-14.10 {OO: instance mixins must be unique in list} -setup {
+    oo::class create parent
+} -body {
+    oo::class create A {superclass parent}
+    oo::class create B {
+	superclass parent
+	constructor {} {oo::objdefine [self] mixin A}
+    }
+    B create obj
+    oo::objdefine obj {mixin -append A}
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {class should only be a direct mixin once}
 
 test oo-15.1 {OO: object cloning} {
     oo::class create Aclass
@@ -4198,6 +4206,19 @@ test oo-33.4 {TIP 380: slots - errors} -setup [SampleSlotSetup {
     rename $s {}
 }] -result \
     {unknown method "-grill": must be -append, -appendifnew, -clear, -prepend, -remove, -set, contents or ops}
+test oo-33.5 {TIP 567: slots -appendifnew} -setup [SampleSlotSetup {
+    set s [SampleSlot new]
+}] -body {
+    list \
+	[$s -clear
+	 $s contents] \
+	[$s -append p q r
+	 $s contents] \
+	[$s -appendifnew q s r t p
+	 $s contents]
+} -cleanup [SampleSlotCleanup {
+    rename $s {}
+}] -result {{} {p q r} {p q r s t}}
 
 test oo-34.1 {TIP 380: slots - presence} -setup {
     set obj [oo::object new]
diff --git a/tests/ooUtil.test b/tests/ooUtil.test
index f41c668..9e1de8f 100644
--- a/tests/ooUtil.test
+++ b/tests/ooUtil.test
@@ -527,6 +527,29 @@ test ooUtil-7.2 {TIP 478: link removed when [my] disappears} -setup {
     parent destroy
 } -result {{in foo of ::o} {in foo of ::o} {} 1 {invalid command name "pqr"}}
 
+# Tests a very weird combination of things (with a key problem locus in
+# MixinClassDelegates) that TIP 567 fixes
+test ooUtil-8.1 {TIP 567: call oo::define twice from metaclass constructor} -setup {
+    oo::class create parent
+} -body {
+    ::oo::class create A {
+	superclass parent
+    }
+    ::oo::class create B {
+	superclass ::oo::class parent
+    	constructor {{definitionScript ""}} {
+	    next $definitionScript
+	    next {superclass ::A}
+	}
+    }
+    B create C {
+	superclass A
+    }
+    C create instance
+} -cleanup {
+    parent destroy
+} -result ::instance
+
 # Tests that verify issues detected with the tcllib version of the code
 test ooUtil-tcllib-ticket-b3577ed586 {test scoping of delegation in oo::class.Delegate } -setup {
     oo::class create animal {}
-- 
cgit v0.12


From da8146f9dd5831b776f3369cd9e4d15ca8698f45 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 13 Nov 2023 14:49:45 +0000
Subject: Blooperfix

---
 generic/tclOODefineCmds.c | 2 --
 1 file changed, 2 deletions(-)

diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index a88a27e..5f10475 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -2922,8 +2922,6 @@ ObjMixinSet(
     Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
     int mixinc, i, isNew;
     Tcl_Obj **mixinv;
-    Class **mixins;
-    int i;
     Class **mixins;		/* The references to the classes to actually
 				 * install. */
     Tcl_HashTable uniqueCheck;	/* Note that this hash table is just used as a
-- 
cgit v0.12


From ceffda607532e8635894db86b93d1e02e4754505 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 15 Nov 2023 16:07:34 +0000
Subject: Fix broken tests

---
 tests/ioCmd.test | 30 ++++++++++++++++--------------
 1 file changed, 16 insertions(+), 14 deletions(-)

diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 7138ecd..619db31 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -3943,22 +3943,23 @@ test iocmd.readFile-1.3 "readFile procedure: syntax" -body {
 } -returnCodes error -result {bad mode "gorp2": must be binary or text}
 
 test iocmd.readFile-2.1 "readFile procedure: behaviour" -setup {
-    set f [makeFile readFile21.txt "File\nContents"]
+    set f [makeFile "File\nContents" readFile21.txt]
 } -body {
     readFile $f
 } -cleanup {
     removeFile $f
 } -result "File\nContents\n"
 test iocmd.readFile-2.2 "readFile procedure: behaviour" -setup {
-    set f [makeFile readFile22.txt "File\nContents"]
+    set f [makeFile "File\nContents" readFile22.txt]
 } -body {
     readFile $f text
 } -cleanup {
     removeFile $f
 } -result "File\nContents\n"
 test iocmd.readFile-2.3 "readFile procedure: behaviour" -setup {
-    set f [makeFile readFile23.bin ""]
+    set f [makeFile "" readFile23.bindata]
     apply {filename {
+	global BIN_DATA
 	set ff [open $filename wb]
 	puts -nonewline $ff $BIN_DATA
 	close $ff
@@ -3969,7 +3970,7 @@ test iocmd.readFile-2.3 "readFile procedure: behaviour" -setup {
     removeFile $f
 } -result {1 {0 1 2 3 4 26 27 13 10 0}}
 # Need to set up ahead of the test
-set f [makeFile readFile24.txt ""]
+set f [makeFile "" readFile24.txt]
 removeFile $f
 test iocmd.readFile-2.4 "readFile procedure: behaviour" -body {
     readFile $f
@@ -3988,7 +3989,7 @@ test iocmd.writeFile-1.3 "writeFile procedure: syntax" -body {
 } -returnCodes error -result {bad mode "gorp2": must be binary or text}
 
 test iocmd.writeFile-2.1 "readFile procedure: behaviour" -setup {
-    set f [makeFile writeFile21.txt ""]
+    set f [makeFile "" writeFile21.txt]
     removeFile $f
 } -body {
     list [writeFile $f "File\nContents\n"] [apply {filename {
@@ -4001,7 +4002,7 @@ test iocmd.writeFile-2.1 "readFile procedure: behaviour" -setup {
     removeFile $f
 } -result [list {} "File\nContents\n"]
 test iocmd.writeFile-2.2 "readFile procedure: behaviour" -setup {
-    set f [makeFile writeFile22.txt ""]
+    set f [makeFile "" writeFile22.txt]
     removeFile $f
 } -body {
     writeFile $f text "File\nContents\n"
@@ -4015,7 +4016,7 @@ test iocmd.writeFile-2.2 "readFile procedure: behaviour" -setup {
     removeFile $f
 } -result "File\nContents\n"
 test iocmd.writeFile-2.3 "readFile procedure: behaviour" -setup {
-    set f [makeFile writeFile23.txt ""]
+    set f [makeFile "" writeFile23.txt]
     removeFile $f
 } -body {
     writeFile $f binary $BIN_DATA
@@ -4039,7 +4040,7 @@ test iocmd.foreachLine-1.2 "foreachLine procedure: syntax" -returnCodes error -b
     foreachLine a b c d
 } -result {wrong # args: should be "foreachLine varName filename body"}
 test iocmd.foreachLine-1.3 "foreachLine procedure: basic errors" -setup {
-    set f [makeFile foreachLine13.txt ""]
+    set f [makeFile "" foreachLine13.txt]
 } -body {
     apply {filename {
 	array set b {1 1}
@@ -4048,7 +4049,7 @@ test iocmd.foreachLine-1.3 "foreachLine procedure: basic errors" -setup {
 } -cleanup {
     removeFile $f
 } -returnCodes error -result {can't set "line": variable is array}
-set f [makeFile foreachLine14.txt ""]
+set f [makeFile "" foreachLine14.txt]
 removeFile $f
 test iocmd.foreachLine-1.4 "foreachLine procedure: basic errors" -body {
     apply {filename {
@@ -4057,19 +4058,20 @@ test iocmd.foreachLine-1.4 "foreachLine procedure: basic errors" -body {
 } -returnCodes error -result "couldn't open \"$f\": no such file or directory"
 
 test iocmd.foreachLine-2.1 "foreachLine procedure: behaviour" -setup {
-    set f [makeFile foreachLine21.txt "a\nb\nc"]
+    set f [makeFile "a\nb\nc" foreachLine21.txt]
 } -body {
     apply {filename {
 	set lines {}
 	foreachLine var $filename {
 	    lappend lines $var
 	}
+	return $lines
     }} $f
 } -cleanup {
     removeFile $f
 } -result {a b c}
 test iocmd.foreachLine-2.2 "foreachLine procedure: behaviour" -setup {
-    set f [makeFile foreachLine22.txt "a\nbb\nc\ndd"]
+    set f [makeFile "a\nbb\nc\ndd" foreachLine22.txt]
 } -body {
     apply {filename {
 	set lines {}
@@ -4083,7 +4085,7 @@ test iocmd.foreachLine-2.2 "foreachLine procedure: behaviour" -setup {
     removeFile $f
 } -result {bb dd}
 test iocmd.foreachLine-2.3 "foreachLine procedure: behaviour" -setup {
-    set f [makeFile foreachLine23.txt "a\nbb\nccc\ndd\ne"]
+    set f [makeFile "a\nbb\nccc\ndd\ne" foreachLine23.txt]
 } -body {
     apply {filename {
 	set lines {}
@@ -4097,7 +4099,7 @@ test iocmd.foreachLine-2.3 "foreachLine procedure: behaviour" -setup {
     removeFile $f
 } -result {a bb}
 test iocmd.foreachLine-2.4 "foreachLine procedure: behaviour" -setup {
-    set f [makeFile foreachLine24.txt "a\nbb\nccc\ndd\ne"]
+    set f [makeFile "a\nbb\nccc\ndd\ne" foreachLine24.txt]
 } -body {
     apply {filename {
     	set lines {}
@@ -4113,7 +4115,7 @@ test iocmd.foreachLine-2.4 "foreachLine procedure: behaviour" -setup {
     removeFile $f
 } -result {ccc}
 test iocmd.foreachLine-2.5 "foreachLine procedure: behaviour" -setup {
-    set f [makeFile foreachLine25.txt "a\nbb\nccc\ndd\ne"]
+    set f [makeFile "a\nbb\nccc\ndd\ne" foreachLine25.txt]
 } -body {
     apply {filename {
 	set lines {}
-- 
cgit v0.12