[nhc-bugs] A bug

Malcolm Wallace Malcolm.Wallace@cs.york.ac.uk
Mon, 11 Jun 2001 17:43:23 +0100


> main = mapM_ putStrLn [ "echo " ++ show x ++ " | a.out " | x <- [1..]]

> hPutStr: internal error, not a cons-list!
> hPutStr:   got CONSTRW src=0x401cc80c size=1
> hPutStr:     char=''

I have located and fixed this bug.  Patch appended, and also available
from the nhc98 website.

Regards,
    Malcolm


Index: src/runtime/Builtin/cHPutStr.c
===================================================================
RCS file: /usr/src/master/nhc/src/runtime/Builtin/cHPutStr.c,v
retrieving revision 1.5
diff -u -r1.5 cHPutStr.c
--- src/runtime/Builtin/cHPutStr.c	2001/02/07 18:15:06	1.5
+++ src/runtime/Builtin/cHPutStr.c	2001/06/11 16:38:31
@@ -93,9 +93,11 @@
             break;
       case 1: /* (:) */
             chr = GET_POINTER_ARG1(src,1);
+            C_PUSH(src);
             C_PUSH(chr);
             C_EVALTOS(chr);
             chr = C_POP();
+            src = C_POP();
             IND_REMOVE(chr);
             c = GET_CHAR_VALUE(chr);
             err = fputc(c,f->fp);
@@ -135,9 +137,11 @@
               break;
         case 1: /* (:) */
               chr = GET_POINTER_ARG1(src,1);
+              C_PUSH(src);
               C_PUSH(chr);
               C_EVALTOS(chr);
               chr = C_POP();
+              src = C_POP();
               IND_REMOVE(chr);
               *dstptr = GET_CHAR_VALUE(chr);
               switch (*dstptr++) {
@@ -203,9 +207,11 @@
               break;
         case 1: /* (:) */
               chr = GET_POINTER_ARG1(src,1);
+              C_PUSH(src);
               C_PUSH(chr);
               C_EVALTOS(chr);
               chr = C_POP();
+              src = C_POP();
               IND_REMOVE(chr);
               *dstptr++ = GET_CHAR_VALUE(chr);
               src = GET_POINTER_ARG1(src,2);