From 4fd7bddd0e7fda8c5e476cba5e7882dae86fd59d Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sun, 2 Jul 2017 18:46:50 -0700
Subject: ffi: relaxation in cptr put semantics.

For convenience, we allow a cptr to be converted to foreign
representation even if its tag doesn't match the FFI type
being used for the conversion. This is allowed only in the
case that the cptr is a null pointer, and its tag is nil.

* lib.c (cptr_handle): Defeat the type check if the pointer
is null, and its tag is nil. Thus, the FFI variable cptr-null
will conveniently convert to any cptr type in the ffi_cptr_put
operation and others.
---
 lib.c | 15 ++++++++++-----
 txr.1 |  8 ++++++++
 2 files changed, 18 insertions(+), 5 deletions(-)

diff --git a/lib.c b/lib.c
index fc70090a..f0f5e035 100644
--- a/lib.c
+++ b/lib.c
@@ -7571,12 +7571,17 @@ val int_cptr(val cptr)
 
 mem_t *cptr_handle(val cptr, val type_sym, val self)
 {
-  if (type(cptr) != CPTR)
+  if (type(cptr) != CPTR) {
     uw_throwf(error_s, lit("~a: ~s isn't a cptr"), self, cptr, nao);
-  if (type_sym && cptr->co.cls != type_sym)
-    uw_throwf(error_s, lit("~a: cptr ~s isn't of type ~s"), self, cptr,
-              type_sym, nao);
-  return cptr->co.handle;
+  } else {
+    mem_t *ptr = cptr->co.handle;
+
+    if (type_sym && cptr->co.cls != type_sym && (ptr != 0 || cptr->co.cls))
+      uw_throwf(error_s, lit("~a: cptr ~s isn't of type ~s"), self, cptr,
+                type_sym, nao);
+
+    return ptr;
+  }
 }
 
 mem_t *cptr_get(val cptr)
diff --git a/txr.1 b/txr.1
index 5fa47065..9a912188 100644
--- a/txr.1
+++ b/txr.1
@@ -55456,6 +55456,14 @@ In the reverse direction, when a Lisp
 object is converted to the parametrized type, its type tag must match
 .metn type-sym ,
 or else the conversion fails with an error exception.
+This rule contains a slight relaxation: a
+.code cptr
+object with a
+.code nil
+tag can be converted to a foreign representation using any parametrized type,
+if its value is null. In other situations, the
+.code cptr-cast
+function must be used to coerce the pointer object to the matching type.
 
 Note that if
 .meta type-sym
-- 
cgit v1.2.3