Changeset 14800 in project


Ignore:
Timestamp:
05/27/09 00:37:38 (10 years ago)
Author:
felix winkelmann
Message:

tests and fixes

Location:
chicken/branches/scrutiny
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/scrutiny/scrutinizer.scm

    r14778 r14800  
    225225                                   (atypes2 (if name2 (third pt) (second pt)))
    226226                                   (rtypes2 (if name2 (cdddr pt) (cddr pt))))
    227                               `(procedure
    228                                 ,@(if (and name1 name2 (eq? name1 name2)) (list name1) '())
    229                                 ,(merge-argument-types atypes1 atypes2)
    230                                 ,@(merge-result-types rtypes1 rtypes2))))
     227                              (append
     228                               '(procedure)
     229                               (if (and name1 name2 (eq? name1 name2)) (list name1) '())
     230                               (list (merge-argument-types atypes1 atypes2))
     231                               (merge-result-types rtypes1 rtypes2))))
    231232                          #f
    232233                          (cdr t))))
     
    256257              (let* ((name (and (named? t) (cadr t)))
    257258                     (rtypes (if name (cdddr t) (cddr t))))
    258                 `(procedure
    259                   ,@(if name (list name) '())
    260                   ,(map simplify (if name (third t) (second t)))
    261                   ,@(if (eq? '* rtypes)
    262                         '*
    263                         (map simplify rtypes)))))
     259                (append
     260                 '(procedure)
     261                 (if name (list name) '())
     262                 (list (map simplify (if name (third t) (second t))))
     263                 (if (eq? '* rtypes)
     264                     '*
     265                     (map simplify rtypes)))))
    264266             (else t))
    265267           t))))
     
    295297    (cond ((null? ts1) ts2)
    296298          ((null? ts2) ts1)
     299          ((or (atom? ts1) (atom? ts2)) '*)
    297300          (else (cons (simplify `(or ,(car ts1) ,(car ts2)))
    298301                      (merge-result-types (cdr ts1) (cdr ts2))))))
  • chicken/branches/scrutiny/types.db

    r14744 r14800  
    191191(current-input-port (procedure current-input-port (#!optional port) port))
    192192(current-output-port (procedure current-output-port (#!optional port) port))
    193 (call-with-input-file (procedure call-with-input-file (string procedure) . *))
    194 (call-with-output-file (procedure call-with-output-file (string procedure) . *))
     193(call-with-input-file (procedure call-with-input-file (string (procedure (port) . *)) . *))
     194(call-with-output-file (procedure call-with-output-file (string (procedure (port) . *)) . *))
    195195(open-input-file (procedure open-input-file (string) port))
    196196(open-output-file (procedure open-output-file (string) port))
     
    460460(string-translate* (procedure string-translate* (string list) string))
    461461(substring-ci=? (procedure substring-ci=? (string string #!optional fixnum fixnum fixnum) boolean))
    462 (substring-index (procedure substring-index (string string #!optional fixnum) fixnum))
    463 (substring-index-ci (procedure substring-index-ci (string string #!optional fixnum) fixnum))
     462(substring-index (procedure substring-index (string string #!optional fixnum) *))
     463(substring-index-ci (procedure substring-index-ci (string string #!optional fixnum) *))
    464464(substring=? (procedure substring=? (string string #!optional fixnum fixnum fixnum) boolean))
    465465(tail? (procedure tail? (* *) boolean))
     
    612612;; ports
    613613
    614 (call-with-input-string (procedure call-with-input-string (string (procedure () . *)) . *))
    615 (call-with-output-string (procedure call-with-output-string ((procedure () . *)) string))
     614(call-with-input-string (procedure call-with-input-string (string (procedure (port) . *)) . *))
     615(call-with-output-string (procedure call-with-output-string ((procedure (port) . *)) string))
    616616(make-input-port (procedure make-input-port ((procedure () char) (procedure () *) (procedure () . *) #!optional (procedure (port) *) (procedure (port fixnum fixnum fixnum) . *) (procedure (port fixnum) string)) port))
    617617(make-output-port (procedure make-output-port ((procedure (string) . *) (procedure () . *) (procedure () . *)) port))
     
    10211021(string-for-each (procedure string-for-each ((procedure (char) . *) string #!optional fixnum fixnum) undefined))
    10221022(string-for-each-index (procedure string-for-each-index ((procedure (fixnum) . *) string #!optional fixnum fixnum) undefined))
    1023 (string-hash (procedure string-hash (string #!optional fixnum fixnum fixnum) number))
    1024 (string-hash-ci (procedure string-hash-ci (string #!optional fixnum fixnum fixnum) number))
    1025 (string-index (procedure string-index (string * #!optional fixnum fixnum) fixnum))
    1026 (string-index-right (procedure string-index-right (string * #!optional fixnum fixnum) fixnum))
     1023(string-index (procedure string-index (string * #!optional fixnum fixnum) *))
     1024(string-index-right (procedure string-index-right (string * #!optional fixnum fixnum) *))
    10271025(string-join (procedure string-join (list #!optional string symbol) string))
    10281026(string-kmp-partial-search (procedure string-kmp-partial-search (string vector string fixnum #!optional (procedure (char char) *) fixnum fixnum fixnum) fixnum))
     
    13381336(number-hash (procedure number-hash (fixnum #!optional fixnum) fixnum))
    13391337(object-uid-hash (procedure object-uid-hash (* #!optional fixnum) fixnum))
    1340 (string-ci-hash (procedure string-ci-hash (string #!optional fixnum) fixnum))
    1341 (string-hash (procedure string-hash (string #!optional fixnum) fixnum))
    13421338(symbol-hash (procedure symbol-hash (symbol #!optional fixnum) fixnum))
     1339(string-hash (procedure string-hash (string #!optional fixnum fixnum fixnum) number))
     1340(string-hash-ci (procedure string-hash-ci (string #!optional fixnum fixnum fixnum) number))
    13431341
    13441342;; tcp
Note: See TracChangeset for help on using the changeset viewer.