From 90c4ac2475eae710ce64257dc694aee0ee3aa7f3 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sat, 3 May 2025 14:21:17 -0700
Subject: buf: buf-put-buf: wrong argument order.

* buf.c (buf_put_buf): Fix incorrect argument order, contrary
to documentation and inconsistent with other buf-put-* functions.
(compat_buf_put_buf): New static function. Detects wrong
argument order and swaps.
(buf_init): Register buf-put-buf intrinsic to new
static function. Thus buf-put-buf conforms to the documentation,
but also works if called with the incorect old argument order.

* test/012/buf.tl: New tests.

* txr.1: Documentation added to clarify behaviors when put
operation is out of the range of the destination buffer.
---
 buf.c            | 12 ++++++++++--
 tests/012/buf.tl | 25 +++++++++++++++++++++++++
 txr.1            | 16 ++++++++++++++++
 3 files changed, 51 insertions(+), 2 deletions(-)

diff --git a/buf.c b/buf.c
index a1b1a8c4..8a51959a 100644
--- a/buf.c
+++ b/buf.c
@@ -439,7 +439,7 @@ static void buf_move_bytes(val buf, val pos, mem_t *ptr, cnum size, val self)
   memmove(b->data + p, ptr, size);
 }
 
-val buf_put_buf(val dbuf, val sbuf, val pos)
+val buf_put_buf(val dbuf, val pos, val sbuf)
 {
   val self = lit("buf-put-buf");
   struct buf *sb = buf_handle(sbuf, self);
@@ -447,6 +447,14 @@ val buf_put_buf(val dbuf, val sbuf, val pos)
   return sbuf;
 }
 
+static val compat_buf_put_buf(val dbuf, val pos, val sbuf)
+{
+  if (is_ptr(pos) && !integerp(pos))
+    return buf_put_buf(dbuf, sbuf, pos);
+  else
+    return buf_put_buf(dbuf, pos, sbuf);
+}
+
 void buf_put_bytes(val buf, val pos, mem_t *ptr, cnum size, val self)
 {
   struct buf *b = buf_handle(buf, self);
@@ -1378,7 +1386,7 @@ void buf_init(void)
   reg_fun(intern(lit("sub-buf"), user_package), func_n3(sub_buf));
   reg_fun(intern(lit("replace-buf"), user_package), func_n4(replace_buf));
   reg_fun(intern(lit("buf-list"), user_package), func_n1(buf_list));
-  reg_fun(intern(lit("buf-put-buf"), user_package), func_n3(buf_put_buf));
+  reg_fun(intern(lit("buf-put-buf"), user_package), func_n3(compat_buf_put_buf));
 
 #if HAVE_I8
   reg_fun(intern(lit("buf-put-i8"), user_package), func_n3(buf_put_i8));
diff --git a/tests/012/buf.tl b/tests/012/buf.tl
index 01a510ab..03f3ad30 100644
--- a/tests/012/buf.tl
+++ b/tests/012/buf.tl
@@ -26,3 +26,28 @@
   (mtest
     (buf-decompress (make-buf 1024)) :error
     (buf-decompress (make-buf 1024 255)) :error))
+
+(let ((buf (make-buf 16)))
+  (mtest
+    (prog1 buf (buf-put-buf buf 0 #b'ffff'))
+    #b'ffff0000000000000000000000000000'
+    (prog1 buf (buf-put-buf buf #b'00' 0))
+    #b'00ff0000000000000000000000000000'
+    (prog1 buf (buf-put-buf buf 14 #b'ffff'))
+    #b'00ff000000000000000000000000ffff'
+    (prog1 buf (buf-put-buf buf 0 (make-buf 18 #\xee)))
+    #b'eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee'
+    (prog1 buf (buf-put-buf buf 16 (make-buf 8 #\xdd)))
+    #b'eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeedddddddddddddddd'
+    (prog1 buf (buf-set-length buf 8)) 
+    #b'eeeeeeeeeeeeeeee'
+    (prog1 buf (buf-put-buf buf 12 (make-buf 4 #\xaa)))
+    #b'eeeeeeeeeeeeeeee00000000aaaaaaaa'
+    (prog1 buf (buf-set-length buf 0)) 
+    #b''
+    (prog1 buf (buf-put-buf buf 0 (make-buf 0)))
+    #b''
+    (prog1 buf (buf-put-buf buf 4 (make-buf 0 #\xcc)))
+    #b'00000000'
+    (prog1 buf (buf-put-buf buf 12 (make-buf 4 #\xcc)))
+    #b'000000000000000000000000cccccccc'))
diff --git a/txr.1 b/txr.1
index b1c84350..8ec0805b 100644
--- a/txr.1
+++ b/txr.1
@@ -29090,6 +29090,22 @@ The source and destination memory regions may overlap.
 The return value is
 .metn src-buf .
 
+If the current length of
+.meta buf
+is less than
+.metn pos ,
+it is extended to
+.meta pos
+by the addition of null bytes. Furthermore,
+if any bytes copied from
+.meta src-buf
+lie outside of the range of
+.metn buf ,
+it is extended to include those byte positions;
+the operation never truncates
+.meta src-buf
+data.
+
 Note: the effect of a
 .code buf-put-buf
 operation may also be performed by a suitable call to
-- 
cgit v1.2.3