From 725c1dd7f23963bdc5732956e07195007aded611 Mon Sep 17 00:00:00 2001
From: Mikhail Novikov <freiksenet@gmail.com>
Date: Thu, 13 Jun 2013 23:49:04 +0300
Subject: [PATCH] Message creation and mangling tests.

---
 src/package.lisp    |  4 ++--
 src/zeromq-api.lisp |  9 ++++---
 tests/main.lisp     | 67 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 75 insertions(+), 5 deletions(-)

diff --git a/src/package.lisp b/src/package.lisp
index 9688dd7..a8da99a 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -70,11 +70,11 @@
    #:getsockopt
    #:setsockopt
 
-   #:msg-data-as-is
+   #:make-msg
+   #:msg-raw
    #:msg-data-as-array
    #:msg-data-as-string
    #:msg-close
-   #:msg-init-size
    #:msg-size
    #:msg-move
    #:msg-copy
diff --git a/src/zeromq-api.lisp b/src/zeromq-api.lisp
index 64a421c..c065329 100644
--- a/src/zeromq-api.lisp
+++ b/src/zeromq-api.lisp
@@ -160,9 +160,6 @@
     (setf (msg-raw msg) raw-msg)
     msg))
 
-(defun msg-data-as-is (msg)
-  (%msg-data (msg-raw msg)))
-
 (defun msg-data-as-string (msg)
   (let ((data (%msg-data (msg-raw msg)))
         (size (%msg-size (msg-raw msg))))
@@ -181,6 +178,12 @@
           (%memcpy ptr data len))
         arr))))
 
+;;; (xxx)freiksenet: doing zmq operations on closed message sends SBCL to ldb.
+(defun msg-close (msg)
+  (tg:cancel-finalization msg)
+  (%msg-close (msg-raw msg))
+  (foreign-free (msg-raw msg)))
+
 (defun msg-size (msg)
   (%msg-size (msg-raw msg)))
 
diff --git a/tests/main.lisp b/tests/main.lisp
index 2dd5181..ea6d570 100644
--- a/tests/main.lisp
+++ b/tests/main.lisp
@@ -126,3 +126,70 @@
     (zmq:with-socket (s ctx :pub)
       (is (zerop (zmq:setsockopt s :identity "Foobar")))
       (is (equal "Foobar" (zmq:getsockopt s :identity))))))
+
+;; Making and working with messages
+
+(test make-msg-empty
+  "Calling make-msg without arguments yield empty message and it's really
+   empty."
+  (let ((msg (zmq:make-msg)))
+    (is (zerop (zmq:msg-size msg)))
+    (is (equalp #() (zmq:msg-data-as-array msg)))
+    (is (equal "" (zmq:msg-data-as-string msg)))))
+
+(test make-msg-string
+  "Calling make-msg with string as :data should produce message with payload
+   matching the string."
+  (let* ((empty-msg (zmq:make-msg :data ""))
+         (content "payload of message")
+         (content-vec (map 'vector #'char-code content))
+         (msg (zmq:make-msg :data content)))
+    (is (zerop (zmq:msg-size empty-msg)))
+    (is (equalp #() (zmq:msg-data-as-array empty-msg)))
+    (is (equal "" (zmq:msg-data-as-string empty-msg)))
+    (is (= (length content) (zmq:msg-size msg)))
+    (is (equal content (zmq:msg-data-as-string msg)))
+    (is (equalp content-vec (zmq:msg-data-as-array msg)))))
+
+(test make-msg-string-unicode
+  "Calling make-msg with unicode data should produce message with payload
+   encoded correctly."
+  (let ((msg (zmq:make-msg :data "ю")))
+    (is (= 2 (zmq:msg-size msg)))
+    (is (equal "ю" (zmq:msg-data-as-string msg)))))
+
+(test make-msg-array
+  "Calling make-msg with array as data should produce message with matching
+   payload."
+  (let ((msg (zmq:make-msg :data #(1 2 3 4))))
+    (is (= 4 (zmq:msg-size msg)))
+    (is (equalp #(1 2 3 4) (zmq:msg-data-as-array msg)))))
+
+(test make-msg-size
+  "Calling make-msg with size argument should produce message of appropriate
+   size."
+  (let ((msg (zmq:make-msg :size 10)))
+    (is (= 10 (zmq:msg-size msg)))))
+
+(test msg-copy
+  "Calling msg-copy should copy the payload of the source without disturbing
+   the original."
+  (let ((src-msg (zmq:make-msg :data #(1 2 3 4)))
+        (dst-msg (zmq:make-msg)))
+    (zmq:msg-copy dst-msg src-msg)
+    (is (= (zmq:msg-size src-msg) (zmq:msg-size dst-msg) 4))
+    (is (equalp (zmq:msg-data-as-array src-msg)
+                (zmq:msg-data-as-array dst-msg)))
+    (is (equalp #(1 2 3 4)
+                (zmq:msg-data-as-array src-msg)))))
+
+(test msg-move
+  "Calling msg-move should copy the payload of the source while making original
+   an empty message."
+  (let ((src-msg (zmq:make-msg :data #(1 2 3 4)))
+        (dst-msg (zmq:make-msg)))
+    (zmq:msg-copy dst-msg src-msg)
+    (is (equalp #() (zmq:msg-data-as-array src-msg)))
+    (is (= 4 (zmq:msg-size dst-msg)))
+    (is (equalp #(1 2 3 4)
+                (zmq:msg-data-as-array dst-msg)))))
-- 
2.11.4.GIT