Description: <short summary of the patch>

 TODO: Put a short summary on the line above and replace this paragraph

 with a longer explanation of this change. Complete the meta-information

 with other relevant fields (see below for details). To make it easier, the

 information below has been extracted from the changelog. Adjust it or drop

 it.

 .

 gcl (2.6.12-45) unstable; urgency=high

 .

   * pathnames1.11

Author: Camm Maguire <camm@debian.org>

---

The information above should follow the Patch Tagging Guidelines, please

checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here

are templates for supplementary fields that you might want to add:

Origin: <vendor|upstream|other>, <url of original patch>

Bug: <url in upstream bugtracker>

Bug-Debian: https://bugs.debian.org/<bugnumber>

Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>

Forwarded: <no|not-needed|url proving that it has been forwarded>

Reviewed-By: <name and email of someone who approved the patch>

Last-Update: 2016-10-31

--- gcl-2.6.12.orig/cmpnew/gcl_lfun_list.lsp

+++ gcl-2.6.12/cmpnew/gcl_lfun_list.lsp

@@ -144,7 +144,7 @@

 (DEFSYSFUN 'SVREF "Lsvref" '(T T) 'T NIL NIL) 

 (DEFSYSFUN 'APPLY "Lapply" '(T T *) 'T NIL NIL) 

 (DEFSYSFUN 'DECODE-FLOAT "Ldecode_float" '(T) '(VALUES T T T) NIL NIL) 

-(DEFSYSFUN 'SUBST-IF-NOT "Lsubst_if_not" '(T T T *) 'T NIL NIL) 

+;(DEFSYSFUN 'SUBST-IF-NOT "Lsubst_if_not" '(T T T *) 'T NIL NIL)

 (DEFSYSFUN 'RPLACA "Lrplaca" '(T T) 'T NIL NIL) 

 (DEFSYSFUN 'SYMBOL-PLIST "Lsymbol_plist" '(T) 'T NIL NIL) 

 (DEFSYSFUN 'WRITE-STRING "Lwrite_string" '(T *) 'T NIL NIL) 

@@ -210,7 +210,7 @@

 (DEFSYSFUN 'NSUBLIS "Lnsublis" '(T T *) 'T NIL NIL) 

 (DEFSYSFUN 'CHAR-NOT-EQUAL "Lchar_not_equal" '(T *) 'T NIL T) 

 (DEFSYSFUN 'MACRO-FUNCTION "Lmacro_function" '(T) 'T NIL NIL) 

-(DEFSYSFUN 'SUBST-IF "Lsubst_if" '(T T T *) 'T NIL NIL) 

+;(DEFSYSFUN 'SUBST-IF "Lsubst_if" '(T T T *) 'T NIL NIL)

 (DEFSYSFUN 'COMPLEXP "Lcomplexp" '(T) 'T NIL T) 

 (DEFSYSFUN 'READ-LINE "Lread_line" '(*) '(VALUES T T) NIL NIL) 

 (DEFSYSFUN 'MAX "Lmax" '(T *) 'T NIL NIL) 

@@ -232,7 +232,7 @@

 (DEFSYSFUN 'FLOAT "Lfloat" '(T *) 'T NIL NIL) 

 ;(DEFSYSFUN 'FIRST "Lcar" '(T) 'T NIL NIL) 

 (DEFSYSFUN 'ROUND "Lround" '(T *) '(VALUES T T) NIL NIL) 

-(DEFSYSFUN 'SUBST "Lsubst" '(T T T *) 'T NIL NIL) 

+;(DEFSYSFUN 'SUBST "Lsubst" '(T T T *) 'T NIL NIL)

 (DEFSYSFUN 'UPPER-CASE-P "Lupper_case_p" '(T) 'T NIL T) 

 (DEFSYSFUN 'ARRAY-ELEMENT-TYPE "Larray_element_type" '(T) 'T NIL NIL) 

 (DEFSYSFUN 'ADJOIN "Ladjoin" '(T T *) 'T NIL NIL) 

--- gcl-2.6.12.orig/lsp/gcl_arraylib.lsp

+++ gcl-2.6.12/lsp/gcl_arraylib.lsp

@@ -262,8 +262,6 @@

 			  (static (staticp array))

                      &aux (fill-pointer (or fill-pointer (when (array-has-fill-pointer-p array) (fill-pointer array)))))

-  (declare (ignore element-type))

-

   (let ((x (if initial-contents-supplied-p

 	       (make-array new-dimensions

 		       :adjustable t

--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp

+++ gcl-2.6.12/lsp/gcl_iolib.lsp

@@ -80,7 +80,7 @@

      0 l)))

 (defun get-string-input-stream-index (stream &aux (s (c-stream-object0 stream)))

-  (+ (fill-pointer s) (multiple-value-bind (a b) (array-displacement s) b)))

+  (+ (fill-pointer s) (multiple-value-bind (a b) (array-displacement s) (declare (ignore a)) b)))

 (defmacro with-input-from-string ((var string &key index (start 0) end) . body)

   (declare (optimize (safety 1)))

@@ -457,10 +457,10 @@

 		      if-exists iesp if-does-not-exist idnesp external-format)))

     (when (typep s 'stream) (c-set-stream-object1 s pf) s)))

-(defun load-pathname-exists (z)

-  (or (probe-file z)

-      (when *allow-gzipped-file*

-	(when (probe-file (string-concatenate (namestring z) ".gz"))

+(defun load-pathname-exists (z &aux (z (link-expand (namestring z))))

+  (cond ((eq (stat z) :file) z)

+	(*allow-gzipped-file*

+	 (when (eq (stat (string-concatenate (namestring z) ".gz")) :file)

 	  z))))

 (defun load-pathname (p print if-does-not-exist external-format

--- gcl-2.6.12.orig/lsp/gcl_listlib.lsp

+++ gcl-2.6.12/lsp/gcl_listlib.lsp

@@ -180,3 +180,34 @@

 (defmacro nth-value (n expr)

   (declare (optimize (safety 1)))

   `(nth ,n (multiple-value-list ,expr)))

+

+(eval-when (compile eval)

+

+  (defmacro repl-if (tc) `(labels ((l (tr &aux (k (if kf (funcall kf tr) tr)))

+				       (cond (,tc n)

+					     ((atom tr) tr)

+					     ((let* ((ca (car tr))(a (l ca))(cd (cdr tr))(d (l cd)))

+						(if (and (eq a ca) (eq d cd)) tr (cons a d)))))))

+			     (declare (ftype (function (t) t) l))

+			     (l tr))))

+

+(defun subst (n o tr &key key test test-not

+		&aux (kf (when key (coerce key 'function)))

+		(tf (when test (coerce test 'function)))

+		(ntf (when test-not (coerce test-not 'function))))

+  (declare (optimize (safety 1)))

+  (check-type key (or null function))

+  (check-type test (or null function))

+  (check-type test-not (or null function))

+  (repl-if (cond (tf (funcall tf o k))(ntf (not (funcall ntf o k)))((eql o k)))))

+

+(defun subst-if (n p tr &key key &aux (kf (when key (coerce key 'function))))

+  (declare (optimize (safety 1)))

+  (check-type p function)

+  (check-type key (or null function))

+  (repl-if (funcall p k)))

+(defun subst-if-not (n p tr &key key &aux (kf (when key (coerce key 'function))))

+  (declare (optimize (safety 1)))

+  (check-type p function)

+  (check-type key (or null function))

+  (repl-if (not (funcall p k)))))

--- gcl-2.6.12.orig/lsp/gcl_truename.lsp

+++ gcl-2.6.12/lsp/gcl_truename.lsp

@@ -23,7 +23,8 @@

   (check-type pd pathname-designator)

   (when (wild-pathname-p ns)

     (error 'file-error :pathname pd :format-control "Pathname is wild"))

-  (let* ((ns (ensure-dir-string (link-expand ns)))(ppd (pathname ns)))

+  (let* ((ns (ensure-dir-string (link-expand ns)))

+	 (ppd (if (eq (namestring pd) ns) pd (pathname ns))))

     (unless (or (zerop (length ns)) (stat ns))

       (error 'file-error :pathname ns :format-control "Pathname does not exist"))

     (let* ((d (pathname-directory ppd))

--- gcl-2.6.12.orig/o/list.d

+++ gcl-2.6.12/o/list.d

@@ -528,26 +528,26 @@ object x;

 		vs_check_push(x);

 }

-/*

-	Subst(new, tree) pushes

-	the result of substituting new in tree

-	onto vs.

-*/

-static void

-subst(new, tree)

-object new, tree;

-{

-	cs_check(new);

-

-	if (TEST(tree))

-		vs_check_push(new);

-	else if (type_of(tree) == t_cons) {

-		subst(new, tree->c.c_car);

-		subst(new, tree->c.c_cdr);

-		stack_cons();

-	} else

-		vs_check_push(tree);

-}

+/* /\* */

+/* 	Subst(new, tree) pushes */

+/* 	the result of substituting new in tree */

+/* 	onto vs. */

+/* *\/ */

+/* static void */

+/* subst(new, tree) */

+/* object new, tree; */

+/* { */

+/* 	cs_check(new); */

+

+/* 	if (TEST(tree)) */

+/* 		vs_check_push(new); */

+/* 	else if (type_of(tree) == t_cons) { */

+/* 		subst(new, tree->c.c_car); */

+/* 		subst(new, tree->c.c_cdr); */

+/* 		stack_cons(); */

+/* 	} else */

+/* 		vs_check_push(tree); */

+/* } */

 /* static object */

 /* subst1(object new, object tree) { */

@@ -1153,25 +1153,25 @@ LFD(Lrplacd)()

 	vs_popp;

 }

-@(defun subst (new old tree &key test test_not key)

-	saveTEST;

-@

-	protectTEST;

-	setupTEST(old, test, test_not, key);

-	subst(new, tree);

-	tree = vs_pop;

-        /* if (kf==identity && */

-	/*     tf==test_eql && */

-	/*     (is_imm_fixnum(item_compared) || */

-	/*      ({enum type tp=type_of(item_compared);tp>t_complex || tp

-	/*   tree=subst1qi(new,tree); */

-	/* else */

-	/*   tree=subst1(new,tree); */

-	restoreTEST;

-	@(return tree)

-@)

+/* @(defun subst (new old tree &key test test_not key) */

+/* 	saveTEST; */

+/* @ */

+/* 	protectTEST; */

+/* 	setupTEST(old, test, test_not, key); */

+/* 	subst(new, tree); */

+/* 	tree = vs_pop; */

+/*         /\* if (kf==identity && *\/ */

+/* 	/\*     tf==test_eql && *\/ */

+/* 	/\*     (is_imm_fixnum(item_compared) || *\/ */

+/* 	/\*      ({enum type tp=type_of(item_compared);tp>t_complex || tp

+/* 	/\*   tree=subst1qi(new,tree); *\/ */

+/* 	/\* else *\/ */

+/* 	/\*   tree=subst1(new,tree); *\/ */

+/* 	restoreTEST; */

+/* 	@(return tree) */

+/* @) */

-PREDICATE(Lsubst,Lsubst_if,Lsubst_if_not, 3)

+/* PREDICATE(Lsubst,Lsubst_if,Lsubst_if_not, 3) */

 @(defun nsubst (new old tree &key test test_not key)

@@ -1506,9 +1506,9 @@ gcl_init_list_function()

 	make_function("LDIFF", Lldiff);

 	make_function("RPLACA", Lrplaca);

 	make_function("RPLACD", Lrplacd);

-	make_function("SUBST", Lsubst);

-	make_function("SUBST-IF", Lsubst_if);

-	make_function("SUBST-IF-NOT", Lsubst_if_not);

+	/* make_function("SUBST", Lsubst); */

+	/* make_function("SUBST-IF", Lsubst_if); */

+	/* make_function("SUBST-IF-NOT", Lsubst_if_not); */

 	make_function("NSUBST", Lnsubst);

 	make_function("NSUBST-IF", Lnsubst_if);

 	make_function("NSUBST-IF-NOT", Lnsubst_if_not);