Changeset 14829 in project


Ignore:
Timestamp:
05/29/09 15:52:46 (10 years ago)
Author:
felix winkelmann
Message:

scrutiny-related fixes

Location:
chicken/trunk
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/defaults.make

    r14828 r14829  
    105105INSTALL_PROGRAM ?= xcopy
    106106MAKEDIR_COMMAND ?= -mkdir
    107 XHERE ?=
    108107else
    109108INSTALL_PROGRAM ?= install
    110109MAKEDIR_COMMAND ?= mkdir
    111 XHERE ?= $(SRCDIR)scripts/xhere
    112110endif
    113111POSTINSTALL_STATIC_LIBRARY ?= true
     
    275273
    276274CHICKEN ?= chicken$(EXE)
    277 XCHICKEN ?= $(XHERE) $(CHICKEN)
    278275
    279276# interpreter for scripts
  • chicken/trunk/extras.scm

    r14507 r14829  
    237237
    238238(define-constant read-string-buffer-size 2048)
     239
    239240(define ##sys#read-string/port
    240241  (let ((open-output-string open-output-string)
  • chicken/trunk/rules.make

    r14828 r14829  
    13371337
    13381338%.scrutiny1: $(SRCDIR)%.scm
    1339         $(XCHICKEN) $< $(CHICKEN_SCRUTINY_OPTIONS) $(CHICKEN_LIBRARY_OPTIONS) 2>&1 | tee $@
     1339        $(CHICKEN) $< $(CHICKEN_SCRUTINY_OPTIONS) $(CHICKEN_LIBRARY_OPTIONS) 2>&1 | tee $@
    13401340
    13411341%.scrutiny2: $(SRCDIR)%.scm
    1342         $(XCHICKEN) $< $(CHICKEN_SCRUTINY_OPTIONS) $(CHICKEN_COMPILER_OPTIONS) 2>&1 | tee $@
     1342        $(CHICKEN) $< $(CHICKEN_SCRUTINY_OPTIONS) $(CHICKEN_COMPILER_OPTIONS) 2>&1 | tee $@
    13431343
    13441344scrutiny-clean:
  • chicken/trunk/scrutinizer.scm

    r14828 r14829  
    464464       (fragment x)
    465465       (if (and (pair? params) (pair? (cdr params)))
    466            (sprintf " (line ~a)" (source-info->line (cadr params)))
     466           (let ((n (source-info->line (cadr params))))
     467             (if (number? n)
     468                 (sprintf " (line ~a)" n)
     469                 ""))
    467470           "")))
    468471    (d "call-result: ~a (~a)" args loc)
     
    553556             (case class
    554557               ((quote) (list (constant-result (first params))))
    555                ((##core#undefined) '(undefined))
     558               ((##core#undefined) '(*))
    556559               ((##core#proc) '(procedure))
    557560               ((##core#global-ref) (global-result (first params) loc))
  • chicken/trunk/tests/scrutiny-tests.scm

    r14828 r14829  
    33
    44(pp (current-environment))
    5 
    6 (let ((a (##core#undefined)))
    7   (print a))
    85
    96(define (a)
  • chicken/trunk/tests/scrutiny.expected

    r14828 r14829  
    22Warning: at toplevel:
    33  use of deprecated toplevel identifier `current-environment'
    4 
    5 Warning: at toplevel:
    6   access to variable `a' which has an undefined value
    74
    85Warning: in local procedure `c',
     
    118  expected value of type boolean in conditional but were given a value of type `number' which is always true:
    129
    13 (if x13 '1 '2)
     10(if x10 '1 '2)
    1411
    1512Warning: in toplevel procedure `foo':
    1613  branches in conditional expression differ in the number of results:
    1714
    18 (if x17 (values '1 '2) (values '1 '2 (+ ...)))
     15(if x14 (values '1 '2) (values '1 '2 (+ ...)))
    1916
    2017Warning: at toplevel:
    21   expected argument #2 of type `number' in procedure call to `bar20' (line 21), but where given an argument of type `symbol'
     18  expected argument #2 of type `number' in procedure call to `bar17' (line 18), but where given an argument of type `symbol'
    2219
    2320Warning: at toplevel:
    24   expected in procedure call to `pp' (line 23) 1 argument, but where given 0 arguments
     21  expected in procedure call to `pp' (line 20) 1 argument, but where given 0 arguments
    2522
    2623Warning: at toplevel:
     
    3128
    3229Warning: at toplevel:
    33   expected in procedure call to `x26' (line 29) a value of type `(procedure () *)', but were given a value of type `fixnum'
     30  expected in procedure call to `x23' (line 26) a value of type `(procedure () *)', but were given a value of type `fixnum'
    3431
    3532Warning: at toplevel:
    36   expected argument #1 of type `number' in procedure call to `+' (line 31), but where given an argument of type `symbol'
     33  expected argument #1 of type `number' in procedure call to `+' (line 28), but where given an argument of type `symbol'
    3734
    3835Warning: at toplevel:
    39   expected argument #2 of type `number' in procedure call to `+' (line 31), but where given an argument of type `symbol'
     36  expected argument #2 of type `number' in procedure call to `+' (line 28), but where given an argument of type `symbol'
    4037
    4138Warning: at toplevel:
  • chicken/trunk/types.db

    r14828 r14829  
    273273(feature? (procedure feature? (symbol) boolean))
    274274(features (procedure features () list))
    275 (file-exists? (procedure file-exists? (string) boolean))
     275(file-exists? (procedure file-exists? (string) *))
    276276(fixnum-bits fixnum)
    277277(fixnum-precision fixnum)
     
    480480(read-line (procedure read-line (#!optional port fixnum) *))
    481481(read-lines (procedure read-lines (#!optional port fixnum) list))
    482 (read-string (procedure read-string (#!optional fixnum port) string))
    483 (read-string! (procedure read-string! (fixnum string #!optional port fixnum) undefined))
     482(read-string (procedure read-string (#!optional * port) string))
     483(read-string! (procedure read-string! (fixnum string #!optional port fixnum) fixnum))
    484484(read-token (procedure read-token ((procedure (char) *) #!optional port) string))
    485485(sprintf (procedure sprintf (string #!rest) string))
    486486(write-byte (procedure write-byte (fixnum #!optional port) undefined))
    487487(write-line (procedure write-line (string #!optional port) undefined))
    488 (write-string (procedure write-string (string #!optional fixnum port) undefined))
     488(write-string (procedure write-string (string #!optional * port) undefined))
    489489
    490490;; files
     
    614614(call-with-input-string (procedure call-with-input-string (string (procedure (port) . *)) . *))
    615615(call-with-output-string (procedure call-with-output-string ((procedure (port) . *)) string))
    616 (make-input-port (procedure make-input-port ((procedure () char) (procedure () *) (procedure () . *) #!optional (procedure (port) *) (procedure (port fixnum fixnum fixnum) . *) (procedure (port fixnum) string)) port))
     616(make-input-port (procedure make-input-port ((procedure () char) (procedure () *) (procedure () . *) #!optional * * *) port))
    617617(make-output-port (procedure make-output-port ((procedure (string) . *) (procedure () . *) (procedure () . *)) port))
    618618(port-for-each (procedure port-for-each ((procedure (*) *) (procedure () . *)) undefined))
    619619(port-map (procedure port-map ((procedure (*) *) (procedure () . *)) list))
    620 (port-fold (procedure port-fold ((procedure (* *) *) (procedure () *)) *))
     620(port-fold (procedure port-fold ((procedure (* *) *) * (procedure () *)) *))
    621621(make-broadcast-port (procedure make-broadcast-port (#!rest port) port))
    622622(make-concatenated-port (procedure make-concatenated-port (port #!rest port) port))
     
    717717(file-permissions (procedure file-permissions (string) fixnum))
    718718(file-position (procedure file-position (string) fixnum))
    719 (file-read (procedure file-read (fixnum fixnum #!optional *) * fixnum))
     719(file-read (procedure file-read (fixnum fixnum #!optional *) list))
    720720(file-read-access? (procedure file-read-access? (string) boolean))
    721721(file-select (procedure file-select (list list #!optional fixnum) list list))
     
    841841(signal/xfsz fixnum)
    842842(signals-list list)
    843 (sleep (procedure sleep (fixnum) undefined))
     843(sleep (procedure sleep (fixnum) fixnum))
    844844(stat-block-device? (procedure stat-block-device? (string) boolean))
    845845(stat-char-device? (procedure stat-char-device? (string) boolean))
     
    871871(regexp-escape (procedure regexp-escape (string) string))
    872872(regexp? (procedure regexp? (*) boolean))
    873 (string-match (procedure string-match (* string) list))
     873(string-match (procedure string-match (* string) *))
    874874(string-match-positions (procedure string-match-positions (* string) *))
    875875(string-search (procedure string-search (* string #!optional fixnum fixnum) *))
     
    885885(alist-delete (procedure alist-delete (* list #!optional (procedure (* *) *)) list))
    886886(alist-delete! (procedure alist-delete! (* list #!optional (procedure (* *) *)) undefined))
    887 (any (procedure any ((procedure (*) *) list) *))
     887(any (procedure any ((procedure (*) *) list #!rest list) *))
    888888(append! (procedure append! (#!rest list) list))
    889889(append-map (procedure append-map ((procedure (#!rest) *) list #!rest list) pair))
     
    911911(drop-while (procedure drop-while ((procedure (*) *) list) list))
    912912(eighth (procedure eighth (pair) *))
    913 (every (procedure every ((procedure (*) *) list) *))
     913(every (procedure every ((procedure (*) *) list #!rest list) *))
    914914(fifth (procedure fifth (pair) *))
    915915(filter (procedure filter ((procedure (*) *) list) list))
     
    919919(find-tail (procedure find-tail ((procedure (*) *) list) *))
    920920(first (procedure first (pair) *))
    921 (fold (procedure fold ((procedure (* *) *) * #!rest list) *))
    922 (fold-right (procedure fold-right ((procedure (* *) *) #!rest list) *))
     921(fold (procedure fold ((procedure (* #!rest) *) * #!rest list) *))
     922(fold-right (procedure fold-right ((procedure (* #!rest) *) * #!rest list) *))
    923923(fourth (procedure fourth (pair) *))
    924924(iota (procedure iota (fixnum #!optional fixnum fixnum) list))
     
    987987
    988988(check-substring-spec (procedure check-substring-spec (* string fixnum fixnum) undefined))
    989 (kmp-step (procedure kmp-step (string vector char fixnum fixnum) fixnum))
     989(kmp-step (procedure kmp-step (string vector char fixnum (procedure (char char) *) fixnum) fixnum))
    990990(make-kmp-restart-vector (procedure make-kmp-restart-vector (string #!optional (procedure (* *) *) fixnum fixnum) vector))
    991991(string->list (procedure string->list (string) list))
     
    11031103(char-set-size (procedure char-set-size ((struct char-set)) fixnum))
    11041104(char-set-unfold (procedure char-set-unfold (procedure procedure procedure * #!optional (struct char-set)) (struct char-set)))
    1105 (char-set-unfold! (procedure char-set-unfold! () (procedure procedure procedure * #!optional (struct char-set)) (struct char-set)))
     1105(char-set-unfold! (procedure char-set-unfold! () (procedure procedure procedure * (struct char-set)) (struct char-set)))
    11061106(char-set-union (procedure char-set-union (#!rest (struct char-set)) (struct char-set)))
    11071107(char-set-union! (procedure char-set-union! (#!rest (struct char-set)) (struct char-set)))
     
    11211121(char-set:printing (struct char-set))
    11221122(char-set:punctuation (struct char-set))
    1123 (char-set:s (struct char-set))
     1123(char-set:s (procedure (struct char-set) *))
    11241124(char-set:symbol (struct char-set))
    11251125(char-set:title-case (struct char-set))
     
    11341134(string->char-set (procedure string->char-set (string #!optional (struct char-set)) (struct char-set)))
    11351135(string->char-set! (procedure string->char-set! (string #!optional (struct char-set)) (struct char-set)))
    1136 (ucs-range->char-set (procedure ucs-range->char-set (fixnum fixnum #!optional (struct char-set)) (struct char-set)))
    1137 (ucs-range->char-set! (procedure ucs-range->char-set! (fixnum fixnum #!optional (struct char-set)) (struct char-set)))
     1136(ucs-range->char-set (procedure ucs-range->char-set (fixnum fixnum #!optional * (struct char-set)) (struct char-set)))
     1137(ucs-range->char-set! (procedure ucs-range->char-set! (fixnum fixnum #!optional * (struct char-set)) (struct char-set)))
    11381138
    11391139;; srfi-18
Note: See TracChangeset for help on using the changeset viewer.