Avoid invalid memory reference when 1st arg of path-build is ""

Author: Jarhmander

csug/io.stex

@@ -3887,6 +3887,7 @@ The preferred directory separator is \scheme{#\\} for Windows and
 
 Combines \var{dir-path} and \var{path}, adding a directory separator
 between them if needed.
+If \var{dir-path} is the empty string, \var{path} is returned.
 
 %----------------------------------------------------------------------------
 \entryheader

mats/6.ms

@@ -3332,6 +3332,7 @@
   (error? (path-last 'a/b/c))
   (error? (path-root 'a/b/c))
   (error? (path-extension 'a/b/c))
+  (error? (path-build 'a 'b))
 
   (eq? (path-absolute? "") #f)
   (eq? (path-absolute? "a") #f)
@@ -3409,6 +3410,20 @@
   (equal? (path-extension "c:..") "")
   (equal? (path-extension "c:") "")
 
+  (equal? (path-build "" "b.ss") "b.ss")
+  (if (windows?)
+      (equal? (path-build "." "b.ss") ".\\b.ss")
+      (equal? (path-build "." "b.ss") "./b.ss"))
+  (if (windows?)
+      (equal? (path-build ".\\" "b.ss") ".\\b.ss")
+      (equal? (path-build "./" "b.ss") "./b.ss"))
+  (if (windows?)
+      (equal? (path-build "foo" "b.ss") "foo\\b.ss")
+      (equal? (path-build "foo" "b.ss") "foo/b.ss"))
+  (if (windows?)
+      (equal? (path-build "quux\\" "b.ss") "quux\\b.ss")
+      (equal? (path-build "quux/" "b.ss") "quux/b.ss"))
+
  ; if this test fails, search for the asterisks in the printed table
   (let ([okay? #t])
     (define print-table

mats/root-experr-compile-0-f-f-f

@@ -7257,6 +7257,7 @@ cp0.mo:Expected error in mat expand/optimize-output: "expand/optimize-output: #<
 6.mo:Expected error in mat pathprocs: "path-last: a/b/c is not a string".
 6.mo:Expected error in mat pathprocs: "path-root: a/b/c is not a string".
 6.mo:Expected error in mat pathprocs: "path-extension: a/b/c is not a string".
+6.mo:Expected error in mat pathprocs: "path-build: a is not a string".
 6.mo:Expected error in mat process: "write-char: not permitted on closed port sanitized-port".
 6.mo:Expected error in mat process: "write-char: not permitted on closed port sanitized-port".
 6.mo:Expected error in mat process: "flush-output-port: not permitted on closed port sanitized-port".

s/6.ss

@@ -544,12 +544,12 @@
     (lambda (dir fn)
       (unless (string? dir) ($oops who "~s is not a string" dir))
       (unless (string? fn) ($oops who "~s is not a string" fn))
-      (format
-       (if (directory-separator?
-            (string-ref dir
-                        (fx- (string-length dir) 1)))
-           "~a~a"
-           (string-append "~a" (string (directory-separator)) "~a"))
-       dir fn)))
+      (cond
+        [(string=? dir "") fn]
+        [(directory-separator?
+           (string-ref dir
+                       (fx- (string-length dir) 1)))
+         (string-append dir fn)]
+        [else (string-append dir (string (directory-separator)) fn)])))
 )
 )

s/7.ss

@@ -112,7 +112,7 @@
             (if (null? ls)
                 ($oops whoarg "file ~s not found in source directories" fn)
                 (let ([path (let ([dir (car ls)])
-                              (if (or (string=? dir "") (string=? dir "."))
+                              (if (string=? dir ".")
                                   fn
                                   (path-build dir fn)))])
                   (if (guard (c [#t #f]) (close-input-port (open-input-file path)) #t)

s/read.ss

@@ -1731,7 +1731,7 @@
       (and (not (null? dir*))
            (or (source-port
                  (let ([dir (car dir*)])
-                   (if (or (string=? dir "") (string=? dir "."))
+                   (if (string=? dir ".")
                        name
                        (path-build dir name))))
                (search name (cdr dir*)))))

s/reboot.ss

@@ -145,7 +145,9 @@
  [else
   (define path-build
     (lambda (a b)
-      (let ([sep (if (eqv? (string-ref a (sub1 (string-length a))) #\/) "" "/")])
+      (let ([sep (if (or (string=? a "")
+                         (eqv? (string-ref a (sub1 (string-length a)))) #\/)
+                     "" "/")])
         (string-append a sep b))))])
 
 (let ([machine.def (path-build xc-dir "machine.def")])

s/syntax.ss

@@ -4787,7 +4787,7 @@
              e1 e2 ...)]))
       (define make-path
         (lambda (dir rpath ext)
-          (if (or (string=? dir "") (string=? dir "."))
+          (if (string=? dir ".")
               (format "~a~a" rpath ext)
               (path-build dir (format "~a~a" rpath ext)))))
       (let ([rpath (fold-left (lambda (dir elem) (path-build dir (symbol->string elem))) (symbol->string (car path)) (cdr path))])