[racket-dev] Can't Find a Workaround for Bug 11017 in DrRacket

From: Doug Williams (m.douglas.williams at gmail.com)
Date: Sat Jul 24 21:41:04 EDT 2010

I downloaded the nightly build version
5.0.1.1--2010-07-23(57d3dd7df753abacc8642809216a873962204d4f/a) [3m] and the
error message is now:

..\..\..\..\..\..\..\..\..\Program
Files\Racket\collects\compiler\cm.rkt:94:26: cdr: expects argument of type
<pair>; given #<path:compiled>

and the backtrace is:

cdr: expects argument of type <pair>; given #<path:compiled>

C:\Program Files\Racket\collects\compiler\cm.rkt: 94:26
                            (delay (get-compiled-file-sha1 (get-zo-path))))]

C:\Program Files\Racket\collects\racket\private\promise.rkt: 103:10
            (lambda ()
            (let ([vs (call-with-values v list)]) (pset! promise vs) vs))))

C:\Program Files\Racket\collects\racket\private\more-scheme.rkt: 274:2
    (define (call-with-exception-handler exnh thunk)
    ;; The `begin0' ensures that we don't overwrite an enclosing
    ;;  exception handler.
    (begin0
     (with-continuation-mark
         exception-handler-key
         exnh
       (thunk))
     (void)))

C:\Program Files\Racket\collects\racket\private\promise.rkt: 95:0
  (define (force/generic promise)
  (reify-result
   (let ([v (pref promise)])
     (if (procedure? v)
       (begin
         (pset! promise (make-running (object-name v)))
         (call-with-exception-handler
          (lambda (e) (pset! promise (make-reraise e)) e)
          (lambda ()
            (let ([vs (call-with-values v list)]) (pset! promise vs) vs))))
       v))))

C:\Program Files\Racket\collects\compiler\cm.rkt: 212:23
                 [l (map (lambda (v)
                         (let ([sha1 (force (car v))]
                               [dep (cdr v)])
                           (unless sha1
                             (error 'cm "no SHA-1 for dependency: ~s" dep))
                           (cons sha1 dep)))

C:\Program Files\Racket\collects\racket\private\map.rkt: 23:17
                   (let loop ([l l])
                   (cond
                    [(null? l) null]
                    [else (cons (f (car l)) (loop (cdr l)))]))

C:\Program Files\Racket\collects\racket\private\map.rkt: 18:11
             (case-lambda
            [(f l)
             (if (and (procedure? f)
                      (procedure-arity-includes? f 1)
                      (list? l))
                 (let loop ([l l])
                   (cond
                    [(null? l) null]
                    [else (cons (f (car l)) (loop (cdr l)))]))
                 (map f l))]
            [(f l1 l2)
             (if (and (procedure? f)
                      (procedure-arity-includes? f 2)
                      (list? l1)
                      (list? l2)
                      (= (length l1) (length l2)))
                 (let loop ([l1 l1][l2 l2])
                   (cond
                    [(null? l1) null]
                    [else (cons (f (car l1) (car l2))
                                (loop (cdr l1) (cdr l2)))]))
                 (map f l1 l2))]
            [(f . args) (apply map f args)])])

C:\Program Files\Racket\collects\compiler\cm.rkt: 187:0
  (define (get-dep-sha1s deps up-to-date read-src-syntax mode must-exist?)
  (let ([l (for/fold ([l null]) ([dep (in-list deps)])
             (and l
                  ;; (cons 'ext rel-path) => a non-module file, check source
                  ;; rel-path => a module file name, check cache
                  (let* ([ext? (and (pair? dep) (eq? 'ext (car dep)))]
                         [p (main-collects-relative->path (if ext? (cdr dep)
dep))])
                    (cond
                     [ext? (let ([v (get-source-sha1 p)])
                             (cond
                              [v (cons (cons (delay v) dep) l)]
                              [must-exist? (error 'cm "cannot find
external-dependency file: ~v" p)]
                              [else #f]))]
                     [(or (hash-ref up-to-date (simple-form-path p) #f)
                          ;; Use `compiler-root' with `sha1-only?' as #t:
                          (compile-root mode p up-to-date read-src-syntax
#t))
                      => (lambda (sh)
                           (cons (cons (cdr sh) dep) l))]
                     [must-exist?
                      ;; apparently, we're forced to use the source of the
module,
                      ;; so compute a sha1 from it instead of the bytecode
                      (cons (cons (get-source-sha1 p) dep) l)]
                     [else #f]))))])
    (and l
         (let ([p (open-output-string)]
               [l (map (lambda (v)
                         (let ([sha1 (force (car v))]
                               [dep (cdr v)])
                           (unless sha1
                             (error 'cm "no SHA-1 for dependency: ~s" dep))
                           (cons sha1 dep)))
                       l)])
           ;; sort by sha1s so that order doesn't matter
           (write (sort l string<? #:key car) p)
           ;; compute one hash from all hashes
           (sha1 (open-input-bytes (get-output-bytes p)))))))

C:\Program Files\Racket\collects\compiler\cm.rkt: 230:6
        (lambda (op tmp-path)
        (let ([deps (append
                     (map path->main-collects-relative deps)
                     (map (lambda (x)
                            (cons 'ext (path->main-collects-relative x)))
                          external-deps))])
        (write (list* (version)
                      (cons (or src-sha1 (get-source-sha1 path))
                            (get-dep-sha1s deps up-to-date read-src-syntax
mode #t))
                      deps)
               op)
        (newline op))))))

C:\Program Files\Racket\collects\racket\private\more-scheme.rkt: 158:2
    (define (call-with-break-parameterization paramz thunk)
    (unless (break-paramz? paramz)
      (raise-type-error 'call-with-break-parameterization "break
parameterization" 0 paramz thunk))
    (unless (and (procedure? thunk)
         (procedure-arity-includes? thunk 0))
      (raise-type-error 'call-with-parameterization "procedure (arity 0)" 1
paramz thunk))
    (begin0
     (with-continuation-mark
     break-enabled-key
     (break-paramz-ref paramz 0)
       (begin
     (check-for-break)
     (thunk)))
     (check-for-break)))

C:\Program Files\Racket\collects\racket\private\more-scheme.rkt: 158:2
    (define (call-with-break-parameterization paramz thunk)
    (unless (break-paramz? paramz)
      (raise-type-error 'call-with-break-parameterization "break
parameterization" 0 paramz thunk))
    (unless (and (procedure? thunk)
         (procedure-arity-includes? thunk 0))
      (raise-type-error 'call-with-parameterization "procedure (arity 0)" 1
paramz thunk))
    (begin0
     (with-continuation-mark
     break-enabled-key
     (break-paramz-ref paramz 0)
       (begin
     (check-for-break)
     (thunk)))
     (check-for-break)))

C:\Program Files\Racket\collects\compiler\cm.rkt: 168:5
       (lambda ()
       (begin0
         (let ([out (open-output-file tmp-path #:exists 'truncate/replace)])
           (dynamic-wind
            void
            (lambda ()
              (call-with-break-parameterization bp (lambda () (proc out
tmp-path))))
            (lambda ()
              (close-output-port out))))
         (set! ok? #t)))

C:\Program Files\Racket\collects\compiler\cm.rkt: 464:2
    (define (do-check)
    (let* ([main-path orig-path]
           [alt-path (rkt->ss orig-path)]
           [main-path-time (try-file-time main-path)]
           [alt-path-time (and (not main-path-time)
                               (not (eq? alt-path main-path))
                               (try-file-time alt-path))]
           [path (if alt-path-time alt-path main-path)]
           [path-time (or main-path-time alt-path-time)]
           [path-zo-time (get-compiled-time mode path)])
      (cond
       [(not path-time)
        (trace-printf "~a does not exist" orig-path)
        (or (hash-ref up-to-date orig-path #f)
            (let ([stamp (cons path-zo-time
                               (delay (get-compiled-sha1 mode path)))])
              (hash-set! up-to-date main-path stamp)
              (unless (eq? main-path alt-path)
                (hash-set! up-to-date alt-path stamp))
              stamp))]
       [else
        (let ([deps (read-deps path)])
          (define build
            (cond
             [(not (and (pair? deps) (equal? (version) (car deps))))
              (lambda ()
                (trace-printf "newer version...")
                (maybe-compile-zo #f #f mode path orig-path read-src-syntax
up-to-date))]
             [(> path-time path-zo-time)
              (trace-printf "newer src...")
              ;; If `sha1-only?', then `maybe-compile-zo' returns a #f or
thunk:
              (maybe-compile-zo sha1-only? deps mode path orig-path
read-src-syntax up-to-date)]
             [(ormap
               (lambda (p)
                 ;; (cons 'ext rel-path) => a non-module file (check date)
                 ;; rel-path => a module file name (check transitive dates)
                 (define ext? (and (pair? p) (eq? 'ext (car p))))
                 (define d (main-collects-relative->path (if ext? (cdr p)
p)))
                 (define t
                   (if ext?
                       (cons (try-file-time d) #f)
                       (compile-root mode d up-to-date read-src-syntax #f)))
                 (and (car t)
                      (> (car t) path-zo-time)
                      (begin (trace-printf "newer: ~a (~a > ~a)..."
                                           d (car t) path-zo-time)
                             #t)))
               (cddr deps))
              ;; If `sha1-only?', then `maybe-compile-zo' returns a #f or
thunk:
              (maybe-compile-zo sha1-only? deps mode path orig-path
read-src-syntax up-to-date)]
             [else #f]))
          (cond
           [(and build sha1-only?) #f]
           [else
            (when build (build))
            (let ([stamp (cons (get-compiled-time mode path)
                               (delay (get-compiled-sha1 mode path)))])
              (hash-set! up-to-date main-path stamp)
              (unless (eq? main-path alt-path)
                (hash-set! up-to-date alt-path stamp))
              stamp)]))])))

C:\Program Files\Racket\collects\compiler\cm.rkt: 558:4
      (define (compilation-manager-load-handler path mod-name)
      (cond [(not mod-name)
             (trace-printf "skipping:  ~a mod-name ~s" path mod-name)]
            [(not (or (file-exists? path)
                      (let ([p2 (rkt->ss path)])
                        (and (not (eq? path p2))
                             (file-exists? p2)))))
             (trace-printf "skipping:  ~a file does not exist" path)]
            [(or (null? (use-compiled-file-paths))
                 (not (equal? (car modes)
                              (car (use-compiled-file-paths)))))
             (trace-printf "skipping:  ~a compiled-paths's first element
changed; current value ~s, first element was ~s"
                           path
                           (use-compiled-file-paths)
                           (car modes))]
            [(not (eq? compilation-manager-load-handler
                       (current-load/use-compiled)))
             (trace-printf "skipping:  ~a current-load/use-compiled changed
~s"
                           path (current-load/use-compiled))]
            [(not (eq? orig-eval (current-eval)))
             (trace-printf "skipping:  ~a orig-eval ~s current-eval ~s"
                           path orig-eval (current-eval))]
            [(not (eq? orig-load (current-load)))
             (trace-printf "skipping:  ~a orig-load ~s current-load ~s"
                           path orig-load (current-load))]
            [(not (eq? orig-registry
                       (namespace-module-registry (current-namespace))))
             (trace-printf "skipping:  ~a orig-registry ~s current-registry
~s"
                           path orig-registry
                           (namespace-module-registry (current-namespace)))]
            [else
             (trace-printf "processing: ~a" path)
             (compile-root (car modes) path cache read-syntax #f)
             (trace-printf "done: ~a" path)])
      (default-handler path mod-name))

C:\Program Files\Racket\collects\compiler\cm.rkt: 464:2
    (define (do-check)
    (let* ([main-path orig-path]
           [alt-path (rkt->ss orig-path)]
           [main-path-time (try-file-time main-path)]
           [alt-path-time (and (not main-path-time)
                               (not (eq? alt-path main-path))
                               (try-file-time alt-path))]
           [path (if alt-path-time alt-path main-path)]
           [path-time (or main-path-time alt-path-time)]
           [path-zo-time (get-compiled-time mode path)])
      (cond
       [(not path-time)
        (trace-printf "~a does not exist" orig-path)
        (or (hash-ref up-to-date orig-path #f)
            (let ([stamp (cons path-zo-time
                               (delay (get-compiled-sha1 mode path)))])
              (hash-set! up-to-date main-path stamp)
              (unless (eq? main-path alt-path)
                (hash-set! up-to-date alt-path stamp))
              stamp))]
       [else
        (let ([deps (read-deps path)])
          (define build
            (cond
             [(not (and (pair? deps) (equal? (version) (car deps))))
              (lambda ()
                (trace-printf "newer version...")
                (maybe-compile-zo #f #f mode path orig-path read-src-syntax
up-to-date))]
             [(> path-time path-zo-time)
              (trace-printf "newer src...")
              ;; If `sha1-only?', then `maybe-compile-zo' returns a #f or
thunk:
              (maybe-compile-zo sha1-only? deps mode path orig-path
read-src-syntax up-to-date)]
             [(ormap
               (lambda (p)
                 ;; (cons 'ext rel-path) => a non-module file (check date)
                 ;; rel-path => a module file name (check transitive dates)
                 (define ext? (and (pair? p) (eq? 'ext (car p))))
                 (define d (main-collects-relative->path (if ext? (cdr p)
p)))
                 (define t
                   (if ext?
                       (cons (try-file-time d) #f)
                       (compile-root mode d up-to-date read-src-syntax #f)))
                 (and (car t)
                      (> (car t) path-zo-time)
                      (begin (trace-printf "newer: ~a (~a > ~a)..."
                                           d (car t) path-zo-time)
                             #t)))
               (cddr deps))
              ;; If `sha1-only?', then `maybe-compile-zo' returns a #f or
thunk:
              (maybe-compile-zo sha1-only? deps mode path orig-path
read-src-syntax up-to-date)]
             [else #f]))
          (cond
           [(and build sha1-only?) #f]
           [else
            (when build (build))
            (let ([stamp (cons (get-compiled-time mode path)
                               (delay (get-compiled-sha1 mode path)))])
              (hash-set! up-to-date main-path stamp)
              (unless (eq? main-path alt-path)
                (hash-set! up-to-date alt-path stamp))
              stamp)]))])))


On Fri, Jul 23, 2010 at 8:18 PM, Matthew Flatt <mflatt at cs.utah.edu> wrote:

> That version is after I improved error message, but before the repair.
>
> It looks like the nightly build failed last night, which is why the
> repair wasn't in the build. We're working on that problem.
>
> At Fri, 23 Jul 2010 16:11:37 -0600, Doug Williams wrote:
> > I downloaded the latest nightly build (version
> > 5.0.1.1--2010-07-21(ca106a41343233e3e2e1d6393b97ff6de67e01c4/a) [3m]).
> Now I
> > get the following error message:
> >
> > cm: no SHA-1 for dependency: (collects #"scheme" #"base" #"lang"
> > #"reader.rkt")
> >
> > Doug
> >
> > On Thu, Jul 22, 2010 at 5:47 PM, Matthew Flatt <mflatt at cs.utah.edu>
> wrote:
> >
> > > At Wed, 21 Jul 2010 17:09:03 -0600, Matthew Flatt wrote:
> > > > I've pushed a change to the git repo that I don't think will fix the
> > > > problem, but I think it will give us better information when you get
> a
> > > > chance to try it.
> > >
> > > The new error message provoked a bug report that led to a repair. So,
> > > please try the latest and let me know if the problem is fixed.
> > >
> > >
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/dev/archive/attachments/20100724/8bf53bd0/attachment.html>

Posted on the dev mailing list.