~ chicken-core (chicken-5) b62176798967c0503bf426b85c3b787ae08718b9


commit b62176798967c0503bf426b85c3b787ae08718b9
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Sun Jan 17 00:33:16 2010 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sun Jan 17 00:33:16 2010 +0100

    fix for signed number->string conversion (reported by Peter Danenberg)

diff --git a/manual/Acknowledgements b/manual/Acknowledgements
index 7dafb5e2..6f3c2b9d 100644
--- a/manual/Acknowledgements
+++ b/manual/Acknowledgements
@@ -10,37 +10,37 @@ Boucher, Terence Brannon, Roy Bryant, Adam Buchbinder, Hans Bulfone,
 Category 5, Taylor Campbell, Naruto Canada, Esteban U. Caamano Castro,
 Franklin Chen, Thomas Chust, Gian Paolo Ciceri, Fulvio Ciriaco, Tobia
 Conforto, John Cowan, Grzegorz Chrupa&#322;a, James Crippen, Tollef
-Fog Heen, Drew Hess, Alejandro Forero Cuervo, Linh Dang, Brian
-Denheyer, dgym, Don, Chris Double, Brown Dragon, Jarod Eells, Petter
-Egesund, Steve Elkins, Daniel B. Faken, Will Farr, Graham Fawcett,
-Marc Feeley, Fizzie, Matthew Flatt, Kimura Fuyuki, Tony Garnock-Jones,
-Martin Gasbichler, Abdulaziz Ghuloum, Joey Gibson, Stephen C. Gilardi,
-Mario Domenech Goulart, Joshua Griffith, Johannes Groedem, Damian
-Gryski, Andreas Gustafsson, Sven Hartrumpf, Jun-ichiro itojun Hagino,
-Ahdi Hargo, Matthias Heiler, Karl M. Hegbloom, William P. Heinemann,
-Bill Hoffman, Bruce Hoult, Hans Huebner, Markus Huelsmann, Goetz
-Isenmann, Paulo Jabardo, Wietse Jacobs, David Janssens, Christian
-Jaeger, Matt Jones, Dale Jordan, Valentin Kamyshenko, Daishi Kato,
-Peter Keller, Brad Kind, Ron Kneusel, Matthias Koeppe, Krysztof
-Kowa&#322;czyk, Andre Kuehne, Todd R. Kueny Sr, Goran Krampe, David
-Krentzlin, Ben Kurtz, Micky Latowicki, John Lenz, Kirill Lisovsky,
-Juergen Lorenz, Kon Lovett, Lam Luu, Leonardo Valeri Manera, Dennis
-Marti, Charles Martin, Bob McIsaac, Alain Mellan, Eric Merrit, Perry
-Metzger, Scott G. Miller, Mikael, Bruce Mitchener, Fadi Moukayed,
-Chris Moline, Eric E. Moore, Julian Morrison, Dan Muresan, David
-N. Murray, Lars Nilsson, Ian Oversby, o.t., Gene Pavlovsky, Levi
-Pearson, Nicolas Pelletier, Derrell Piper, Carlos Pita, Robin Lee
-Powell, Pupeno, Davide Puricelli, presto, Doug Quale, Eric Raible,
-Ivan Raikov, Joel Reymont, Eric Rochester, Andreas Rottman, David
-Rush, Lars Rustemeier, Daniel Sadilek, Oskar Schirmer, Burton
-Samograd, Reed Sheridan, Ronald Schroeder, Spencer Schumann, Ivan
-Shcheklein, Alex Shinn, Ivan Shmakov, Shmul, Tony Sidaway, Jeffrey
-B. Siegal, Andrey Sidorenko, Michele Simionato, Volker Stolz, Jon
-Strait, Dorai Sitaram, Robert Skeels, Jason Songhurst, Clifford Stein,
-Sunnan, Zbigniew Szadkowski, Rick Taube, Nathan Thern, Mike Thomas,
-Minh Thu, Christian Tismer, Andre van Tonder, John Tobey, Henrik
-Tramberend, Vladimir Tsichevsky, Neil van Dyke, Sam Varner, Taylor
-Venable, Sander Vesik, Jaques Vidrine, Panagiotis Vossos, Shawn
+Fog Heen, Drew Hess, Alejandro Forero Cuervo, Peter Danenberg, Linh
+Dang, Brian Denheyer, dgym, Don, Chris Double, Brown Dragon, Jarod
+Eells, Petter Egesund, Steve Elkins, Daniel B. Faken, Will Farr,
+Graham Fawcett, Marc Feeley, Fizzie, Matthew Flatt, Kimura Fuyuki,
+Tony Garnock-Jones, Martin Gasbichler, Abdulaziz Ghuloum, Joey Gibson,
+Stephen C. Gilardi, Mario Domenech Goulart, Joshua Griffith, Johannes
+Groedem, Damian Gryski, Andreas Gustafsson, Sven Hartrumpf, Jun-ichiro
+itojun Hagino, Ahdi Hargo, Matthias Heiler, Karl M. Hegbloom, William
+P. Heinemann, Bill Hoffman, Bruce Hoult, Hans Huebner, Markus
+Huelsmann, Goetz Isenmann, Paulo Jabardo, Wietse Jacobs, David
+Janssens, Christian Jaeger, Matt Jones, Dale Jordan, Valentin
+Kamyshenko, Daishi Kato, Peter Keller, Brad Kind, Ron Kneusel,
+Matthias Koeppe, Krysztof Kowa&#322;czyk, Andre Kuehne, Todd R. Kueny
+Sr, Goran Krampe, David Krentzlin, Ben Kurtz, Micky Latowicki, John
+Lenz, Kirill Lisovsky, Juergen Lorenz, Kon Lovett, Lam Luu, Leonardo
+Valeri Manera, Dennis Marti, Charles Martin, Bob McIsaac, Alain
+Mellan, Eric Merrit, Perry Metzger, Scott G. Miller, Mikael, Bruce
+Mitchener, Fadi Moukayed, Chris Moline, Eric E. Moore, Julian
+Morrison, Dan Muresan, David N. Murray, Lars Nilsson, Ian Oversby,
+o.t., Gene Pavlovsky, Levi Pearson, Nicolas Pelletier, Derrell Piper,
+Carlos Pita, Robin Lee Powell, Pupeno, Davide Puricelli, presto, Doug
+Quale, Eric Raible, Ivan Raikov, Joel Reymont, Eric Rochester, Andreas
+Rottman, David Rush, Lars Rustemeier, Daniel Sadilek, Oskar Schirmer,
+Burton Samograd, Reed Sheridan, Ronald Schroeder, Spencer Schumann,
+Ivan Shcheklein, Alex Shinn, Ivan Shmakov, Shmul, Tony Sidaway,
+Jeffrey B. Siegal, Andrey Sidorenko, Michele Simionato, Volker Stolz,
+Jon Strait, Dorai Sitaram, Robert Skeels, Jason Songhurst, Clifford
+Stein, Sunnan, Zbigniew Szadkowski, Rick Taube, Nathan Thern, Mike
+Thomas, Minh Thu, Christian Tismer, Andre van Tonder, John Tobey,
+Henrik Tramberend, Vladimir Tsichevsky, Neil van Dyke, Sam Varner,
+Taylor Venable, Sander Vesik, Jaques Vidrine, Panagiotis Vossos, Shawn
 Wagner, Peter Wang, Ed Watkeys, Brad Watson, Thomas Weidner, Goeran
 Weinholt, Matthew Welland, Drake Wilson, Joerg Wittenberger, Peter
 Wright, Mark Wutka, Richard Zidlicky and Houman Zolfaghari for
