[racket-dev] Possible bug in get-module-code function of syntax/modcode

From: Timur Sufiev (tsufiev at jet.msk.su)
Date: Wed Feb 22 08:25:09 EST 2012

Hi all!

It seems to me that a bug exists in handling so-extensions inside 
get-module-code. Imagine a situation when we want to use get-module-code 
on mzmimer.so file which is located inside 
/opt/dozor/racket/lib/racket/collects/jetinfo/compiled/native/i386-linux/3m 
and is specified by (lib "mzmimer" "jetinfo") module-spec. No, I don't 
really want to do some introspection on so-extension, but geiser (emacs 
extension for racket) does.

Going inside get-module-code (look for squre-bracketed line numbers in 
listing below), path = 
/opt/dozor/racket/lib/racket/collects/jetinfo/mzmimer ...
[1]: orig-path = /opt/dozor/racket/lib/racket/collects/jetinfo/mzmimer
[2]: base = /opt/dozor/racket/lib/racket/collects/jetinfo, orig-file = 
mzmimer
[3]: main-file = mzmimer, alt-file = #f
[4]: main-path = /opt/dozor/racket/lib/racket/collects/jetinfo/mzmimer
[5]: alt-path = #f
[6]: main-path-d = #f
[7]: alt-path-d = #f
[8]: try-alt? = #t
[9]: error!

main-path-d is #f because orig-path doesn't actually exist, but it is ok 
for so-extension. alt-file doesn't exist neither, but stiil we try to 
calculate path to it. The bug in my opinion resides in line [8]: 
[try-alt? (and (not alt-path-d) (not main-path-d))]
so I've changed it to: [try-alt? (and alt-file (not alt-path-d) (not 
main-path-d))]
and it has worked for me. I doubt whether that fix is good for everyone, 
but know for sure it should be fixed somehow.

(let*-values ([(orig-path) (resolve path)]                 [1]
                   [(base orig-file dir?) (split-path path)]   [2]
                   [(main-file alt-file)                               
    [3]
                    (if rkt-try-ss?
                        (let* ([b (path->bytes orig-file)]
                               [len (bytes-length b)])
                          (cond
                           [(and (len . >= . 4)
                                 (bytes=? #".rkt" (subbytes b (- len 4))))
                            ;; .rkt => try .rkt then .ss
                            (values orig-file
                                    (bytes->path (bytes-append (subbytes 
b 0 (- len 4)) #".ss")))]
                           [else
                            ;; No search path
                            (values orig-file #f)]))
                        (values orig-file #f))]
                   [(main-path) (if (eq? main-file orig-file)    [4]
                                    orig-path
                                    (build-path base main-file))]
                   [(alt-path) (and alt-file                             [5]
                                    (if (eq? alt-file orig-file)
                                        orig-path
                                        (build-path base alt-file)))]
                   [(base) (if (eq? base 'relative) 'same base)])
       (let* ([main-path-d (file-or-directory-modify-seconds orig-path 
#f (lambda () #f))]       [6]
              [alt-path-d (and 
alt-path                                                                                         
[7]
                               (not main-path-d)
                               (file-or-directory-modify-seconds 
alt-path #f (lambda () #f)))]
              [path-d (or main-path-d alt-path-d)]
              [file (if alt-path-d alt-file main-file)]
              [path (if alt-path-d alt-path main-path)]
              [try-alt? (and (not alt-path-d) (not 
main-path-d))]                                                   [8]
              [get-so (lambda (file)
                        (build-path
                         base sub-path "native"
                         (system-library-subpath)
                         (path-add-suffix file (system-type 'so-suffix))))]
              [zo (build-path base sub-path (path-add-suffix file #".zo"))]
              [alt-zo (and try-alt?
                           (build-path base sub-path (path-add-suffix 
alt-file #".zo")))]                     [9]



-- 
Best regards,
Timur


Posted on the dev mailing list.