From 62a001decf51fd01321d462faf636c063a018757 Mon Sep 17 00:00:00 2001
From: John Clements <clements@racket-lang.org>
Date: Thu, 10 Apr 2014 16:05:07 -0700
Subject: [PATCH] rackety, add a test for annotation success on test cases in
 the stepper

---
 .../htdp-test/tests/stepper/annotation.rkt    | 13 ++++++++++++
 .../htdp-test/tests/stepper/test-engine.rkt   | 10 +++++++---
 .../htdp-test/tests/stepper/through-tests.rkt | 20 +++++++++++--------
 3 files changed, 32 insertions(+), 11 deletions(-)
 create mode 100644 pkgs/htdp-pkgs/htdp-test/tests/stepper/annotation.rkt

diff --git a/pkgs/htdp-pkgs/htdp-test/tests/stepper/annotation.rkt b/pkgs/htdp-pkgs/htdp-test/tests/stepper/annotation.rkt
new file mode 100644
index 0000000000..6280121ead
--- /dev/null
+++ b/pkgs/htdp-pkgs/htdp-test/tests/stepper/annotation.rkt
@@ -0,0 +1,13 @@
+#lang racket/base
+
+(require stepper/private/annotate
+         "test-engine.rkt"
+         "language-level-model.rkt")
+
+(define (try-annotating str)
+  (define expanded 
+    (car (string->expanded-syntax-list intermediate str)))
+  (printf "expanded: ~s\n" expanded)
+  (annotate expanded (lambda (a b c) 'bogus) #f))
+
+(try-annotating "(check-expect 2 2)")
\ No newline at end of file
diff --git a/pkgs/htdp-pkgs/htdp-test/tests/stepper/test-engine.rkt b/pkgs/htdp-pkgs/htdp-test/tests/stepper/test-engine.rkt
index 078d34e841..6cdc5fd28b 100644
--- a/pkgs/htdp-pkgs/htdp-test/tests/stepper/test-engine.rkt
+++ b/pkgs/htdp-pkgs/htdp-test/tests/stepper/test-engine.rkt
@@ -1,4 +1,4 @@
-#lang scheme
+#lang racket
 
 (require stepper/private/shared
          stepper/private/model
@@ -9,6 +9,9 @@
          "language-level-model.rkt")
 
 
+(provide (contract-out [string->expanded-syntax-list (-> ll-model? string? (listof syntax?))]
+                       [run-one-test (-> symbol? model-or-models/c string? (listof step?) (listof (list/c string? string?)) boolean?)]))
+
 ;; A SIMPLE EXAMPLE OF USING THIS FRAMEWORK:
 
 ;; note that this example uses the abbreviation from test-abbrev; don't uncomment it!
@@ -77,7 +80,7 @@
 
 ;; THE METHOD THAT RUNS A TEST:
 
-(provide/contract [run-one-test (symbol? model-or-models/c string? (listof step?) (listof (list/c string? string?)) . -> . boolean?)])
+
 ;; run-one-test : symbol? model-or-models? string? steps? extra-files -> boolean?
 
 ;; the ll-model determines the behavior of the stepper w.r.t. "language-level"-y things:
@@ -104,7 +107,8 @@
                #f)
         #t)))
 
-(provide/contract [string->expanded-syntax-list (-> ll-model? string? (listof syntax?))])
+
+
 (define (string->expanded-syntax-list ll-model exp-str)
   (define expander-thunk ((string->expander-thunk ll-model exp-str)))
   (let loop ()
diff --git a/pkgs/htdp-pkgs/htdp-test/tests/stepper/through-tests.rkt b/pkgs/htdp-pkgs/htdp-test/tests/stepper/through-tests.rkt
index e5477adfa6..9b271b58b8 100755
--- a/pkgs/htdp-pkgs/htdp-test/tests/stepper/through-tests.rkt
+++ b/pkgs/htdp-pkgs/htdp-test/tests/stepper/through-tests.rkt
@@ -5,6 +5,9 @@
          "test-engine.rkt"
          "test-cases.rkt"
          
+         ;; poor man's testing:
+         "annotation.rkt"
+         
          ;; for xml testing:
          ;; mzlib/class
          ;; (all-except xml/xml-snipclass snip-class)
@@ -13,6 +16,9 @@
 
          )
 
+(require stepper/private/annotate)
+
+
 
 (provide run-test run-tests run-all-tests run-all-tests-except)
 
@@ -98,9 +104,8 @@
       #;(run-tests '(check-expect forward-ref check-within check-within-bad
                                   check-error check-error-bad))
       #;(run-tests '(teachpack-universe))
-      (run-test 'let*-deriv)
-      #;(run-test 'letrec1)
-      #;(run-test 'require-test)
+      #;(run-test 'check-expect)
+      (run-all-tests)
 
       #;(string->expanded-syntax-list m:mz "(if true 3 4)"
                                     #;"(define (a3 x) (if true x x))")
@@ -114,8 +119,7 @@
         [(_ _ _ 
             (_ _ (_ _ (_ _ it) _))) #'it])
       ))
-  
-  
-  
-  
-  
+
+
+
+