tests for wrap-expr/c, no build-time paths
This commit is contained in:
parent
bcb6299b4b
commit
a4eddbd63d
9
pkgs/racket-test/tests/syntax/contract/client1-1.rkt
Normal file
9
pkgs/racket-test/tests/syntax/contract/client1-1.rkt
Normal file
|
@ -0,0 +1,9 @@
|
||||||
|
#lang racket/base
|
||||||
|
(require tests/syntax/contract/macro1)
|
||||||
|
(provide go)
|
||||||
|
|
||||||
|
(define (go)
|
||||||
|
(m 'not-a-string))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(void))
|
9
pkgs/racket-test/tests/syntax/contract/client1-2.rkt
Normal file
9
pkgs/racket-test/tests/syntax/contract/client1-2.rkt
Normal file
|
@ -0,0 +1,9 @@
|
||||||
|
#lang racket/base
|
||||||
|
(require "macro1.rkt")
|
||||||
|
(provide go)
|
||||||
|
|
||||||
|
(define (go)
|
||||||
|
(m 'not-a-string))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(void))
|
22
pkgs/racket-test/tests/syntax/contract/macro1.rkt
Normal file
22
pkgs/racket-test/tests/syntax/contract/macro1.rkt
Normal file
|
@ -0,0 +1,22 @@
|
||||||
|
#lang racket/base
|
||||||
|
(require (for-syntax racket/base syntax/contract))
|
||||||
|
(provide m go)
|
||||||
|
|
||||||
|
(define-syntax (m stx)
|
||||||
|
(syntax-case stx ()
|
||||||
|
[(_ e1)
|
||||||
|
(with-syntax ([c1 (wrap-expr/c #'string? #'e1
|
||||||
|
#:context stx
|
||||||
|
#:positive 'use-site
|
||||||
|
#:negative 'from-macro)])
|
||||||
|
#'(string-length c1))]))
|
||||||
|
|
||||||
|
(define (go)
|
||||||
|
(m 'not-a-string))
|
||||||
|
|
||||||
|
(module+ main
|
||||||
|
;; (go)
|
||||||
|
(m 'also-not-a-string))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(void))
|
25
pkgs/racket-test/tests/syntax/contract/macro2.rkt
Normal file
25
pkgs/racket-test/tests/syntax/contract/macro2.rkt
Normal file
|
@ -0,0 +1,25 @@
|
||||||
|
#lang racket/base
|
||||||
|
(provide go)
|
||||||
|
|
||||||
|
(module defmac racket/base
|
||||||
|
(require (for-syntax racket/base syntax/contract))
|
||||||
|
(provide m)
|
||||||
|
|
||||||
|
(define-syntax (m stx)
|
||||||
|
(syntax-case stx ()
|
||||||
|
[(_ e1)
|
||||||
|
(with-syntax ([c1 (wrap-expr/c #'string? #'e1
|
||||||
|
#:context stx
|
||||||
|
#:positive 'use-site
|
||||||
|
#:negative 'from-macro)])
|
||||||
|
#'(string-length c1))])))
|
||||||
|
(require 'defmac)
|
||||||
|
|
||||||
|
(define (go)
|
||||||
|
(m 'not-a-string))
|
||||||
|
|
||||||
|
(module+ main
|
||||||
|
(m 'also-not-a-string))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(void))
|
24
pkgs/racket-test/tests/syntax/contract/test-exprc-paths.rkt
Normal file
24
pkgs/racket-test/tests/syntax/contract/test-exprc-paths.rkt
Normal file
|
@ -0,0 +1,24 @@
|
||||||
|
#lang racket/base
|
||||||
|
(require (for-syntax racket/base)
|
||||||
|
racket/file
|
||||||
|
rackunit
|
||||||
|
racket/runtime-path)
|
||||||
|
|
||||||
|
;; Check that the compiled example files (macro*.rkt, client*.rkt) do
|
||||||
|
;; not contain absolute paths. In particular, we look for the fragment
|
||||||
|
;; "pkgs/racket-test".
|
||||||
|
|
||||||
|
(define bad (path->bytes (build-path "pkgs" "racket-test")))
|
||||||
|
(define bad-rx (regexp-quote bad))
|
||||||
|
|
||||||
|
(define-runtime-path compiled "compiled")
|
||||||
|
(define test-files
|
||||||
|
'("macro1_rkt.zo" "client1-1_rkt.zo" "client1-2_rkt.zo" "macro2_rkt.zo"))
|
||||||
|
|
||||||
|
(for ([file0 test-files])
|
||||||
|
(define file (build-path compiled file0))
|
||||||
|
(cond [(file-exists? file)
|
||||||
|
(define code-b (file->bytes file))
|
||||||
|
(check-false (regexp-match bad-rx code-b))]
|
||||||
|
[else
|
||||||
|
(printf "skipping ~e, does not exist\n" file)]))
|
Loading…
Reference in New Issue
Block a user