[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Bugs in KCL affecting the XP pretty printing package.



There are four bugs in KCL which cause failure of the test cases of
Richard Waters' XP pretty printing package (which implements
one of the chapters of CLtL2).  This package is available for
anonymous ftp from wheaties.ai.mit.edu.  

  Richard Harris

------------------------------------------------------------
(1) (format nil "test~V%  test" nil) 
   is supposed to return:
"test
  test"
   but it gets an error.

*** c/format.c.~1~	Mon Mar 18 14:44:46 1991
--- c/format.c    Tue Mar 19 13:34:21 1991
***************
*** 204,215 ****
--- 204,217 ----
                          if (type_of(x) == t_fixnum) {
                                  fmt_param[n].fmt_param_type = INT;
                                  fmt_param[n].fmt_param_value = fix(x);
                          } else if (type_of(x) == t_character) {
                                  fmt_param[n].fmt_param_type = CHAR;
                                  fmt_param[n].fmt_param_value = x->ch.ch_code;
+                         } else if (x == Cnil) {
+                                 fmt_param[n].fmt_param_type = NULL;
                          } else
                                  fmt_error("illegal V parameter");
                          c = ctl_advance();
                          break;
  
                  case '#':
------------------------------------------------------------
(2) (let ((*print-case* :capitalize))(format nil "~A" 'foo-bar))
    is supposed to return:
"Foo-Bar"
    but it returns
"Foo-bar".

*** c/print.d.~1~ Mon Mar 18 14:45:08 1991
--- c/print.d     Tue Mar 19 17:36:35 1991
***************
*** 543,555 ****
  
  write_object(x, level)
  object x;
  int level;
  {
          object r, y;
!         int i, j, k;
          object *vp;
  
          cs_check(x);
  
          if (x == OBJNULL) {
                  write_str("#<OBJNULL>");
--- 543,555 ----
  
  write_object(x, level)
  object x;
  int level;
  {
          object r, y;
!         int i, j, k, lw;
          object *vp;
  
          cs_check(x);
  
          if (x == OBJNULL) {
                  write_str("#<OBJNULL>");
***************
*** 734,751 ****
                          break;
                  }
                  break;
  
          case t_symbol:
                  if (!PRINTescape) {
!                         for (i = 0;  i < x->s.s_fillp;  i++) {
                                  j = x->s.s_self[i];
!                                 if (isUpper(j) &&
!                                     (PRINTcase == Kdowncase ||
!                                      PRINTcase == Kcapitalize && i!=0))
                                          j += 'a' - 'A';
                                  write_ch(j);
                          }
                          break;
                  }
                  if (x->s.s_hpack == Cnil) {
                      if (PRINTcircle) {
--- 734,753 ----
                          break;
                  }
                  break;
  
          case t_symbol:
                  if (!PRINTescape) {
!                         for (lw = 0, i = 0;  i < x->s.s_fillp;  i++) {
                                  j = x->s.s_self[i];
!                                 if (isUpper(j)) {
!                                    if (PRINTcase == Kdowncase ||
!                                        PRINTcase == Kcapitalize && i!=lw)
                                          j += 'a' - 'A';
+                                 } else if (!isLower(j))
+                                         lw = i + 1;
                                  write_ch(j);
                          }
                          break;
                  }
                  if (x->s.s_hpack == Cnil) {
                      if (PRINTcircle) {
***************
*** 779,801 ****
                                      ->st.st_self[i];
                                  if (to_be_escaped(j))
                                          k++;
                          }
                          if (k > 0)
                                  write_ch('|');
!                         for (i = 0;
                               i < x->s.s_hpack->p.p_name->st.st_fillp;
                               i++) {
                                  j = x->s.s_hpack->p.p_name
                                      ->st.st_self[i];
                                  if (j == '|' || j == '\\')
                                          write_ch('\\');
!                                 if (k == 0 && isUpper(j) &&
!                                     (PRINTcase == Kdowncase ||
!                                      PRINTcase == Kcapitalize && i!=0))
!                                         j += 'a' - 'A';
                                  write_ch(j);
                          }
                          if (k > 0)
                                  write_ch('|');
                          if (find_symbol(x, x->s.s_hpack) != x)
                                  error("can't print symbol");
--- 781,807 ----
                                      ->st.st_self[i];
                                  if (to_be_escaped(j))
                                          k++;
                          }
                          if (k > 0)
                                  write_ch('|');
!                         for (lw = 0, i = 0;
                               i < x->s.s_hpack->p.p_name->st.st_fillp;
                               i++) {
                                  j = x->s.s_hpack->p.p_name
                                      ->st.st_self[i];
                                  if (j == '|' || j == '\\')
                                          write_ch('\\');
!                                 if (k == 0) {
!                                         if (isUpper(j)) {
!                                                 if (PRINTcase == Kdowncase ||
!                                                     PRINTcase == Kcapitalize && i!=lw)
!                                                 j += 'a' - 'A';
!                                         } else if (!isLower(j))
!                                                 lw = i + 1;
!                                 }
                                  write_ch(j);
                          }
                          if (k > 0)
                                  write_ch('|');
                          if (find_symbol(x, x->s.s_hpack) != x)
                                  error("can't print symbol");
***************
*** 819,838 ****
                                  goto NOT_DOT;
                  k++;
  
          NOT_DOT:                        
                  if (k > 0)
                          write_ch('|');
!                 for (i = 0;  i < x->s.s_fillp;  i++) {
                          j = x->s.s_self[i];
                          if (j == '|' || j == '\\')
                                  write_ch('\\');
!                         if (k == 0 && isUpper(j) &&
!                             (PRINTcase == Kdowncase ||
!                              PRINTcase == Kcapitalize && i != 0))
!                                 j += 'a' - 'A';
                          write_ch(j);
                  }
                  if (k > 0)
                          write_ch('|');
                  break;
  
--- 825,848 ----
                                  goto NOT_DOT;
                  k++;
  
          NOT_DOT:                        
                  if (k > 0)
                          write_ch('|');
!                 for (lw = 0, i = 0;  i < x->s.s_fillp;  i++) {
                          j = x->s.s_self[i];
                          if (j == '|' || j == '\\')
                                  write_ch('\\');
!                         if (k == 0) {
!                                 if (isUpper(j)) {
!                                         if (PRINTcase == Kdowncase ||
!                                             PRINTcase == Kcapitalize && i != lw)
!                                             j += 'a' - 'A';
!                                 } else if (!isLower(j))
!                                         lw = i + 1;
!                         }
                          write_ch(j);
                  }
                  if (k > 0)
                          write_ch('|');
                  break;
------------------------------------------------------------
(3) 'x and #'x print as 'X and #'X, even when *print-pretty* is nil.

*** c/print.d.~1~ Mon Mar 18 14:45:08 1991
--- c/print.d     Tue Mar 19 17:36:35 1991
***************
*** 1038,1049 ****
--- 1048,1060 ----
                                      write_ch('=');
                                      vp[1] = Ct;
                                      break;
                                  }
                              }
                  }
+                 if (PRINTpretty) {
                  if (x->c.c_car == Squote &&
                      type_of(x->c.c_cdr) == t_cons &&
                      x->c.c_cdr->c.c_cdr == Cnil) {
                          write_ch('\'');
                          write_object(x->c.c_cdr->c.c_car, level);
                          break;
***************
*** 1053,1064 ****
--- 1064,1076 ----
                      x->c.c_cdr->c.c_cdr == Cnil) {
                          write_ch('#');
                          write_ch('\'');
                          write_object(x->c.c_cdr->c.c_car, level);
                          break;
                  }
+                 }
                  if (PRINTlevel >= 0 && level >= PRINTlevel) {
                          write_ch('#');
                          break;
                  }
                  write_ch(MARK);
                  write_ch('(');
------------------------------------------------------------
(4) (read-from-string "#3A((() ()) (() ()))") returns NIL.

*** lsp/arraylib.lsp.~1~  Mon Mar 18 14:46:40 1991
--- lsp/arraylib.lsp      Tue Mar 19 14:36:20 1991
***************
*** 69,100 ****
                        (i 0 (1+ i)))
                       ((>= i n))
                     (declare (fixnum n i))
                     (si:aset x i (elt initial-contents i))))
             x))
          (t
-          (unless (member 0 dimensions)
           (let ((x
                  (apply #'si:make-pure-array
                         element-type adjustable 
                         displaced-to displaced-index-offset
                         static initial-element
                         dimensions)))
             (when initial-contents-supplied-p
                   (do ((cursor
                         (make-list (length dimensions)
                                    :initial-element 0)))
                       (nil)
                       (declare (:dynamic-extent cursor))
                     (aset-by-cursor x
                                     (sequence-cursor initial-contents
                                                      cursor)
                                     cursor)
                     (when (increment-cursor cursor dimensions)
!                          (return nil))))
!            x)))))
  
  
--- 69,100 ----
                        (i 0 (1+ i)))
                       ((>= i n))
                     (declare (fixnum n i))
                     (si:aset x i (elt initial-contents i))))
             x))
          (t
           (let ((x
                  (apply #'si:make-pure-array
                         element-type adjustable 
                         displaced-to displaced-index-offset
                         static initial-element
                         dimensions)))
+            (unless (member 0 dimensions)
             (when initial-contents-supplied-p
                   (do ((cursor
                         (make-list (length dimensions)
                                    :initial-element 0)))
                       (nil)
                       (declare (:dynamic-extent cursor))
                     (aset-by-cursor x
                                     (sequence-cursor initial-contents
                                                      cursor)
                                     cursor)
                     (when (increment-cursor cursor dimensions)
!                          (return nil)))))
!            x))))
  
  
------------------------------------------------------------