Add new condition type ILLEGAL-PATHNAME-COMPONENT so that pathname

parsing errors can be caught.

diff --git a/v7/src/runtime/dospth.scm b/v7/src/runtime/dospth.scm
index c0572ad61e5946140b0cdf966f446f737d3becf0..3f2163485e795ffc379729b4e9d977f873443441 100644 (file)
--- a/v7/src/runtime/dospth.scm
+++ b/v7/src/runtime/dospth.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: dospth.scm,v 1.27 1995/07/11 22:31:03 cph Exp $
+$Id: dospth.scm,v 1.28 1995/09/11 19:07:10 cph Exp $
 
 Copyright (c) 1992-95 Massachusetts Institute of Technology
 
@@ -200,12 +200,13 @@ MIT in each case. |#
                               sub-directory-delimiter-string
                               (loop (cdr directory)))))))
        (else
-        (error "Illegal pathname directory:" directory))))
+        (error:illegal-pathname-component directory "directory"))))
 
 (define (unparse-directory-component component)
   (cond ((eq? component 'UP) "..")
        ((string? component) component)
-       (else (error "Illegal pathname directory component:" component))))
+       (else
+        (error:illegal-pathname-component component "directory component"))))
 
 (define (unparse-name name type)
   (let ((name (or (unparse-component name) ""))
@@ -217,7 +218,7 @@ MIT in each case. |#
 (define (unparse-component component)
   (cond ((or (not component) (string? component)) component)
        ((eq? component 'WILD) "*")
-       (else (error "Illegal pathname component:" component))))
+       (else (error:illegal-pathname-component component "component"))))
 \f
 ;;;; Pathname Constructors
 
@@ -226,8 +227,7 @@ MIT in each case. |#
    host
    (cond ((string? device) device)
         ((memq device '(#F UNSPECIFIC)) device)
-        (else
-         (error:wrong-type-argument device "pathname device" 'MAKE-PATHNAME)))
+        (else (error:illegal-pathname-component device "device")))
    (cond ((or (not directory) (eq? directory 'UNSPECIFIC))
          directory)
         ((and (list? directory)
@@ -242,19 +242,18 @@ MIT in each case. |#
                       (eq? element 'UP)))))
          (simplify-directory directory))
         (else
-         (error:wrong-type-argument directory "pathname directory"
-                                    'MAKE-PATHNAME)))
+         (error:illegal-pathname-component directory "directory")))
    (if (or (memq name '(#F WILD))
           (and (string? name) (not (string-null? name))))
        name
-       (error:wrong-type-argument name "pathname name" 'MAKE-PATHNAME))
+       (error:illegal-pathname-component name "name"))
    (if (or (memq type '(#F WILD))
           (and (string? type) (not (string-null? type))))
        type
-       (error:wrong-type-argument type "pathname type" 'MAKE-PATHNAME))
+       (error:illegal-pathname-component type "type"))
    (if (memq version '(#F UNSPECIFIC WILD NEWEST))
        'UNSPECIFIC
-       (error:wrong-type-argument version "pathname version" 'MAKE-PATHNAME))))
+       (error:illegal-pathname-component version "version"))))
 
 (define (%%make-pathname host device directory name type version)
   ;; This is a kludge to make the \\foo\bar notation work correctly.

diff --git a/v7/src/runtime/error.scm b/v7/src/runtime/error.scm
index deb2200ba2887d017a7a11171fbc9cb5bd8fa09b..700fe4fb6938f810e30387c94c557051f2529f47 100644 (file)
--- a/v7/src/runtime/error.scm
+++ b/v7/src/runtime/error.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: error.scm,v 14.45 1993/12/23 08:03:22 cph Exp $
+$Id: error.scm,v 14.46 1995/09/11 19:05:26 cph Exp $
 
-Copyright (c) 1988-93 Massachusetts Institute of Technology
+Copyright (c) 1988-95 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -684,6 +684,7 @@ MIT in each case. |#
 (define condition-type:floating-point-overflow)
 (define condition-type:floating-point-underflow)
 (define condition-type:illegal-datum)
+(define condition-type:illegal-pathname-component)
 (define condition-type:no-such-restart)
 (define condition-type:port-error)
 (define condition-type:serious-condition)
@@ -710,6 +711,7 @@ MIT in each case. |#
 (define error:derived-file)
 (define error:derived-port)
 (define error:derived-thread)
+(define error:illegal-pathname-component)
 (define error:wrong-number-of-arguments)
 (define error:wrong-type-argument)
 (define error:wrong-type-datum)
@@ -885,6 +887,16 @@ MIT in each case. |#
                       (write-string " arguments" port))))
              (write-char #\. port)))))
 
+  (set! condition-type:illegal-pathname-component
+       (make-condition-type 'ILLEGAL-PATHNAME-COMPONENT
+           condition-type:wrong-type-datum
+         (lambda (condition port)
+           (write-string "The object " port)
+           (write (access-condition condition 'DATUM) port)
+           (write-string " is not a valid pathname " port)
+           (write (access-condition condition 'TYPE) port)
+           (write-string "." port))))
+
   (set! condition-type:control-error
        (make-condition-type 'CONTROL-ERROR condition-type:error '()
          "Control error."))
@@ -1112,6 +1124,10 @@ MIT in each case. |#
        (condition-signaller condition-type:wrong-number-of-arguments
                             '(DATUM TYPE OPERANDS)
                             standard-error-handler))
+  (set! error:illegal-pathname-component
+       (condition-signaller condition-type:illegal-pathname-component
+                            '(DATUM TYPE)
+                            standard-error-handler))
   (set! error:divide-by-zero
        (condition-signaller condition-type:divide-by-zero
                             '(OPERATOR OPERANDS)

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 7c53ff4a5bd7d2511f9f2dffa4f111427334ecdd..ad1dadf8eddd8d494d49526701d487f70f00057e 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.261 1995/08/08 15:30:04 adams Exp $
+$Id: runtime.pkg,v 14.262 1995/09/11 19:06:33 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -585,6 +585,7 @@ MIT in each case. |#
          condition-type:floating-point-overflow
          condition-type:floating-point-underflow
          condition-type:illegal-datum
+         condition-type:illegal-pathname-component
          condition-type:no-such-restart
          condition-type:port-error
          condition-type:serious-condition
@@ -622,6 +623,7 @@ MIT in each case. |#
          error:derived-thread
          error:divide-by-zero
          error:file-operation
+         error:illegal-pathname-component
          error:no-such-restart
          error:wrong-number-of-arguments
          error:wrong-type-argument

diff --git a/v7/src/runtime/unxpth.scm b/v7/src/runtime/unxpth.scm
index 63a85340e3a0dbf2725061605c61028e0784d728..cb4ae439f31bc54a08d40f356cc56dec3fd3268e 100644 (file)
--- a/v7/src/runtime/unxpth.scm
+++ b/v7/src/runtime/unxpth.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: unxpth.scm,v 14.18 1995/04/09 22:32:33 cph Exp $
+$Id: unxpth.scm,v 14.19 1995/09/11 19:07:16 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -160,12 +160,13 @@ MIT in each case. |#
                               "/"
                               (loop (cdr directory)))))))
        (else
-        (error "Illegal pathname directory:" directory))))
+        (error:illegal-pathname-component directory "directory"))))
 
 (define (unparse-directory-component component)
   (cond ((eq? component 'UP) "..")
        ((string? component) component)
-       (else (error "Illegal pathname directory component:" component))))
+       (else
+        (error:illegal-pathname-component component "directory component"))))
 
 (define (unparse-name name type)
   (let ((name (or (unparse-component name) ""))
@@ -177,7 +178,7 @@ MIT in each case. |#
 (define (unparse-component component)
   (cond ((or (not component) (string? component)) component)
        ((eq? component 'WILD) "*")
-       (else (error "Illegal pathname component:" component))))
+       (else (error:illegal-pathname-component component "component"))))
 \f
 ;;;; Pathname Constructors
 
@@ -186,7 +187,7 @@ MIT in each case. |#
    host
    (if (memq device '(#F UNSPECIFIC))
        'UNSPECIFIC
-       (error:wrong-type-argument device "pathname device" 'MAKE-PATHNAME))
+       (error:illegal-pathname-component device "device"))
    (cond ((not directory)
          directory)
         ((and (list? directory)
@@ -199,19 +200,18 @@ MIT in each case. |#
                       (eq? element 'UP)))))
          (simplify-directory directory))
         (else
-         (error:wrong-type-argument directory "pathname directory"
-                                    'MAKE-PATHNAME)))
+         (error:illegal-pathname-component directory "directory")))
    (if (or (memq name '(#F WILD))
           (and (string? name) (not (string-null? name))))
        name
-       (error:wrong-type-argument name "pathname name" 'MAKE-PATHNAME))
+       (error:illegal-pathname-component name "name"))
    (if (or (memq type '(#F WILD))
           (and (string? type) (not (string-null? type))))
        type
-       (error:wrong-type-argument type "pathname type" 'MAKE-PATHNAME))
+       (error:illegal-pathname-component type "type"))
    (if (memq version '(#F UNSPECIFIC WILD NEWEST))
        'UNSPECIFIC
-       (error:wrong-type-argument version "pathname version" 'MAKE-PATHNAME))))
+       (error:illegal-pathname-component version "version"))))
 
 (define (unix/pathname-as-directory pathname)
   (let ((name (%pathname-name pathname))

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 52494dd8ff02cc356725e876ae60766fb3559910..b7c177f248dcf633eb12c3d96068bd7b8792b104 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.263 1995/08/08 15:30:29 adams Exp $
+$Id: runtime.pkg,v 14.264 1995/09/11 19:05:39 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -584,6 +584,7 @@ MIT in each case. |#
          condition-type:floating-point-overflow
          condition-type:floating-point-underflow
          condition-type:illegal-datum
+         condition-type:illegal-pathname-component
          condition-type:no-such-restart
          condition-type:port-error
          condition-type:serious-condition
@@ -621,6 +622,7 @@ MIT in each case. |#
          error:derived-thread
          error:divide-by-zero
          error:file-operation
+         error:illegal-pathname-component
          error:no-such-restart
          error:wrong-number-of-arguments
          error:wrong-type-argument