From a40f288e48c759ba4606278fe74f79b5bf63c806 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 7 Oct 2011 07:47:40 -0500
Subject: [PATCH] relaxed the restrictions on planet requires in the teaching
 languages to allow the new forms

---
 collects/lang/private/teach.rkt       | 56 ++++++++++++++++-----------
 collects/tests/htdp-lang/beg-adv.rktl |  2 +
 2 files changed, 35 insertions(+), 23 deletions(-)

diff --git a/collects/lang/private/teach.rkt b/collects/lang/private/teach.rkt
index 0585e7f1c7..9c10a63b9e 100644
--- a/collects/lang/private/teach.rkt
+++ b/collects/lang/private/teach.rkt
@@ -1550,29 +1550,39 @@
                       'stepper-black-box-expr
                       stx)]))]
         [(_ (planet . rest))
-         (syntax-case stx (planet)
-           [(_ (planet s1 (s2 s3 n1 n2)))
-            (and (string? (syntax-e #'s1))
-                 (string? (syntax-e #'s2))
-                 (string? (syntax-e #'s3))
-                 (version-number? (syntax-e #'n1))
-                 (version-number? (syntax-e #'n2)))
-            (begin
-              (check-string-form stx #'s1)
-              (check-string-form stx #'s2)
-              (check-string-form stx #'s3)
-              ;; use the original `planet', so that it binds correctly:
-              (syntax-case stx ()
-                [(_ ms) (stepper-syntax-property
-                         #'(require ms)
-                         'stepper-black-box-expr
-                         stx)]))]
-           [_else
-            (teach-syntax-error
-             'require
-             stx
-             #f
-             "not a valid planet path; should be: (require (planet STRING (STRING STRING NUMBER NUMBER)))")])]
+         (let ([go
+                (λ ()
+                  ;; use the original `planet', so that it binds correctly:
+                  (syntax-case stx ()
+                    [(_ ms) (stepper-syntax-property
+                             #'(require ms)
+                             'stepper-black-box-expr
+                             stx)]))])
+           (syntax-case stx (planet)
+             [(_ (planet s1 (s2 s3 n1 n2)))
+              (and (string? (syntax-e #'s1))
+                   (string? (syntax-e #'s2))
+                   (string? (syntax-e #'s3))
+                   (version-number? (syntax-e #'n1))
+                   (version-number? (syntax-e #'n2)))
+              (begin
+                (check-string-form stx #'s1)
+                (check-string-form stx #'s2)
+                (check-string-form stx #'s3)
+                (go))]
+             [(_ (planet a))
+              (or (string? (syntax-e #'a))
+                  (symbol? (syntax-e #'a)))
+              (go)]
+             [_else
+              (teach-syntax-error
+               'require
+               stx
+               #f
+               (string-append
+                "not a valid planet path; should be:"
+                " (require (planet STRING (STRING STRING NUMBER NUMBER)))"
+                " (require (planet STRING)) or (require (planet SYMBOL))"))]))]
         [(_ thing)
          (teach-syntax-error
           'require
diff --git a/collects/tests/htdp-lang/beg-adv.rktl b/collects/tests/htdp-lang/beg-adv.rktl
index 5c11beeeff..9d32a93b3c 100644
--- a/collects/tests/htdp-lang/beg-adv.rktl
+++ b/collects/tests/htdp-lang/beg-adv.rktl
@@ -247,6 +247,8 @@
 (htdp-syntax-test #'(require (lib "a" "b/")) #rx"end with a slash")
 (htdp-syntax-test #'(require (lib "a" 2)) #rx"string for a lib path")
 (htdp-syntax-test #'(require (planet "a" 2)) #rx"not a valid planet path")
+(htdp-syntax-test #'(require (planet "test-connectionλ.ss" ("planet" "test-connection.plt" 1 0)))
+                  #rx"string can contain only")
 
 (define rx:dots-error "found a template")