- fix bug in unit test script

- change print format of forced-compiled-promises
- fix some warnings



git-svn-id: svn://localhost/root/svnrepo/trunk@11 bee25f81-8ba7-4b93-944d-dfac3d1a11cc

src/cell.cpp

@@ -390,11 +390,15 @@ cellvector * Cell::CProcValue () const
     typecheck(Cproc); return cd.cv;
     }
 
-Cell * Cell::PromiseValue () const
-    {
-    typecheck (Promise);
-    return cd.cv->get (0);
-    }
+Cell* Cell::PromiseValue () const {
+  typecheck (Promise);
+  return cd.cv->get (0);
+}
+
+Cell* Cell::CPromiseValue() const {
+  typecheck(Cpromise);
+  return cd.cv->get(0);
+}
 
 psymbol Cell::BuiltinValue () const
     {

src/io.cpp

@@ -535,9 +535,10 @@ void Cell::write (sstring& ss) const {
         ss.append("#<compiled-procedure>");
         break;
       case Cpromise:
-        ss.append(flag(FORCED)
-                  ? "#<forced-compiled-promise>"
-                  : "#<compiled-promise>");
+        if (flag(FORCED))
+	  CPromiseValue()->write(ss);
+	else
+	  ss.append("#<compiled-promise>");
         break;
       case Insn:
         ss.append("#<vm-instruction>");

src/vm.cpp

@@ -290,7 +290,7 @@ Cell* Context::execute (Cell* proc, Cell* args) {
       break;
     case 2: // subr
       if (!insn->flag(Cell::QUICK)) { 
-        Cell* subr = find_var(root_envt, insn->cd.y, 0);
+        Cell* const subr = find_var(root_envt, insn->cd.y, 0);
         if (!subr) error("missing primitive procedure");
 	Cell* proc = cdr(subr);
 	type = proc->type();
@@ -303,12 +303,12 @@ Cell* Context::execute (Cell* proc, Cell* args) {
           // re-push the args, and dispatch to the procedure.
           n_args = INSN_COUNT(insn);
           cellvector cv;
-          for (int ix = 0; ix < n_args; ++ix) 
+          for (unsigned int ix = 0; ix < n_args; ++ix) 
             cv.push(m_stack.pop());
           save(r_envt);
           save(r_cproc);
           save(pc+1);
-          for (int ix = 0; ix < n_args; ++ix)
+          for (unsigned int ix = 0; ix < n_args; ++ix)
             m_stack.push(cv.pop());
           r_cproc = proc;
           goto PROC;

src/vx-scheme.h

@@ -415,39 +415,39 @@ public:
     // preallocate the string space; freeing this object discards
     // both box and string.
 
-    struct StringBox
-        {
-        size_t length;
-        char   s[1];
-        };
+    struct StringBox {
+      size_t length;
+      char s[1];
+    };
 
     // Value extractors
 
-    int          IntValue ()     const;
-    char         CharValue ()    const;
-    SubrBox *    SubrValue ()    const;
-    char *       StringValue ()  const;
-    size_t       StringLength () const;                 
-    FILE *       IportValue ()   const;
-    FILE *       OportValue ()   const;
-    void *       ContValue ()    const;
-    cellvector * VectorValue ()  const;
-    cellvector * CProcValue ()   const;
-    Cell *       PromiseValue () const;
-    psymbol      SymbolValue ()  const;
-    psymbol      BuiltinValue () const;
-    Procedure    LambdaValue ()  const;
-    double       RealValue ()    const;
-    const char * name ()         const;
+    int IntValue() const;
+    char CharValue() const;
+    SubrBox* SubrValue() const;
+    char* StringValue() const;
+    size_t StringLength() const;                 
+    FILE* IportValue() const;
+    FILE* OportValue() const;
+    void* ContValue() const;
+    cellvector* VectorValue() const;
+    cellvector* CProcValue() const;
+    Cell* PromiseValue() const;
+    Cell* CPromiseValue() const;
+    psymbol SymbolValue() const;
+    psymbol BuiltinValue() const;
+    Procedure LambdaValue() const;
+    double RealValue() const;
+    const char* name() const;
 
     // unsafe accessors: use when you have prior knowledge that the 
     // cell contains an atom of the proper type.
 
-    cellvector * unsafe_vector_value() const { 
+    cellvector* unsafe_vector_value() const { 
       return cd.cv;
     }
 
-    static void         real_to_string (double, char *, int);
+    static void real_to_string (double, char *, int);
 
     double asReal () const { 
       if (type () == Cell::Int)

testcases/c-good/r4rstest.good

@@ -744,7 +744,7 @@ SECTION(6 9)
 (delay (3 3))  ==> (3 3)
 (delay 2)  ==> 2
 (#<subr force> #<compiled-promise>)  ==> 6
-(#<subr force> #<forced-compiled-promise>)  ==> 6
+(#<subr force> 6)  ==> 6
 (force 3)  ==> 3
 
 errors were:

testcases/vx-test.scm

@@ -52,8 +52,7 @@
 	     (display (cdr result))
 	     (display " ")
 	     (set! total-time (+ total-time (cdr result))))
-	   (else
-	    (display "FAIL: ")))
+	   (display "FAIL: "))
        (display testcase)
        (newline)))
    testcases)