From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 9 Mar 1998 04:32:56 +0000 (+0000)
Subject: Restrict parsing of device so that it requires a single letter.
X-Git-Tag: 20090517-FFI~4828
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4d40ff190c452e4f5645cae0a296caa4f017e35b;p=mit-scheme.git

Restrict parsing of device so that it requires a single letter.
---

diff --git a/v7/src/runtime/dospth.scm b/v7/src/runtime/dospth.scm
index 95cf9f32a..10bb8c588 100644
--- a/v7/src/runtime/dospth.scm
+++ b/v7/src/runtime/dospth.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: dospth.scm,v 1.37 1997/11/11 12:47:40 cph Exp $
+$Id: dospth.scm,v 1.38 1998/03/09 04:32:56 cph Exp $
 
-Copyright (c) 1992-97 Massachusetts Institute of Technology
+Copyright (c) 1992-98 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -147,9 +147,14 @@ MIT in each case. |#
     (let ((colon (string-find-next-char string #\:)))
       (if (not colon)
 	  (values #f components)
-	  (values (string-head string colon)
-		  (cons (string-tail string (+ colon 1))
-			(cdr components)))))))
+	  (begin
+	    (if (not (and (= colon 1)
+			  (char-alphabetic? (string-ref string 0))
+			  (= (string-length string) 2)))
+		(error "Device specification must be a single letter:" string))
+	    (values (string-head string colon)
+		    (cons (string-tail string (+ colon 1))
+			  (cdr components))))))))
 
 (define (simplify-directory directory)
   (cond ((and (eq? (car directory) 'RELATIVE) (null? (cdr directory))) #f)