Changeset 14323 in project

04/21/09 09:12:38 (11 years ago)
felix winkelmann

warn if accessing undefined local, use real-name info for vars and line-number info for calls

1 edited


  • chicken/branches/scrutiny/scrutinizer.scm

    r14312 r14323  
    4949  perform-closure-conversion prepare-for-code-generation compiler-source-file create-foreign-stub expand-foreign-lambda*
    5050  transform-direct-lambdas! expand-foreign-callback-lambda* debug-lambda-list debug-variable-list debugging
    51   debugging-chicken bomb check-signature posq stringify symbolify build-lambda-list
     51  debugging-chicken bomb check-signature posq stringify symbolify build-lambda-list source-info->string
    5252  string->c-identifier c-ify-string words check-and-open-input-file close-checked-input-file fold-inner constant?
    5353  collapsable-literal? immediate? canonicalize-begin-body extract-mutable-constants string->expr get get-all
    121121                   (else (list a)))))
    122122          (else '*)))
    123   (define (variable-result id e)
     123  (define (variable-result id e loc)
    124124    (cond ((and (get db id 'assigned)
    125125                (not (##sys#get id '##core#declared-type)) )
    126126           '*)
    127127          ((assq id e) =>
    128            (lambda (a) (list (cdr a))))
     128           (lambda (a)
     129             (when (eq? 'undefined (cadr a))
     130               (report1
     131                loc
     132                (sprintf "access to variable `~a' which has an undefined value"
     133                         (real-name id db))))
     134             (list (cdr a))))
    129135          (else (global-result id))))
    130136  (define (always-true t loc x)
    332338                    x1)))
    333339            (else x))))
    334   (define (call-result args e loc x)
     340  (define (call-result args e loc x params)
    335341    (define (pname)
    336       (sprintf "in procedure call to `~s'" (fragment x)))
     342      (sprintf
     343       "in procedure call to `~s'~a"
     344       (fragment x)
     345       (if (and (pair? params) (pair? (cdr params)))
     346           (sprintf "(~a)" (source-info->string (cadr params)))
     347           "")))
    337348    (d "call-result: ~a (~a)" args loc)
    338349    (let ((ptype (car args))
    404415               ((##core#proc) '(procedure))
    405416               ((##core#global-ref) (global-result (first params)))
    406                ((##core#variable) (variable-result (first params) e))
     417               ((##core#variable) (variable-result (first params) e loc))
    407418               ((if) (let ((rt (single (walk (first subs) e loc dest) loc)))
    408419                       (always-true rt loc n)
    449460               ((##core#call)
    450461                (let ((args (map (lambda (n) (single (walk n e loc #f) loc)) subs)))
    451                   (call-result args e loc (first subs))))
     462                  (call-result args e loc (first subs) params)))
    452463               ((##core#switch ##core#cond)
    453464                (bomb "unexpected node class: ~a" class))
Note: See TracChangeset for help on using the changeset viewer.