CMUCL commit: intl-branch src/code (pathname.lisp)

[Raymond Toy]

    Date: Tuesday, February 16, 2010 @ 00:17:34
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/code
     Tag: intl-branch

Modified: pathname.lisp

In PARSE-LOGICAL-NAMESTRING, don't try to translate the strings error
strings.  Move the translation to the labels function EXPECTING.
Otherwise, we get stuck in a loop trying to lookup the translation.
This is easily triggered with

(merge-pathnames "CLTEST:file-to-be-renamed.txt"
"CLTEST:file-to-be-renamed.txt")

where CLTEST is some valid logical host.  (This is from ansi-test
rename-file.5.)


---------------+
 pathname.lisp |   16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)


Index: src/code/pathname.lisp
diff -u src/code/pathname.lisp:1.89.2.2 src/code/pathname.lisp:1.89.2.3
--- src/code/pathname.lisp:1.89.2.2	Tue Feb  9 20:53:31 2010
+++ src/code/pathname.lisp	Tue Feb 16 00:17:34 2010
@@ -4,7 +4,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/code/pathname.lisp,v 1.89.2.2 2010-02-10 01:53:31 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/pathname.lisp,v 1.89.2.3 2010-02-16 05:17:34 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1865,7 +1865,7 @@
 		 (unless (and chunks (simple-string-p (caar chunks)))
 		   (error 'namestring-parse-error
 			  :complaint _"Expecting ~A, got ~:[nothing~;~:*~S~]."
-			  :arguments (list what (caar chunks))
+			  :arguments (list (intl:gettext what) (caar chunks))
 			  :namestring namestr
 			  :offset (if chunks (cdar chunks) end)))
 		 (caar chunks))
@@ -1873,7 +1873,7 @@
 		 (case (caadr chunks)
 		   (#\:
 		    (setq host
-			  (find-logical-host (expecting _"a host name" chunks)))
+			  (find-logical-host (expecting _N"a host name" chunks)))
 		    (parse-relative (cddr chunks)))
 		   (t
 		    (parse-relative chunks))))
@@ -1889,7 +1889,7 @@
 		 (case (caadr chunks)
 		   (#\;
 		    (directory
-		     (let ((res (expecting _"a directory name" chunks)))
+		     (let ((res (expecting _N"a directory name" chunks)))
 		       (cond ((string= res "..") :up)
 			     ((string= res "**") :wild-inferiors)
 			     (t
@@ -1899,14 +1899,14 @@
 		    (parse-name chunks))))
 	       (parse-name (chunks)
 		 (when chunks
-		   (expecting _"a file name" chunks)
+		   (expecting _N"a file name" chunks)
 		   (setq name (maybe-make-logical-pattern namestr chunks))
 		   (expecting-dot (cdr chunks))))
 	       (expecting-dot (chunks)
 		 (when chunks
 		   (unless (eql (caar chunks) #\.)
 		     (error 'namestring-parse-error
-			    :complaint _"Expecting a dot, got ~S."
+			    :complaint _N"Expecting a dot, got ~S."
 			    :arguments (list (caar chunks))
 			    :namestring namestr
 			    :offset (cdar chunks)))
@@ -1914,11 +1914,11 @@
 		       (parse-version (cdr chunks))
 		       (parse-type (cdr chunks)))))
 	       (parse-type (chunks)
-		 (expecting _"a file type" chunks)
+		 (expecting _N"a file type" chunks)
 		 (setq type (maybe-make-logical-pattern namestr chunks))
 		 (expecting-dot (cdr chunks)))
 	       (parse-version (chunks)
-		 (let ((str (expecting _"a positive integer, * or NEWEST"
+		 (let ((str (expecting _N"a positive integer, * or NEWEST"
 				       chunks)))
 		   (cond
 		    ((string= str "*") (setq version :wild))