Merge branch 'wip-guile-2.0.12'

9 files changed, 60 insertions, 9 deletions

diff --git a/libguile-ssh/key-type.c b/libguile-ssh/key-type.c
index 46c2d71..8bb8f28 100644
--- a/libguile-ssh/key-type.c
+++ b/libguile-ssh/key-type.c
@@ -57,7 +57,15 @@ mark_key_smob (SCM key_smob)
 size_t
 free_key_smob (SCM arg1)
 {
-  struct key_data *data = _scm_to_key_data (arg1);
+  struct key_data *data;
+  if (! SCM_SMOB_PREDICATE (key_tag, arg1))
+    {
+      _ssh_log (SSH_LOG_FUNCTIONS, "free_key_smob", "%s", "already freed");
+      return 0;
+    }
+
+  data = _scm_to_key_data (arg1);
+
   if (scm_is_false (data->parent))
     {
       /* It's safe to free the key only if it was not derived from some other
diff --git a/libguile-ssh/message-type.c b/libguile-ssh/message-type.c
index 83d32b1..46b91f1 100644
--- a/libguile-ssh/message-type.c
+++ b/libguile-ssh/message-type.c
@@ -41,6 +41,11 @@ mark_message (SCM message)
 size_t
 free_message (SCM message)
 {
+  if (! SCM_SMOB_PREDICATE (message_tag, message))
+    {
+      _ssh_log (SSH_LOG_FUNCTIONS, "free_message", "%s", "already freed");
+      return 0;
+    }
   struct message_data *msg_data = _scm_to_message_data (message);
   ssh_message_free (msg_data->message);
   return 0;
diff --git a/libguile-ssh/server-type.c b/libguile-ssh/server-type.c
index ed2402f..5bb5e2e 100644
--- a/libguile-ssh/server-type.c
+++ b/libguile-ssh/server-type.c
@@ -41,6 +41,11 @@ mark_server (SCM server)
 size_t
 free_server (SCM server)
 {
+  if (! SCM_SMOB_PREDICATE (server_tag, server))
+    {
+      _ssh_log (SSH_LOG_FUNCTIONS, "free_server", "%s", "already freed");
+      return 0;
+    }
   struct server_data *server_data = _scm_to_server_data (server);
   ssh_bind_free (server_data->bind);
   return 0;
diff --git a/libguile-ssh/session-type.c b/libguile-ssh/session-type.c
index f6d909f..a766329 100644
--- a/libguile-ssh/session-type.c
+++ b/libguile-ssh/session-type.c
@@ -41,6 +41,11 @@ mark_session (SCM session_smob)
 size_t
 free_session (SCM session_smob)
 {
+  if (! SCM_SMOB_PREDICATE (session_tag, session_smob))
+    {
+      _ssh_log (SSH_LOG_FUNCTIONS, "free_session", "%s", "already freed");
+      return 0;
+    }
   struct session_data *data = _scm_to_session_data (session_smob);
 
   ssh_disconnect (data->ssh_session);
diff --git a/libguile-ssh/sftp-session-type.c b/libguile-ssh/sftp-session-type.c
index c3260e3..ae59c57 100644
--- a/libguile-ssh/sftp-session-type.c
+++ b/libguile-ssh/sftp-session-type.c
@@ -42,6 +42,11 @@ mark_sftp_session (SCM sftp_session)
 static size_t
 free_sftp_session (SCM sftp_session)
 {
+  if (! SCM_SMOB_PREDICATE (sftp_session_tag, sftp_session))
+    {
+      _ssh_log (SSH_LOG_FUNCTIONS, "free_sftp_session", "%s", "already freed");
+      return 0;
+    }
   struct sftp_session_data *sftp_sd = _scm_to_sftp_session_data (sftp_session);
   sftp_free (sftp_sd->sftp_session);
   return 0;
diff --git a/tests/Makefile.am b/tests/Makefile.am
index d79be60..f791aa7 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -97,6 +97,8 @@ CLEANFILES = \
 	client-server-libssh.log		\
 	dist-errors.log				\
 	dist-libssh.log				\
+	key-errors.log				\
+	key-libssh.log				\
 	popen-errors.log			\
 	popen-libssh.log			\
 	server-client-errors.log		\
diff --git a/tests/common.scm b/tests/common.scm
index 77034ea..c5dac55 100644
--- a/tests/common.scm
+++ b/tests/common.scm
@@ -469,6 +469,7 @@ printer."
     (setup-error-logging! errors-log-file)))
 
 (define (test-begin-with-log test-name)
+  (set-log-verbosity! 'functions)
   (test-begin test-name)
   (setup-test-suite-logging! test-name))
 
diff --git a/tests/key.scm b/tests/key.scm
index cfbed1a..c4394b1 100644
--- a/tests/key.scm
+++ b/tests/key.scm
@@ -33,15 +33,15 @@
   (or (not %openssl?)
       test))
 
-(test-begin "key")
+(test-begin-with-log "key")
 
-(test-assert "private-key-from-file"
+(test-assert-with-log "private-key-from-file"
   (and (private-key-from-file %rsakey)
        (private-key-from-file %dsakey)
        (when-openssl
         (private-key-from-file %ecdsakey))))
 
-(test-assert "public-key-from-file"
+(test-assert-with-log "public-key-from-file"
   (and (public-key-from-file %rsakey-pub)
        (public-key-from-file %dsakey-pub)
        (when-openssl
@@ -72,7 +72,7 @@
        (not (private-key? *rsa-pub-key*))
        (not (private-key? "not a key"))))
 
-(test-assert "public-key?"
+(test-assert-with-log "public-key?"
   (and (public-key? *rsa-pub-key*)
 
        ;; XXX: Currently a SSH key that has been read from a file
@@ -81,20 +81,20 @@
 
        (not (public-key? "not a key"))))
 
-(test-assert "private-key->public-key"
+(test-assert-with-log "private-key->public-key"
   (and (private-key->public-key *rsa-key*)
        (private-key->public-key *dsa-key*)
        (when-openssl
         (private-key->public-key *ecdsa-key*))))
 
-(test-assert "get-key-type"
+(test-assert-with-log "get-key-type"
   (and (eq? 'rsa   (get-key-type *rsa-key*))
        (eq? 'dss   (get-key-type *dsa-key*))
        (when-openssl
         (eq? 'ecdsa (get-key-type *ecdsa-key*)))))
 
 
-(test-assert "private-key-to-file"
+(test-assert-with-log "private-key-to-file"
   (when-openssl
    (let ((file-name "./tmp-rsa-key"))
      (private-key-to-file *rsa-key* file-name)
@@ -141,8 +141,18 @@
    (public-key->string (string->public-key %ecdsakey-pub-string 'ecdsa))
    %ecdsakey-pub-string))
 
+(test-assert-with-log "string->public-key, RSA, gc test"
+  (let ((max-keys 1000))
+    (do ((idx 1 (+ idx 1)))
+        ((> idx max-keys))
+      (when (zero? (euclidean-remainder idx 100))
+        (format-log/scm 'nolog "" (format #f "~d / ~d keys created ..."
+                                          idx max-keys)))
+      (public-key->string (string->public-key %rsakey-pub-string 'rsa)))
+    #t))
+
 
-(test-assert "make-keypair"
+(test-assert-with-log "make-keypair"
   (and (let ((key (make-keypair 'rsa 1024)))
          (and (key? key)
               (eq? (get-key-type key) 'rsa)))
diff --git a/tests/session.scm b/tests/session.scm
index cada199..bfce279 100644
--- a/tests/session.scm
+++ b/tests/session.scm
@@ -31,6 +31,16 @@
 (test-assert "%make-session"
   (%make-session))
 
+(test-assert-with-log "%make-session, gc test"
+  (let ((max-sessions 1000))
+    (do ((idx 1 (+ idx 1)))
+        ((> idx max-sessions))
+      (when (zero? (euclidean-remainder idx 100))
+        (format-log/scm 'nolog "" (format #f "~d / ~d sessions created ..."
+                                          idx max-sessions)))
+      (%make-session))
+    #t))
+
 (test-assert "session?"
   (let ((session (%make-session))
         (x       "string"))