Changeset 14618 in project


Ignore:
Timestamp:
05/13/09 15:31:32 (11 years ago)
Author:
felix winkelmann
Message:

types; check global assignment with predeclared type

Location:
chicken/branches/scrutiny
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/scrutiny/rules.make

    r14529 r14618  
    13371337
    13381338%.scrutiny1: $(SRCDIR)%.scm
    1339         $(XCHICKEN) $< $(CHICKEN_SCRUTINY_OPTIONS) $(CHICKEN_LIBRARY_OPTIONS)
    1340         touch $@
     1339        $(XCHICKEN) $< $(CHICKEN_SCRUTINY_OPTIONS) $(CHICKEN_LIBRARY_OPTIONS) >$@ 2>&1
    13411340
    13421341%.scrutiny2: $(SRCDIR)%.scm
    1343         $(XCHICKEN) $< $(CHICKEN_SCRUTINY_OPTIONS) $(CHICKEN_COMPILER_OPTIONS)
    1344         touch $@
     1342        $(XCHICKEN) $< $(CHICKEN_SCRUTINY_OPTIONS) $(CHICKEN_COMPILER_OPTIONS) >$@ 2>&1
  • chicken/branches/scrutiny/scrutinizer.scm

    r14564 r14618  
    117117    (cond ((##sys#get id '##core#type) =>
    118118           (lambda (a)
    119              (cond ((and (get db id 'assigned)
     119             (cond #;((and (get db id 'assigned)
    120120                         (not (##sys#get id '##core#declared-type)))
    121121                    (##sys#put! id '##core#type #f)
     
    129129          (else '*)))
    130130  (define (variable-result id e loc)
    131     (cond ((and (get db id 'assigned)
     131    (cond #;((and (get db id 'assigned)
    132132                (not (##sys#get id '##core#declared-type)) )
    133133           '*)
     
    135135           (lambda (a)
    136136             (cond ((eq? 'undefined (cdr a))
    137                     (pp (list a loc) (current-error-port))
    138137                    (report1
    139138                     loc
     
    314313                (and (match-args args1 args2)
    315314                     (match-results results1 results2))))
    316              ((struct) (equal? t1 t2))))))
     315             ((struct) (equal? t1 t2))
     316             (else #f) ) )
     317          (else #f)))
    317318  (define (match-args args1 args2)
    318319    (d "match-args: ~s <-> ~s" args1 args2)
     
    573574                              '(*)
    574575                              r)))))))
    575                ((set!)
     576               ((set! ##core#set!)
    576577                (let* ((var (first params))
     578                       (type (##sys#get var '##core#type))
    577579                       (rt (single
    578580                            (sprintf "in assignment to `~a'" var)
     
    580582                            loc))
    581583                       (b (assq var e)) )
     584                  (when (and type (not b)
     585                             (not (match type rt)))
     586                    (report1
     587                     loc
     588                     (sprintf
     589                      "assignment of value of type `~a' to toplevel variable `~a' does not match declared type `~a'"
     590                      rt var type)))
    582591                  (when (and b (eq? 'undefined (cdr b)))
    583592                    (set-cdr! b rt))
  • chicken/branches/scrutiny/types.db

    r14608 r14618  
    881881;; srfi-1
    882882
    883 #!eof
    884 
    885 (alist-cons (procedure alist-cons () *))
    886 (alist-copy (procedure alist-copy () *))
    887 (alist-delete (procedure alist-delete () *))
    888 (alist-delete! (procedure alist-delete! () *))
    889 (any (procedure any () *))
    890 (append! (procedure append! () *))
    891 (append-map (procedure append-map () *))
    892 (append-map! (procedure append-map! () *))
    893 (append-reverse (procedure append-reverse () *))
    894 (append-reverse! (procedure append-reverse! () *))
    895 (assoc (procedure assoc () *))
    896 (break (procedure break () *))
    897 (break! (procedure break! () *))
    898 (car+cdr (procedure car+cdr () *))
    899 (circular-list (procedure circular-list () *))
    900 (circular-list? (procedure circular-list? () *))
    901 (concatenate (procedure concatenate () *))
    902 (concatenate! (procedure concatenate! () *))
    903 (cons* (procedure cons* () *))
    904 (count (procedure count () *))
     883(alist-cons (procedure alist-cons (* * *) list))
     884(alist-copy (procedure alist-copy (list) list))
     885(alist-delete (procedure alist-delete (* list #!optional (procedure (* *) *)) list))
     886(alist-delete! (procedure alist-delete! (* list #!optional (procedure (* *) *)) undefined))
     887(any (procedure any ((procedure (*) *) list) *))
     888(append! (procedure append! (#!rest list) list))
     889(append-map (procedure append-map ((procedure (*) *) list #!rest list) pair))
     890(append-map! (procedure append-map! ((procedure (*) *) list #!rest list) pair))
     891(append-reverse (procedure append-reverse (list list) list))
     892(append-reverse! (procedure append-reverse! (list list) list))
     893(assoc (procedure assoc (* list) *))
     894(break (procedure break ((procedure (*) *) list) list list))
     895(break! (procedure break! ((procedure (*) *) list) list list))
     896(car+cdr (procedure car+cdr (pair) * *))
     897(circular-list (procedure circular-list (#!rest) list))
     898(circular-list? (procedure circular-list? (*) boolean))
     899(concatenate (procedure concatenate (list) list))
     900(concatenate! (procedure concatenate! (list) list))
     901(cons* (procedure cons* (* #!rest) pair))
     902(count (procedure count ((procedure (*) *) list #!rest list) number))
     903
     904#!eof
     905
    905906(delete (procedure delete () *))
    906907(delete! (procedure delete! () *))
Note: See TracChangeset for help on using the changeset viewer.