From c34bd6c28d027a886254c1459beb11614751923a Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 20 Oct 2010 13:46:37 -0500 Subject: [PATCH] fix the metadata parsing to be more robust so drracket does not crash when opening a corrupt htdp teaching language file closes PR 11332 --- collects/lang/htdp-langs.rkt | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/collects/lang/htdp-langs.rkt b/collects/lang/htdp-langs.rkt index fda50d8625..171e506863 100644 --- a/collects/lang/htdp-langs.rkt +++ b/collects/lang/htdp-langs.rkt @@ -662,7 +662,7 @@ (inherit default-settings) (define/override (metadata->settings metadata) - (let* ([table (metadata->table metadata)] ;; extract the table + (let* ([table (massage-metadata (metadata->table metadata))] ;; extract the table [ssv (assoc 'htdp-settings table)]) (if ssv (let ([settings-list (vector->list (cadr ssv))]) @@ -672,11 +672,18 @@ (default-settings))) (default-settings)))) + (define/private (massage-metadata md) + (if (and (list? md) + (andmap (λ (x) (and (pair? x) (symbol? (car x)))) md)) + md + '())) + (define/private (metadata->table metadata) - (let ([p (open-input-string metadata)]) - (regexp-match #rx"\n#reader" p) ;; skip to reader - (read p) ;; skip module - (read p))) + (with-handlers ((exn:fail:read? (λ (x) #f))) + (let ([p (open-input-string metadata)]) + (regexp-match #rx"\n#reader" p) ;; skip to reader + (read p) ;; skip module + (read p)))) (define/override (get-metadata-lines) 3)