~ chicken-core (chicken-5) 7ae936dabe848a7afe7cb3ab727bb4785c8d8907

commit 7ae936dabe848a7afe7cb3ab727bb4785c8d8907
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Jun 30 06:24:00 2011 -0400
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Thu Jun 30 06:25:42 2011 -0400

    tcp-port-numbers used incorrect checks for results of port-accessors;
    string-results in foreign functions have scrutiny-type "(or boolean string)"

diff --git a/support.scm b/support.scm
index 05246b4f..8a6b143e 100644
--- a/support.scm
+++ b/support.scm
@@ -1203,23 +1203,17 @@
 		unsigned-long) 
        'number)
       ((c-pointer c-string-list c-string-list*)
-       (case mode
-	 ((arg) '(or boolean pointer))
-	 (else 'pointer)))
+       '(or boolean pointer))
       ((nonnull-c-pointer) 'pointer)
       ((c-string c-string* unsigned-c-string unsigned-c-string*)
-       (case mode
-	 ((arg) '(or boolean string))
-	 (else 'string)))
+       '(or boolean string))
       ((nonnull-c-string nonnull-c-string* nonnull-unsigned-c-string*) 'string)
       ((symbol) 'symbol)
       (else
        (cond ((pair? t)
 	      (case (car t)
 		((ref pointer function c-pointer)
-		 (case mode
-		   ((arg) '(or boolean pointer))
-		   (else 'pointer)))
+		 '(or boolean pointer))
 		((const) (foreign-type->scrutiny-type (cadr t) mode))
 		((enum) 'number)
 		((nonnull-pointer nonnull-c-pointer) 'pointer)
diff --git a/tcp.scm b/tcp.scm
index 49efac6d..456399cf 100644
--- a/tcp.scm
+++ b/tcp.scm
@@ -644,15 +644,17 @@ EOF
 (define (tcp-port-numbers p)
   (##sys#check-port p 'tcp-port-numbers)
   (let ((fd (##sys#tcp-port->fileno p)))
-    (values
-     (or (##net#getsockport fd)
-	 (##sys#signal-hook 
-	  #:network-error 'tcp-port-numbers
-	  (##sys#string-append "cannot compute local port - " strerror) p) )
-     (or (##net#getpeerport fd)
-	 (##sys#signal-hook
-	  #:network-error 'tcp-port-numbers
-	  (##sys#string-append "cannot compute remote port - " strerror) p) ) ) ) )
+    (let ((sp (##net#getsockport fd))
+	  (pp (##net#getpeerport fd)))
+      (when (eq? -1 sp)
+	(##sys#signal-hook 
+	 #:network-error 'tcp-port-numbers
+	 (##sys#string-append "cannot compute local port - " strerror) p))
+      (when (eq? -1 pp)
+	(##sys#signal-hook
+	 #:network-error 'tcp-port-numbers
+	 (##sys#string-append "cannot compute remote port - " strerror) p) )
+      (values sp pp))))
 
 (define (tcp-listener-port tcpl)
   (##sys#check-structure tcpl 'tcp-listener 'tcp-listener-port)