[usocket-cvs] r46 - in usocket/trunk: . test

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Mon Feb  6 14:50:07 2006
New Revision: 46

Added:
   usocket/trunk/run-usocket-tests.sh   (contents, props changed)
Modified:
   usocket/trunk/   (props changed)
   usocket/trunk/package.lisp
   usocket/trunk/test/package.lisp   (contents, props changed)
   usocket/trunk/test/test-usocket.lisp   (contents, props changed)
   usocket/trunk/test/usocket-test.asd   (contents, props changed)
Log:
Commit test script update.

Modified: usocket/trunk/package.lisp
==============================================================================
--- usocket/trunk/package.lisp	(original)
+++ usocket/trunk/package.lisp	Mon Feb  6 14:50:07 2006
@@ -16,6 +16,7 @@
              :with-connected-socket ; macros
 
              :usocket ; socket object and accessors
+             :socket
              :socket-stream
 
              :host-byte-order ; IPv4 utility functions

Added: usocket/trunk/run-usocket-tests.sh
==============================================================================
--- (empty file)
+++ usocket/trunk/run-usocket-tests.sh	Mon Feb  6 14:50:07 2006
@@ -0,0 +1,23 @@
+#!/bin/sh
+
+# Test script to be run from the usocket source root
+#
+# Unfortunately, it currently works only with SBCL
+# in my setup...
+#
+# I need to figure out how to setup ASDF with the other lisps
+# I have installed: cmucl, ABCL, clisp, allegro and lispworks
+
+for my_lisp in sbcl ; do
+
+echo "
+(require 'usocket-test)
+
+(usocket-test:run-usocket-tests)
+
+(quit)
+" | $my_lisp
+
+echo "Above test results for $my_lisp."
+
+done

Modified: usocket/trunk/test/package.lisp
==============================================================================
--- usocket/trunk/test/package.lisp	(original)
+++ usocket/trunk/test/package.lisp	Mon Feb  6 14:50:07 2006
@@ -1,5 +1,5 @@
 ;;;; $Id$
-;;;; $Source$
+;;;; $URL$
 
 ;;;; See the LICENSE file for licensing information.
 
@@ -9,5 +9,5 @@
   (defpackage :usocket-test
       (:use :cl :rt)
     (:nicknames :usoct)
-    (:export :do-tests)))
+    (:export :do-tests :run-usocket-tests)))
 

Modified: usocket/trunk/test/test-usocket.lisp
==============================================================================
--- usocket/trunk/test/test-usocket.lisp	(original)
+++ usocket/trunk/test/test-usocket.lisp	Mon Feb  6 14:50:07 2006
@@ -1,17 +1,82 @@
 ;;;; $Id$
-;;;; $Source$
+;;;; $URL$
 
 ;;;; See LICENSE for licensing information.
 
 (in-package :usocket-test)
 
-(defvar *soc1* (usoc:make-socket :socket :stream
-                                 :host #(1 2 3 4)
-                                 :port 80
-                                 :stream :my-stream))
-
-(deftest make-socket.1 (usoc::real-socket usoct::*soc1*) :my-socket)
-(deftest make-socket.2 (usoc::real-stream usoct::*soc1*) :my-stream)
-(deftest make-socket.3 (usoc:host usoct::*soc1*) #(1 2 3 4))
-(deftest make-socket.4 (usoc:host usoct::*soc1*) 80)
+(defparameter *soc1* (usocket::make-socket :socket :my-socket
+                                           :stream :my-stream))
 
+(deftest make-socket.1 (usocket:socket *soc1*) :my-socket)
+(deftest make-socket.2 (usocket:socket-stream *soc1*) :my-stream)
+
+(deftest socket-no-connect.1
+  (catch 'caught-error
+    (handler-bind ((usocket:usocket-error
+                    #'(lambda (c) (throw 'caught-error nil))))
+      (usocket:socket-connect "127.0.0.0" 80)
+      t))
+  nil)
+(deftest socket-no-connect.2
+  (catch 'caught-error
+    (handler-bind ((usocket:usocket-error
+                    #'(lambda (c) (throw 'caught-error nil))))
+      (usocket:socket-connect #(127 0 0 0) 80)
+      t))
+  nil)
+(deftest socket-no-connect.3
+  (catch 'caught-error
+    (handler-bind ((usocket:usocket-error
+                    #'(lambda (c) (throw 'caught-error nil))))
+      (usocket:socket-connect 2130706432 80) ;; == #(127 0 0 0)
+      t))
+  nil)
+
+(deftest socket-failure.1
+  (catch 'caught-error
+    (handler-bind ((usocket:network-unreachable-error
+                    #'(lambda (c) (throw 'caught-error nil)))
+                   (condition
+                    #'(lambda (c) (throw 'caught-error t))))
+      (usocket:socket-connect 2130706432 80) ;; == #(127 0 0 0)
+      t))
+  nil)
+
+;; let's hope c-l.net doesn't move soon, or that people start to
+;; test usocket like crazy..
+(deftest socket-connect.1
+  (let ((sock (usocket:socket-connect "common-lisp.net" 80)))
+    (unwind-protect
+        (typep sock 'usocket:usocket)
+      (usocket:socket-close sock)))
+  t)
+(deftest socket-connect.2
+  (let ((sock (usocket:socket-connect #(65 110 12 237) 80)))
+    (unwind-protect
+        (typep sock 'usocket:usocket)
+      (usocket:socket-close sock)))
+  t)
+(deftest socket-connect.3
+  (let ((sock (usocket:socket-connect 1097731309 80)))
+    (unwind-protect
+        (typep sock 'usocket:usocket)
+      (usocket:socket-close sock)))
+  t)
+
+;; let's hope c-l.net doesn't change its software any time soon
+(deftest socket-stream.1
+  (let ((sock (usocket:socket-connect "common-lisp.net" 80)))
+    (unwind-protect
+        (progn
+          (format (usocket:socket-stream sock)
+                  "GET / HTTP/1.0~A~A~A~A"
+                  #\Return #\Newline #\Return #\Newline)
+          (force-output (usocket:socket-stream sock))
+          (read-line (usocket:socket-stream sock)))
+      (usocket:socket-close sock)))
+  #.(format nil "HTTP/1.1 200 OK~A" #\Return) nil)
+
+
+(defun run-usocket-tests ()
+  (do-tests))

Modified: usocket/trunk/test/usocket-test.asd
==============================================================================
--- usocket/trunk/test/usocket-test.asd	(original)
+++ usocket/trunk/test/usocket-test.asd	Mon Feb  6 14:50:07 2006
@@ -1,5 +1,5 @@
 ;;;; $Id$
-;;;; $Source$
+;;;; $URL$
 
 ;;;; See the LICENSE file for licensing information.