Nausicaa oopp result on Sagittarius

patch.diff

diff --git a/lib/nausicaa/language/classes.sls b/lib/nausicaa/language/classes.s
index 5c82b39..e5f0a9c 100644
--- a/lib/nausicaa/language/classes.sls
+++ b/lib/nausicaa/language/classes.sls
@@ -1149,7 +1149,7 @@
                               ((??next-from ??next-to) (... ...))
                               (??mixin-spec (... ...))))))
          (_
-          (synner "invalid syntax"))
+          (synner "invalid syntax" stx))
          ))
     ))
 
diff --git a/lib/nausicaa/language/getenv.sagittarius.sls b/lib/nausicaa/languag
index 75d8bc4..e8518bf 100644
--- a/lib/nausicaa/language/getenv.sagittarius.sls
+++ b/lib/nausicaa/language/getenv.sagittarius.sls
@@ -27,6 +27,6 @@
 #!r6rs
 (library (nausicaa language getenv)
   (export getenv)
-  (import (only (rnrs) getenv)))
+  (import (only (sagittarius) getenv)))
 
 ;;; end of file

stest.log

cd tests ; make stest
make[1]: Entering directory `/home/takashi/projects/nausicaa-oopp/tests'

===> test file ./test-classes-binding-constructs.sps with Sagittarius Scheme

*** testing classes, tagged binding constructs

(catch-syntax-violation
  #f
  (%eval '(let (((a <n>) 1) (a 2)) a)))
 => #f
 ; *** failed ***
 ; expected result: a


(catch-syntax-violation
  #f
  (%eval '(let (((a <n>) 1) ((a <t>) 2)) a)))
 => #f
 ; *** failed ***
 ; expected result: a


(catch-syntax-violation
  #f
  (%eval '(let loop (((a <n>) 1) (a 2)) a)))
 => #f
 ; *** failed ***
 ; expected result: a


(catch-syntax-violation
  #f
  (%eval '(let loop (((a <n>) 1) ((a <t>) 2)) a)))
 => #f
 ; *** failed ***
 ; expected result: a


(catch-syntax-violation
  #f
  (%eval '(let-values (((a (a <n>)) (values 1 2))) a)))
 => ()
 ; *** failed ***
 ; expected result: a


(catch-syntax-violation
  #f
  (%eval '(let-values (((a) 1) ((a) 2)) a)))
 => ()
 ; *** failed ***
 ; expected result: a


(catch-syntax-violation
  #f
  (%eval '(let*-values (((a (a <n>)) (values 1 2))) a)))
 => ()
 ; *** failed ***
 ; expected result: a


; *** checks *** : 142 correct, 7 failed. First failed example:

(catch-syntax-violation
  #f
  (%eval '(let (((a <n>) 1) (a 2)) a)))
 => #f
 ; *** failed ***
 ; expected result: a




===> test file ./test-classes-builtin-labels.sps with Sagittarius Scheme

*** testing built-in labels

; *** checks *** : 90 correct, 0 failed.



===> test file ./test-classes-core.sps with Sagittarius Scheme

*** testing classes basics

(catch-assertion
  #f
  (let ()
    (define-class
      <beta>
      (fields a b c)
      (protocol 123))
    #f))
 => ((#<<record-type-descriptor> 0x6763da0>
  #<<record-constructor-descriptor> 0x21539a0>
  123))
 ; *** failed ***
 ; expected result: (123)


(catch-assertion
  #f
  (let ()
    (define-class
      <beta>
      (fields a b c)
      (protocol (lambda (make-top) 123)))
    #f))
 => #f
 ; *** failed ***
 ; expected result: (123)


; *** checks *** : 291 correct, 2 failed. First failed example:

(catch-assertion
  #f
  (let ()
    (define-class
      <beta>
      (fields a b c)
      (protocol 123))
    #f))
 => ((#<<record-type-descriptor> 0x6763da0>
  #<<record-constructor-descriptor> 0x21539a0>
  123))
 ; *** failed ***
 ; expected result: (123)




===> test file ./test-classes-generics.sps with Sagittarius Scheme

*** testing generic functions as class methods

; *** checks *** : 4 correct, 0 failed.



===> test file ./test-classes-label-core.sps with Sagittarius Scheme

*** testing class labels

; *** checks *** : 19 correct, 0 failed.



===> test file ./test-classes-labels-and-interfaces.sps with Sagittarius Scheme

*** testing labels as interfaces

; *** checks *** : 4 correct, 0 failed.



===> test file ./test-classes-label-shadowing.sps with Sagittarius Scheme

*** testing label shadowing

; *** checks *** : 6 correct, 0 failed.



===> test file ./test-classes-mixins.sps with Sagittarius Scheme

*** testing class mixins

(catch-syntax-violation
  #f
  (%eval '(let () (define-mixin <alpha10>))))
 => #<unspecified>
 ; *** failed ***
 ; expected result: #f


; *** checks *** : 12 correct, 1 failed. First failed example:

(catch-syntax-violation
  #f
  (%eval '(let () (define-mixin <alpha10>))))
 => #<unspecified>
 ; *** failed ***
 ; expected result: #f




===> test file ./test-classes-setter-and-getter.sps with Sagittarius Scheme

*** testing classes setter and getter

; *** checks *** : 18 correct, 0 failed.



===> test file ./test-generics-ordinary.sps with Sagittarius Scheme

*** testing ordinary generic functions

(alpha (expt 12 12))
 => <fixnum>
 ; *** failed ***
 ; expected result: <integer>


; *** checks *** : 108 correct, 1 failed. First failed example:

(alpha (expt 12 12))
 => <fixnum>
 ; *** failed ***
 ; expected result: <integer>




===> test file ./test-generics-starred.sps with Sagittarius Scheme

*** testing starred generic functions

(alpha (expt 12 12))
 => <fixnum>
 ; *** failed ***
 ; expected result: <integer>


; *** checks *** : 50 correct, 1 failed. First failed example:

(alpha (expt 12 12))
 => <fixnum>
 ; *** failed ***
 ; expected result: <integer>




===> test file ./test-tags-core-classes.sps with Sagittarius Scheme

*** testing classes core features

; *** checks *** : 41 correct, 0 failed.



===> test file ./test-tags-core-labels.sps with Sagittarius Scheme

*** testing tags core features: labels

; *** checks *** : 69 correct, 0 failed.



===> test file ./test-tags-core-procedure.sps with Sagittarius Scheme

*** testing tags core features: <procedure> tag

; *** checks *** : 10 correct, 0 failed.



===> test file ./test-tags-core-top.sps with Sagittarius Scheme

*** testing tags core features: <top> tag

; *** checks *** : 17 correct, 0 failed.



===> test file ./test-tags-docs.sps with Sagittarius Scheme

*** testing tags features: documentation examples

; *** checks *** : 34 correct, 0 failed.



===> test file ./test-tags-helpers.sps with Sagittarius Scheme

*** testing tags helpers for expand

; *** checks *** : 133 correct, 0 failed.


make[1]: Leaving directory `/home/takashi/projects/nausicaa-oopp/tests'