diff --git a/runtime.c b/runtime.c
index 1adf53a9..b2eeee75 100644
--- a/runtime.c
+++ b/runtime.c
@@ -7235,8 +7235,8 @@ static char *to_binary(C_uword num)
 {
   char *p;
 
-  buffer[ 65 ] = '\0';
-  p = buffer + 65;
+  buffer[ 66 ] = '\0';
+  p = buffer + 66;
   
   do {
     *(--p) = (num & 1) ? '1' : '0';
@@ -7253,6 +7253,7 @@ void C_ccall C_number_to_string(C_word c, C_word closure, C_word k, C_word num,
   C_char *p;
   double f;
   va_list v;
+  int neg = 0;
 
   if(c == 3) radix = 10;
   else if(c == 4) {
@@ -7268,20 +7269,26 @@ void C_ccall C_number_to_string(C_word c, C_word closure, C_word k, C_word num,
   if(num & C_FIXNUM_BIT) {
     num = C_unfix(num);
 
+    if(num < 0) {
+      neg = 1;
+      num = -num;
+    }
+
     switch(radix) {
     case 2:
       p = to_binary(num);
       break;
      
 #ifdef C_SIXTY_FOUR
-    case 8: C_sprintf(p = buffer, C_text("%lo"), num); break;
-    case 10: C_sprintf(p = buffer, C_text("%ld"), num); break;
-    case 16: C_sprintf(p = buffer, C_text("%lx"), num); break;
+    case 8: C_sprintf(p = buffer + 1, C_text("%lo"), num); break;
+    case 10: C_sprintf(p = buffer + 1, C_text("%ld"), num); break;
+    case 16: C_sprintf(p = buffer + 1, C_text("%lx"), num); break;
 #else
-    case 8: C_sprintf(p = buffer, C_text("%o"), num); break;
-    case 10: C_sprintf(p = buffer, C_text("%d"), num); break;
-    case 16: C_sprintf(p = buffer, C_text("%x"), num); break;
+    case 8: C_sprintf(p = buffer + 1, C_text("%o"), num); break;
+    case 10: C_sprintf(p = buffer + 1, C_text("%d"), num); break;
+    case 16: C_sprintf(p = buffer + 1, C_text("%x"), num); break;
 #endif
+
     default: barf(C_BAD_ARGUMENT_TYPE_ERROR, "number->string", C_fix(radix));
     }
   }
@@ -7289,6 +7296,11 @@ void C_ccall C_number_to_string(C_word c, C_word closure, C_word k, C_word num,
     f = C_flonum_magnitude(num);
 
     if(C_fits_in_unsigned_int_p(num) == C_SCHEME_TRUE) {
+      if(f < 0) {
+	neg = 1;
+	f = -f;
+      }
+
       switch(radix) {
       case 2:
 	p = to_binary((unsigned int)f);
@@ -7334,11 +7346,13 @@ void C_ccall C_number_to_string(C_word c, C_word closure, C_word k, C_word num,
   else
     barf(C_BAD_ARGUMENT_TYPE_ERROR, "number->string", num);
 
-  fini:
-    radix = C_strlen(p);
-    a = C_alloc((C_bytestowords(radix) + 1));
-    radix = C_string(&a, radix, p);
-    C_kontinue(k, radix);
+ fini:
+  if(neg) *(--p) = '-';
+
+  radix = C_strlen(p);
+  a = C_alloc((C_bytestowords(radix) + 1));
+  radix = C_string(&a, radix, p);
+  C_kontinue(k, radix);
 }
 
 
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index 4c5509fa..ec59bf60 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -19,6 +19,22 @@
 (assert (not (rational? 'foo)))
 
 
+;; number->string conversion
+
+(for-each
+ (lambda (x)
+   (let ((number (car x))
+	 (radix (cadr x)))
+     (assert (eqv? number (string->number (number->string number radix) radix)))))
+ '((123 10)
+   (123 2)
+   (123 8)
+   (-123 10)
+   (-123 2)
+   (-123 8)
+   (99.2 10)
+   (-99.2 10)))
+
 ;; fp-math
 
 (assert (= (sin 42.0) (fpsin 42.0)))
Trap