Moved unstable/cce/text to unstable/text.

collects/tests/unstable/helpers.rkt

@@ -2,7 +2,9 @@
 
 (provide test
          test-ok check-ok
-         test-bad check-bad)
+         test-bad check-bad
+         check-not
+         with/c)
 
 (require rackunit racket/pretty)
 
@@ -18,3 +20,18 @@
 (define (pretty-format/write x)
   (with-output-to-string
     (lambda () (pretty-write x))))
+
+(define-syntax-rule (with/c c e)
+  (let () (with-contract value ([value c]) (define value e)) value))
+
+(define-check (check-not compare actual expected)
+  (with-check-info*
+   (list (make-check-info 'comparison compare)
+         (make-check-actual actual)
+         (make-check-expected expected))
+   (lambda ()
+     (let* ([result (compare actual expected)])
+       (when result
+         (with-check-info*
+          (list (make-check-info 'result result))
+          (lambda () (fail-check))))))))

collects/tests/unstable/text.rkt

@@ -0,0 +1,133 @@
+#lang racket
+
+(require rackunit rackunit/text-ui unstable/text "helpers.rkt")
+
+(run-tests
+ (test-suite "text.ss"
+   (test-suite "text/c"
+     (test-ok (with/c text/c "text"))
+     (test-ok (with/c text/c #"text"))
+     (test-ok (with/c text/c 'text))
+     (test-ok (with/c text/c '#:text))
+     (test-ok (with/c text/c #'"text"))
+     (test-ok (with/c text/c #'#"text"))
+     (test-ok (with/c text/c #'text))
+     (test-ok (with/c text/c #'#:text))
+     (test-bad (with/c text/c '(not text))))
+   (test-suite "text?"
+     (test-case "accept string"
+       (check-pred text? "text"))
+     (test-case "accept byte string"
+       (check-pred text? #"text"))
+     (test-case "accept symbol"
+       (check-pred text? 'text))
+     (test-case "accept keyword"
+       (check-pred text? '#:text))
+     (test-case "accept string literal"
+       (check-pred text? #'"text"))
+     (test-case "accept byte string literal"
+       (check-pred text? #'#"text"))
+     (test-case "accept identifier"
+       (check-pred text? #'text))
+     (test-case "accept keyword literal"
+       (check-pred text? #'#:text))
+     (test-case "reject non-text"
+       (check-false (text? '(not text)))))
+   (test-suite "string-literal?"
+     (test-case "accept" (check-true (string-literal? #'"string")))
+     (test-case "reject" (check-false (string-literal? "string"))))
+   (test-suite "keyword-literal?"
+     (test-case "accept" (check-true (keyword-literal? #'#:keyword)))
+     (test-case "reject" (check-false (keyword-literal? '#:keyword))))
+   (test-suite "bytes-literal?"
+     (test-case "accept" (check-true (bytes-literal? #'#"bytes")))
+     (test-case "reject" (check-false (bytes-literal? #"bytes"))))
+   (test-suite "text=?"
+     (test-case "string = string"
+       (check text=? "abc" (string-copy "abc")))
+     (test-case "string != string"
+       (check-not text=? "abc" (string-copy "cba")))
+     (test-case "string = identifier"
+       (check text=? "car" #'car))
+     (test-case "string != identifier"
+       (check-not text=? "car" #'cdr))
+     (test-case "identifier = identifier, different bindings"
+       (check text=? #'car (datum->syntax #f 'car)))
+     (test-case "identifier != identifier, no bindings"
+       (check-not text=? #'UNBOUND (datum->syntax #f 'ALSO-UNBOUND))))
+   (test-suite "text<?"
+     (test-case "string < string"
+       (check text<? "abc" "def"))
+     (test-case "string !< string"
+       (check-not text<? "abc" "abc"))
+     (test-case "string < identifier"
+       (check text<? "abc" #'def))
+     (test-case "string !< identifier"
+       (check-not text<? "abc" #'abc)))
+   (test-suite "text<=?"
+     (test-case "string <= string"
+       (check text<=? "abc" "abc"))
+     (test-case "string !<= string"
+       (check-not text<=? "def" "abc"))
+     (test-case "string <= identifier"
+       (check text<=? "abc" #'abc))
+     (test-case "string !<= identifier"
+       (check-not text<=? "def" #'abc)))
+   (test-suite "text>?"
+     (test-case "string > string"
+       (check text>? "def" "abc"))
+     (test-case "string !> string"
+       (check-not text>? "abc" "abc"))
+     (test-case "string > identifier"
+       (check text>? "def" #'abc))
+     (test-case "string !> identifier"
+       (check-not text>? "abc" #'abc)))
+   (test-suite "text>=?"
+     (test-case "string >= string"
+       (check text>=? "abc" "abc"))
+     (test-case "string !>= string"
+       (check-not text>=? "abc" "def"))
+     (test-case "string >= identifier"
+       (check text>=? "abc" #'abc))
+     (test-case "string !>= identifier"
+       (check-not text>=? "abc" #'def)))
+   (test-suite "text->string"
+     (test-case "single" (check-equal? (text->string 'abc) "abc"))
+     (test-case "multiple" (check-equal? (text->string 'a "b" #'c) "abc")))
+   (test-suite "text->symbol"
+     (test-case "single" (check-equal? (text->symbol "abc") 'abc))
+     (test-case "multiple" (check-equal? (text->symbol 'a "b" #'c) 'abc)))
+   (test-suite "text->keyword"
+     (test-case "single" (check-equal? (text->keyword #'abc) '#:abc))
+     (test-case "multiple" (check-equal? (text->keyword 'a "b" #'c) '#:abc)))
+   (test-suite "text->bytes"
+     (test-case "single" (check-equal? (text->bytes "abc") #"abc"))
+     (test-case "multiple" (check-equal? (text->bytes 'a "b" #'c) #"abc")))
+   (test-suite "text->identifier"
+     (test-case "single, no context"
+       (check-equal? (syntax-e (text->identifier "abc")) 'abc))
+     (test-case "multiple w/ context"
+       (check bound-identifier=?
+              (text->identifier #:stx #'here 'a "b" #'c)
+              #'abc)))
+   (test-suite "text->string-literal"
+     (test-case "single"
+       (check-equal? (syntax-e (text->string-literal '#:abc)) "abc"))
+     (test-case "multiple"
+       (check-equal?
+        (syntax-e (text->string-literal #:stx #'here 'a "b" #'c))
+        "abc")))
+   (test-suite "text->keyword-literal"
+     (test-case "single"
+       (check-equal? (syntax-e (text->keyword-literal #"abc")) '#:abc))
+     (test-case "multiple"
+       (check-equal?
+        (syntax-e (text->keyword-literal #:stx #'here 'a "b" #'c))
+        '#:abc)))
+   (test-suite "text->bytes-literal"
+     (test-case "single"
+       (check-equal? (syntax-e (text->bytes-literal 'abc)) #"abc"))
+     (test-case "multiple"
+       (check-equal?
+        (syntax-e (text->bytes-literal #:stx #'here 'a "b" #'c))
+        #"abc")))))

collects/unstable/cce/private/syntax-core.ss

@@ -2,8 +2,8 @@
 
 (require scheme/contract
          scheme/match
+         unstable/text
          (only-in unstable/syntax with-syntax*)
-         "../text.ss"
          (for-syntax scheme/base))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

collects/unstable/cce/reference/manual.scrbl

@@ -12,7 +12,6 @@
 
 @include-section["values.scrbl"]
 
-@include-section["text.scrbl"]
 @include-section["regexp.scrbl"]
 @include-section["web.scrbl"]
 

collects/unstable/cce/reference/web.scrbl

@@ -29,7 +29,8 @@ described by the following grammar:
 [value text]
 ]
 
-Here, @scheme[text] is any of the datatypes described in @secref["cce-text"].
+Here, @scheme[text] is any of the datatypes described in
+@secref["unstable-text"].
 }
 
 @defthing[xexpr/c flat-contract?]{

collects/unstable/cce/syntax.ss

@@ -8,14 +8,14 @@
          syntax/kerncase
          setup/main-collects
          planet/planet-archives
+         unstable/text
          (for-template scheme/base)
          (for-syntax scheme/base)
          (for-label scheme)
          "private/syntax-core.ss"
          "private/define-core.ss"
          (for-template "private/define-core.ss")
-         "contract.ss"
-         "text.ss")
+         "contract.ss")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;

collects/unstable/cce/test/test-main.ss

@@ -18,7 +18,6 @@
          "test-scribble.ss"
          "test-set.ss"
          "test-syntax.ss"
-         "test-text.ss"
          "test-values.ss"
          "test-web.ss")
 
@@ -41,6 +40,5 @@
    scribble-suite
    set-suite
    syntax-suite
-   text-suite
    values-suite
    web-suite))

collects/unstable/cce/test/test-text.ss

@@ -1,136 +0,0 @@
-#lang scheme
-
-(require "checks.ss"
-         "../text.ss")
-
-(provide text-suite)
-
-(define text-suite
-  (test-suite "text.ss"
-    (test-suite "text/c"
-      (test-ok (with/c text/c "text"))
-      (test-ok (with/c text/c #"text"))
-      (test-ok (with/c text/c 'text))
-      (test-ok (with/c text/c '#:text))
-      (test-ok (with/c text/c #'"text"))
-      (test-ok (with/c text/c #'#"text"))
-      (test-ok (with/c text/c #'text))
-      (test-ok (with/c text/c #'#:text))
-      (test-bad (with/c text/c '(not text))))
-    (test-suite "text?"
-      (test-case "accept string"
-        (check-pred text? "text"))
-      (test-case "accept byte string"
-        (check-pred text? #"text"))
-      (test-case "accept symbol"
-        (check-pred text? 'text))
-      (test-case "accept keyword"
-        (check-pred text? '#:text))
-      (test-case "accept string literal"
-        (check-pred text? #'"text"))
-      (test-case "accept byte string literal"
-        (check-pred text? #'#"text"))
-      (test-case "accept identifier"
-        (check-pred text? #'text))
-      (test-case "accept keyword literal"
-        (check-pred text? #'#:text))
-      (test-case "reject non-text"
-        (check-false (text? '(not text)))))
-    (test-suite "string-literal?"
-      (test-case "accept" (check-true (string-literal? #'"string")))
-      (test-case "reject" (check-false (string-literal? "string"))))
-    (test-suite "keyword-literal?"
-      (test-case "accept" (check-true (keyword-literal? #'#:keyword)))
-      (test-case "reject" (check-false (keyword-literal? '#:keyword))))
-    (test-suite "bytes-literal?"
-      (test-case "accept" (check-true (bytes-literal? #'#"bytes")))
-      (test-case "reject" (check-false (bytes-literal? #"bytes"))))
-    (test-suite "text=?"
-      (test-case "string = string"
-        (check text=? "abc" (string-copy "abc")))
-      (test-case "string != string"
-        (check-not text=? "abc" (string-copy "cba")))
-      (test-case "string = identifier"
-        (check text=? "car" #'car))
-      (test-case "string != identifier"
-        (check-not text=? "car" #'cdr))
-      (test-case "identifier = identifier, different bindings"
-        (check text=? #'car (datum->syntax #f 'car)))
-      (test-case "identifier != identifier, no bindings"
-        (check-not text=? #'UNBOUND (datum->syntax #f 'ALSO-UNBOUND))))
-    (test-suite "text<?"
-      (test-case "string < string"
-        (check text<? "abc" "def"))
-      (test-case "string !< string"
-        (check-not text<? "abc" "abc"))
-      (test-case "string < identifier"
-        (check text<? "abc" #'def))
-      (test-case "string !< identifier"
-        (check-not text<? "abc" #'abc)))
-    (test-suite "text<=?"
-      (test-case "string <= string"
-        (check text<=? "abc" "abc"))
-      (test-case "string !<= string"
-        (check-not text<=? "def" "abc"))
-      (test-case "string <= identifier"
-        (check text<=? "abc" #'abc))
-      (test-case "string !<= identifier"
-        (check-not text<=? "def" #'abc)))
-    (test-suite "text>?"
-      (test-case "string > string"
-        (check text>? "def" "abc"))
-      (test-case "string !> string"
-        (check-not text>? "abc" "abc"))
-      (test-case "string > identifier"
-        (check text>? "def" #'abc))
-      (test-case "string !> identifier"
-        (check-not text>? "abc" #'abc)))
-    (test-suite "text>=?"
-      (test-case "string >= string"
-        (check text>=? "abc" "abc"))
-      (test-case "string !>= string"
-        (check-not text>=? "abc" "def"))
-      (test-case "string >= identifier"
-        (check text>=? "abc" #'abc))
-      (test-case "string !>= identifier"
-        (check-not text>=? "abc" #'def)))
-    (test-suite "text->string"
-      (test-case "single" (check-equal? (text->string 'abc) "abc"))
-      (test-case "multiple" (check-equal? (text->string 'a "b" #'c) "abc")))
-    (test-suite "text->symbol"
-      (test-case "single" (check-equal? (text->symbol "abc") 'abc))
-      (test-case "multiple" (check-equal? (text->symbol 'a "b" #'c) 'abc)))
-    (test-suite "text->keyword"
-      (test-case "single" (check-equal? (text->keyword #'abc) '#:abc))
-      (test-case "multiple" (check-equal? (text->keyword 'a "b" #'c) '#:abc)))
-    (test-suite "text->bytes"
-      (test-case "single" (check-equal? (text->bytes "abc") #"abc"))
-      (test-case "multiple" (check-equal? (text->bytes 'a "b" #'c) #"abc")))
-    (test-suite "text->identifier"
-      (test-case "single, no context"
-        (check-equal? (syntax-e (text->identifier "abc")) 'abc))
-      (test-case "multiple w/ context"
-        (check bound-identifier=?
-               (text->identifier #:stx #'here 'a "b" #'c)
-               #'abc)))
-    (test-suite "text->string-literal"
-      (test-case "single"
-        (check-equal? (syntax-e (text->string-literal '#:abc)) "abc"))
-      (test-case "multiple"
-        (check-equal?
-         (syntax-e (text->string-literal #:stx #'here 'a "b" #'c))
-         "abc")))
-    (test-suite "text->keyword-literal"
-      (test-case "single"
-        (check-equal? (syntax-e (text->keyword-literal #"abc")) '#:abc))
-      (test-case "multiple"
-        (check-equal?
-         (syntax-e (text->keyword-literal #:stx #'here 'a "b" #'c))
-         '#:abc)))
-    (test-suite "text->bytes-literal"
-      (test-case "single"
-        (check-equal? (syntax-e (text->bytes-literal 'abc)) #"abc"))
-      (test-case "multiple"
-        (check-equal?
-         (syntax-e (text->bytes-literal #:stx #'here 'a "b" #'c))
-         #"abc")))))

collects/unstable/cce/web.ss

@@ -1,8 +1,8 @@
 #lang scheme
 (require xml
          unstable/function
-         "define.ss"
-         "text.ss")
+         unstable/text
+         "define.ss")
 
 ;; css/c : FlatContract
 ;; Recognizes representations of Cascading Style Sheets.

collects/unstable/scribblings/text.scrbl

@@ -1,13 +1,11 @@
-#lang scribble/doc
-@(require scribble/manual
-          scribble/eval
-          "../scribble.ss"
-          "eval.ss")
-@(require (for-label scheme unstable/cce/text))
+#lang scribble/manual
+@(require scribble/eval "utils.rkt" (for-label racket unstable/text))
 
-@title[#:style 'quiet #:tag "cce-text"]{Text Representations}
+@title[#:tag "unstable-text"]{Text Representations}
 
-@defmodule[unstable/cce/text]
+@defmodule[unstable/text]
+
+@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
 
 This module provides tools for manipulating and converting textual data.
 
@@ -22,7 +20,7 @@ This contract and predicate recognize text values: strings, byte strings,
 symbols, and keywords, as well as syntax objects containing them.
 
 @defexamples[
-#:eval (evaluator 'unstable/cce/text)
+#:eval (eval/require 'unstable/text)
 (text? "text")
 (text? #"text")
 (text? 'text)
@@ -45,7 +43,7 @@ symbols, and keywords, as well as syntax objects containing them.
 These predicates recognize specific text types stored in syntax objects.
 
 @defexamples[
-#:eval (evaluator 'unstable/cce/text)
+#:eval (eval/require 'unstable/text)
 (string-literal? #'"literal")
 (string-literal? "not literal")
 (bytes-literal? #'#"literal")
@@ -82,7 +80,7 @@ These functions convert text values to specific types.  They concatenate each
 and back of the result and @scheme[between] between each argument.
 
 @defexamples[
-#:eval (evaluator 'unstable/cce/text)
+#:eval (eval/require 'unstable/text)
 (text->string #"concat" #'enate)
 (text->bytes #:between "-" 'concat #'#:enate)
 (text->symbol #:before "(" #:after ")" '#:concat #'"enate")
@@ -124,7 +122,7 @@ syntax object properties from the @scheme[stx] argument.  They concatenate each
 and back of the result and @scheme[between] between each argument.
 
 @defexamples[
-#:eval (evaluator 'unstable/cce/text)
+#:eval (eval/require 'unstable/text)
 (text->string-literal #"concat" #'enate)
 (text->bytes-literal #:between "-" 'concat #'#:enate)
 (text->identifier #:before "(" #:after ")"
@@ -159,7 +157,7 @@ equivalent to:
 ]
 
 @defexamples[
-#:eval (evaluator 'unstable/cce/text)
+#:eval (eval/require 'unstable/text)
 (text=? #"x" #'y)
 (text<? #"x" #'y)
 (text<=? #"x" #'y)

collects/unstable/scribblings/unstable.scrbl

@@ -85,6 +85,7 @@ Keep documentation and tests up to date.
 @include-section["string.scrbl"]
 @include-section["struct.scrbl"]
 @include-section["syntax.scrbl"]
+@include-section["text.scrbl"]
 @include-section["poly-c.scrbl"]
 @include-section["mutated-vars.scrbl"]
 @include-section["find.scrbl"]

collects/unstable/text.rkt

@@ -1,6 +1,6 @@
-#lang scheme/base
+#lang racket/base
 
-(require scheme/list scheme/match scheme/contract)
+(require racket/list racket/match racket/contract)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;