ffi: pack bugfix and tests.

* ffi.c (ffi_transform_pack): Fix: return the original syntax in
the situation when no cases are recognized, rather than
the cdr of the syntax. When the struct/union syntax has no
members, return the original syntax to indicate no transformation
took place.

* txr.1: Document the feature that pack on a typedef name or struct
name with no members will do the alignment adjustment only, without
the syntactic transformation.

* tests/017/pack-align.tl: New file.

3 files changed, 149 insertions, 12 deletions

diff --git a/ffi.c b/ffi.c
index 8f482e9a..13e8769b 100644
--- a/ffi.c
+++ b/ffi.c
@@ -3925,15 +3925,16 @@ static val ffi_struct_init(val slot_init, val strct)
 
 static val ffi_transform_pack(val syntax, val align)
 {
-  val op = pop(&syntax);
+  val args = syntax;
+  val op = pop(&args);
 
   if (op == struct_s || op == union_s)
   {
-    val name = pop(&syntax);
+    val name = pop(&args);
     val iter;
     list_collect_decl (packed, ptail);
 
-    for (iter = syntax; iter; iter = cdr(iter)) {
+    for (iter = args; iter; iter = cdr(iter)) {
       val slot_spec = car(iter);
       val slot = car(slot_spec);
       val type = cadr(slot_spec);
@@ -3945,14 +3946,14 @@ static val ffi_transform_pack(val syntax, val align)
                                       list(slot, packed_type, nao)));
     }
 
-    return cons(op, cons(name, packed));
+    return if3(packed, cons(op, cons(name, packed)), syntax);
   } else if (op == align_s) {
-    if (length(syntax) == one) {
-      val type = car(syntax);
+    if (length(syntax) == two) {
+      val type = car(args);
       return list(align_s, list(pack_s, align, type, nao), nao);
-    } else if (length(syntax) == two) {
-      val align = car(syntax);
-      val type = cadr(syntax);
+    } else if (length(syntax) == three) {
+      val align = car(args);
+      val type = cadr(args);
       return list(align_s, align, list(pack_s, align, type, nao), nao);
     }
   }
diff --git a/tests/017/pack-align.tl b/tests/017/pack-align.tl
new file mode 100644
index 00000000..a1048788
--- /dev/null
+++ b/tests/017/pack-align.tl
@@ -0,0 +1,112 @@
+(load "../common")
+
+(mtest
+  (alignof int) 4
+  (alignof (align int)) 16
+  (alignof (align 1 int)) 4
+  (alignof (align 6 int)) :error
+  (alignof (align 8 int)) 8)
+
+(mtest
+  (alignof (pack int)) 1
+  (alignof (pack 1 int)) 1
+  (alignof (pack 6 int)) :error
+  (alignof (pack 8 int)) 8)
+
+(mtest
+  (alignof (pack 1 (align 8 int))) 8
+  (alignof (align 8 (pack 1 int))) 8)
+
+(typedef s0 (pack (struct s0
+                    (a char)
+                    (b short)
+                    (c int)
+                    (d longlong))))
+
+(mtest
+  (alignof s0.a) 1
+  (alignof s0.b) 1
+  (alignof s0.c) 1
+  (alignof s0.d) 1)
+
+(mtest
+  (offsetof s0 a) 0
+  (offsetof s0 b) 1
+  (offsetof s0 c) 3
+  (offsetof s0 d) 7
+  (sizeof s0) 15)
+
+(typedef s1 (pack 2 (struct s1
+                      (a char)
+                      (b short)
+                      (c int)
+                      (d longlong))))
+
+(mtest
+  (alignof s1.a) 2
+  (alignof s1.b) 2
+  (alignof s1.c) 2
+  (alignof s1.d) 2)
+
+(mtest
+  (offsetof s1 a) 0
+  (offsetof s1 b) 2
+  (offsetof s1 c) 4
+  (offsetof s1 d) 8
+  (sizeof s1) 16)
+
+(typedef s2 (pack 32 (struct s2
+                       (a char)
+                       (b short)
+                       (c int)
+                       (d longlong))))
+
+(mtest
+  (alignof s2.a) 32
+  (alignof s2.b) 32
+  (alignof s2.c) 32
+  (alignof s2.d) 32)
+
+(mtest
+  (offsetof s2 a) 0
+  (offsetof s2 b) 32
+  (offsetof s2 c) 64
+  (offsetof s2 d) 96
+  (sizeof s2) 128)
+
+(typedef s3 (pack 1 (struct s3
+                      (a char)
+                      (b (align 2 char))
+                      (c (align int))
+                      (d longlong))))
+
+(mtest
+  (alignof s3.a) 1
+  (alignof s3.b) 2
+  (alignof s3.c) 16
+  (alignof s3.d) 1)
+
+(mtest
+  (offsetof s3 a) 0
+  (offsetof s3 b) 2
+  (offsetof s3 c) 16
+  (offsetof s3 d) 20
+  (sizeof s3) 32)
+
+(typedef s4 (align 256 s3))
+
+(mtest
+  (sizeof s4) 32
+  (alignof s4) 256)
+
+(typedef s5 (pack s3))
+
+(mtest
+  (sizeof s5) 32
+  (alignof s5) 1)
+
+(typedef s6 (pack (struct s3)))
+
+(mtest
+  (sizeof s6) 32
+  (alignof s6) 1)
diff --git a/txr.1 b/txr.1
index 732e417d..971a96fc 100644
--- a/txr.1
+++ b/txr.1
@@ -81254,11 +81254,11 @@ operator has no semantics other than these behaviors.
 .IP 1.
 When
 .meta type
-is a
+is
 .code struct
 or
-.codn union ,
-then the
+.code union
+syntax which defines at least one member, then the
 .code pack
 operator performs the following syntactic transformation:
 each member of
@@ -81292,6 +81292,30 @@ An important rationale also is that the GNU C
 attribute works this way, and so C structures declarations using
 that attribute are easier to translate to the \*(TL FFI type system.
 
+Deriving a less strictly aligned version of a structure or union type without
+any effect on the alignment of its members may be obtained by applying the
+.code bit
+operator to either
+.code typedef
+name for a structure or union type, or else to syntax which refers
+to an existing type without defining members.
+Given the definition
+.codn "(typedef s (struct s (a int) (b char)))" ,
+the type
+.code s
+is an eight byte structure with three bytes of padding at the end, which has
+four byte alignment. The type expression
+.code "(pack s)"
+produces a version of this type which has one byte alignment.
+The expression
+.codn "(pack (struct s))" ,
+likewise. The resulting
+unaligned type is still eight bytes wide, and has three padding bytes.
+In other words, the
+.code pack
+operator does not transform the syntax of a structure which is already
+defined as an object,
+
 .IP 2.
 When
 .meta type