First hacky solution to fixing toplevel interactions, and tests.

Closes PR 14161.

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/core.rkt

@@ -11,7 +11,7 @@
          (types utils abbrev generalize printer)
          (typecheck provide-handling tc-toplevel tc-app-helper)
          (rep type-rep)
-         (for-template (only-in (base-env prims) :type :print-type :query-type/result))
+         (for-template (only-in (base-env prims) :type :print-type :query-type/args :query-type/result))
          (utils utils tc-utils arm)
          "tc-setup.rkt")
 
@@ -72,8 +72,10 @@
                        (format "[can expand further: ~a]"
                                (string-join (map ~a unexpanded)))))
        #`(display #,(format "~a\n~a" type cue)))]
+    [(_ . (~and form ((~literal :type) . _)))
+     (raise-syntax-error #f "must be applied to exactly one argument" #'form)]
     ;; Prints the _entire_ type. May be quite large.
-    [(_ . ((~literal :print-type) e:expr))
+    [(_ . ((~literal :print-type) e))
      (tc-setup #'stx #'e 'top-level expanded init tc-toplevel-form before type
                #`(display
                   #,(parameterize ([print-multi-line-case-> #t])
@@ -81,8 +83,10 @@
                                        [(tc-result1: t f o) t]
                                        [(tc-results: t) (cons 'Values t)]
                                        [(tc-any-results:) ManyUniv])))))]
+    [(_ . (~and form ((~literal :print-type) . _)))
+     (raise-syntax-error #f "must be applied to exactly one argument" #'form)]
     ;; given a function and input types, display the result type
-    [(_ . ((~literal :query-type/args) op:expr arg-type:expr ...))
+    [(_ . ((~literal :query-type/args) op arg-type ...))
      (with-syntax ([(dummy-arg ...) (generate-temporaries #'(arg-type ...))])
        (tc-setup #'stx
                  ;; create a dummy function with the right argument types
@@ -94,8 +98,10 @@
                     #,(format "~a\n"
                               (match type
                                 [(tc-result1: (and t (Function: _)) f o) t])))))]
+    [(_ . (~and form ((~literal :query-type/args) . _)))
+     (raise-syntax-error #f "must be applied to at least one argument" #'form)]
     ;; given a function and a desired return type, fill in the blanks
-    [(_ . ((~literal :query-type/result) op:expr desired-type:expr))
+    [(_ . ((~literal :query-type/result) op desired-type))
      (let ([expected (parse-type #'desired-type)])
        (tc-setup #'stx #'op 'top-level expanded init tc-toplevel-form before type
                  (match type
@@ -108,6 +114,8 @@
                              [(Function: arrs)
                               (format "~a\n" cleaned)])))]
                    [_ (error (format "~a: not a function" (syntax->datum #'op) ))])))]
+    [(_ . (~and form ((~literal :query-type/result) . _)))
+     (raise-syntax-error #f "must be applied to exactly two arguments" #'form)]
     [(_ . form)
      (init)
      (tc-setup

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/all-tests.rkt

@@ -15,6 +15,7 @@
 
  "module-tests.rkt" ;; pass
  "contract-tests.rkt"
+ "interactive-tests.rkt"
 
  racket/runtime-path
  rackunit rackunit/text-ui)
@@ -40,6 +41,7 @@
                   fv-tests
                   contract-tests
                   keyword-tests
+                  interactive-tests
                   ;; this uses dynamic require because the file fails to compile when there's a test failure
                   (λ () ((dynamic-require special 'typecheck-special-tests))))])
      (f))))

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt

@@ -0,0 +1,80 @@
+#lang racket/base
+
+(require
+  racket/base
+  racket/port
+  racket/promise
+  rackunit
+  (for-syntax
+    racket/base
+    racket/format
+    syntax/parse))
+
+(provide interactive-tests)
+
+(define promised-ns
+  (delay
+    (define ns (make-base-namespace))
+    (eval '(require typed/racket) ns)
+    ;; Load TR code. TODO make this not needed (pr/13102)
+    (eval '(#%top-interaction void) ns)
+    ns))
+
+(define-syntax (test-form-exn stx)
+  (syntax-parse stx
+    [(_ regexp:expr form:expr)
+     (quasisyntax/loc stx
+       (test-case #,(~a (syntax->datum #'form))
+         (check-exn
+           regexp
+           (lambda ()
+             (eval `(#%top-interaction .
+                     ,(syntax->datum #'form)) (force promised-ns))))))]))
+
+(define-syntax (test-form stx)
+  (syntax-parse stx
+    [(_ regexp:expr form:expr)
+     (quasisyntax/loc stx
+       (test-case #,(~a (syntax->datum #'form))
+         (check-regexp-match
+           regexp
+           (with-output-to-string
+             (lambda ()
+               (eval `(#%top-interaction .
+                       ,(syntax->datum #'form)) (force promised-ns)))))))]))
+
+(define (interactive-tests)
+  (test-suite "Interactive tests"
+    (test-form #rx"1"
+      (:type 1))
+    (test-form (regexp-quote "(U Positive-Byte Zero)")
+      (:type Byte))
+    (test-form (regexp-quote "(U 0 1 Byte-Larger-Than-One")
+      (:type #:verbose Byte))
+    (test-form-exn #rx"applied to arguments"
+      :type)
+    (test-form-exn #rx"exactly one argument"
+      (:type))
+    (test-form-exn #rx"exactly one argument"
+      (:type 1 2))
+    (test-form-exn #rx"exactly one argument"
+      (:type #:verbose))
+
+    (test-form-exn #rx"applied to arguments"
+      :print-type)
+    (test-form-exn #rx"exactly one argument"
+      (:print-type))
+    (test-form-exn #rx"exactly one argument"
+      (:print-type 1 2))
+
+    (test-form-exn #rx"applied to arguments"
+      :query-type/args)
+    (test-form-exn #rx"at least one argument"
+      (:query-type/args))
+
+    (test-form-exn #rx"applied to arguments"
+      :query-type/result)
+    (test-form-exn #rx"exactly two arguments"
+      (:query-type/result))
+    (test-form-exn #rx"exactly two arguments"
+      (:query-type/result 1 2 3))))