fix broken-link reporting by `scribble'

This commit is contained in:
Matthew Flatt 2011-08-21 21:20:15 -06:00
parent fc5fc02e5e
commit 853e47f05e
4 changed files with 55 additions and 11 deletions

View File

@ -236,9 +236,19 @@
(define/public (get-defined ci)
(hash-map (collect-info-ht ci) (lambda (k v) k)))
(define/public (get-undefined ri)
(define/public (get-external ri)
(hash-map (resolve-info-undef ri) (lambda (k v) k)))
(define/public (get-undefined ri)
(for/list ([(k v) (in-hash (resolve-info-undef ri))]
#:unless (or (eq? v 'found)
(and v
;; v is a search key; see if any key in the set was resolved:
(let ([ht (hash-ref (resolve-info-searches ri) v)])
(for/or ([k2 (in-hash-keys ht)])
(eq? 'found (hash-ref (resolve-info-undef ri) k2 #f)))))))
k))
(define/public (transfer-info ci src-ci)
(let ([in-ht (collect-info-ext-ht ci)])
(for ([(k v) (collect-info-ext-ht src-ci)])

View File

@ -39,13 +39,20 @@
#t)]))))
(define (resolve-get/ext? part ri key)
(resolve-get/ext?* part ri key #f))
(define (resolve-get/ext?* part ri key search-key)
(let-values ([(v ext?) (resolve-get/where part ri key)])
(when ext?
(hash-set! (resolve-info-undef ri) (tag-key key ri) #t))
(hash-set! (resolve-info-undef ri) (tag-key key ri)
(if v 'found search-key)))
(values v ext?)))
(define (resolve-get part ri key)
(let-values ([(v ext?) (resolve-get/ext? part ri key)])
(resolve-get* part ri key #f))
(define (resolve-get* part ri key search-key)
(let-values ([(v ext?) (resolve-get/ext?* part ri key search-key)])
v))
(define (resolve-get/tentative part ri key)
@ -61,14 +68,12 @@
search-key s-ht)
s-ht)))])
(hash-set! s-ht key #t))
(resolve-get part ri key))
(resolve-get* part ri key search-key))
(define (resolve-get-keys part ri key-pred)
(let ([l null])
(hash-for-each
(collected-info-info (part-collected-info part ri))
(lambda (k v) (when (key-pred k) (set! l (cons k l)))))
l))
(for/list ([k (in-hash-keys (collected-info-info (part-collected-info part ri)))]
#:when (key-pred k))
k))
(provide (struct-out collect-info)
(struct-out resolve-info))

View File

@ -187,6 +187,7 @@ object.}
Serializes the collected info in @racket[ri].}
@defmethod[(deserialize-info [v any/c]
[ci collect-info?]
[#:root root-path (or/c path-string? false/c) #f])
@ -199,6 +200,32 @@ recorded in @racket[ci] as relative to an instantiation-supplied
@racket[root-path] are deserialized as relative instead to the given
@racket[root-path].}
@defmethod[(get-defined [ci collect-info?]) (listof tag?)]{
Returns a list of tags that were defined within the documents
represented by @racket[ci].}
@defmethod[(get-external [ri resolve-info?]) (listof tag?)]{
Returns a list of tags that were referenced but not defined within the
documents represented by @racket[ri] (though possibly found in
cross-reference information transferred to @racket[ri] via
@racket[xref-transfer-info]).}
@defmethod[(get-undefined [ri resolve-info?]) (listof tag?)]{
Returns a list of tags that were referenced by the resolved documents
with no target found either in the resolved documents represented by
@racket[ri] or cross-reference information transferred to @racket[ri]
via @racket[xref-transfer-info].
If multiple tags were referenced via @racket[resolve-search] and a
target was found for any of the tags using the same dependency key,
then no tag in the set is included in the list of undefined tags.}
}
@; ----------------------------------------

View File

@ -265,6 +265,8 @@
(doc-src-file (info-doc i))))
(hash-set! deps i #t)))
(when first?
;; FIXME: instead of special-casing 'dep, we should
;; skip any key that is covered by `(info-searches info)'.
(unless (eq? (car k) 'dep)
(not-found k))))))
(when first?
@ -627,7 +629,7 @@
v)))]
[sci (send renderer serialize-info ri)]
[defs (send renderer get-defined ci)]
[undef (send renderer get-undefined ri)]
[undef (send renderer get-external ri)]
[searches (resolve-info-searches ri)]
[need-out-write?
(or (not out-v)
@ -753,7 +755,7 @@
(render-time "resolve" (send renderer resolve (list v) (list dest-dir) ci)))]
[sci (render-time "serialize" (send renderer serialize-info ri))]
[defs (render-time "defined" (send renderer get-defined ci))]
[undef (render-time "undefined" (send renderer get-undefined ri))]
[undef (render-time "undefined" (send renderer get-external ri))]
[in-delta? (not (equal? (any-order undef) (any-order ff-undef)))]
[out-delta? (or (not (serialized=? sci ff-sci))
(not (equal? (any-order defs) (any-order ff-provides))))])