From f4ca838155df32109c32d588ec8c66df64063e14 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 11 Sep 1995 19:07:16 +0000 Subject: [PATCH] Add new condition type ILLEGAL-PATHNAME-COMPONENT so that pathname parsing errors can be caught. --- v7/src/runtime/dospth.scm | 21 ++++++++++----------- v7/src/runtime/error.scm | 20 ++++++++++++++++++-- v7/src/runtime/runtime.pkg | 4 +++- v7/src/runtime/unxpth.scm | 20 ++++++++++---------- v8/src/runtime/runtime.pkg | 4 +++- 5 files changed, 44 insertions(+), 25 deletions(-) diff --git a/v7/src/runtime/dospth.scm b/v7/src/runtime/dospth.scm index c0572ad61..3f2163485 100644 --- 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")))) ;;;; 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 deb2200ba..700fe4fb6 100644 --- 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 7c53ff4a5..ad1dadf8e 100644 --- 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 63a85340e..cb4ae439f 100644 --- 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")))) ;;;; 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 52494dd8f..b7c177f24 100644 --- 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 -- 2.25.1