From 00c93a1829176c9b54565836a824b7aed09d8451 Mon Sep 17 00:00:00 2001 From: Matthias Felleisen Date: Mon, 28 Nov 2011 21:31:18 -0500 Subject: [PATCH] allow strings and symbols for name clause in world; Closes PR12403 --- collects/2htdp/private/clauses-spec-aux.rkt | 17 +++++++++++------ collects/2htdp/tests/name.rkt | 9 +++++++++ collects/2htdp/universe.rkt | 2 +- collects/2htdp/xtest | 1 + doc/release-notes/teachpack/HISTORY.txt | 6 ++++-- 5 files changed, 26 insertions(+), 9 deletions(-) create mode 100644 collects/2htdp/tests/name.rkt diff --git a/collects/2htdp/private/clauses-spec-aux.rkt b/collects/2htdp/private/clauses-spec-aux.rkt index 039b881975..28487df29a 100644 --- a/collects/2htdp/private/clauses-spec-aux.rkt +++ b/collects/2htdp/private/clauses-spec-aux.rkt @@ -3,7 +3,7 @@ ;; --------------------------------------------------------------------------------------------------- ;; provides constants and functions for specifying the shape of clauses in big-bang and universe -(provide nat> nat? proc> bool> num> ip> string> symbol> any> K False True) +(provide nat> nat? proc> bool> num> ip> string> symbol> string-or-symbol> any> K False True) (require htdp/error "check-aux.rkt") @@ -11,23 +11,28 @@ (define (False w) #f) (define (True w) #t) -;; Symbol X -> X +;; Symbol X -> X : boolean? (define (bool> tag x) (check-arg tag (boolean? x) "boolean" "first" x) x) -;; Symbol X -> X +;; Symbol X -> X : string? (define (string> tag x) (check-arg tag (string? x) "string" "first" x) x) -(define ip> string>) - -;; Symbol X -> X +;; Symbol X -> X : symbol? (define (symbol> tag x) (check-arg tag (symbol? x) "symbol" "second" x) x) +;; Symbol X -> X : symbol? or string? +(define (string-or-symbol> tag x) + (check-arg tag (or (symbol? x) (string? x)) "symbol or string" "first" x) + x) + +(define ip> string>) + ;; Symbol X Nat -> X (define (proc> tag f ar) (check-proc tag f ar "first" (if (> ar 1) (format "~a arguments" ar) "one argument")) diff --git a/collects/2htdp/tests/name.rkt b/collects/2htdp/tests/name.rkt new file mode 100644 index 0000000000..6e70cd83ce --- /dev/null +++ b/collects/2htdp/tests/name.rkt @@ -0,0 +1,9 @@ +#lang racket +(require 2htdp/universe) +(require 2htdp/image) + +(big-bang '* + (name 'jimbob) + (on-tick (λ (w) w) 1/3 2) + (to-draw (λ (w) (empty-scene 200 200)))) + diff --git a/collects/2htdp/universe.rkt b/collects/2htdp/universe.rkt index 39dbee4b30..648d1dd217 100644 --- a/collects/2htdp/universe.rkt +++ b/collects/2htdp/universe.rkt @@ -112,7 +112,7 @@ [record? DEFAULT #'#f (expr-with-check any> "")] ;; (U #f String) ;; -- name specifies one string - [name DEFAULT #'#f (expr-with-check string> "expected a string")] + [name DEFAULT #'#f (expr-with-check string-or-symbol> "expected a string")] ;; (U #f IP) ;; -- register must specify the internet address of a host (e.g., LOCALHOST) [register DEFAULT #'#f (expr-with-check ip> "expected a host (ip address)")]) diff --git a/collects/2htdp/xtest b/collects/2htdp/xtest index d719a9c980..ac3fbc77ca 100755 --- a/collects/2htdp/xtest +++ b/collects/2htdp/xtest @@ -38,4 +38,5 @@ run on-tick-with-limit.rkt run on-release-no-key.rkt run struct-universe.rkt run universe-receive.rkt +run name.rkt diff --git a/doc/release-notes/teachpack/HISTORY.txt b/doc/release-notes/teachpack/HISTORY.txt index df58e5493a..3f7bdf2eb7 100644 --- a/doc/release-notes/teachpack/HISTORY.txt +++ b/doc/release-notes/teachpack/HISTORY.txt @@ -1,7 +1,9 @@ ------------------------------------------------------------------------ -* on-receive doesn't have to exist for universe/world interactions - -- fixed +* fixed + -- on-receive doesn't have to exist for universe/world interactions + -- name clause accepts strings and symbols + -- doc typos ------------------------------------------------------------------------ Version 5.2 [Tue Oct 18 12:34:16 EDT 2011]