Skip to content

Commit 5313e3b

Browse files
rfindlerrfindler
committed
test cases for arrows from define-local-member-name
1 parent 0386971 commit 5313e3b

File tree

1 file changed

+221
-0
lines changed

1 file changed

+221
-0
lines changed

‎drracket-tool-test/tests/check-syntax/syncheck-direct.rkt

+221
Original file line numberDiff line numberDiff line change
@@ -520,6 +520,227 @@
520520
'((66 77) (92 95)) ;; sketchy; should we eliminate?
521521
'((85 88) (92 95))))
522522

523+
524+
525+
;
526+
;
527+
;
528+
;
529+
;
530+
; ;;; ;;;;;;; ;;; ;;;
531+
; ;;; ;;; ;;; ;;;
532+
; ;; ;;; ;;; ;;;;; ;;; ;;; ;; ;;; ;;; ;;; ;;; ;;;;; ;;;
533+
; ;;;;;;; ;;;;; ;;;;; ;;; ;;;;;;; ;;;;; ;;; ;;;;; ;;;;; ;;;;;;; ;;;
534+
; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
535+
; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;; ;;; ;;; ;;; ;;; ;;;; ;;; ;;;;
536+
; ;;; ;;; ;;;;;;; ;;; ;;; ;;; ;;; ;;;;;;; ;;;; ;;; ;;; ;;; ;;; ;; ;;; ;;; ;;;;
537+
; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
538+
; ;;;;;;; ;;;;;; ;;; ;;; ;;; ;;; ;;;;;; ;;; ;;;;; ;;;;; ;;;;;;; ;;;
539+
; ;; ;;; ;;;; ;;; ;;; ;;; ;;; ;;;; ;;; ;;; ;;; ;;;;;; ;;;
540+
;
541+
;
542+
;
543+
;
544+
;
545+
; ;;;
546+
; ;;;
547+
; ;;; ;; ;;; ;;; ;;; ;; ;;; ;;; ;; ;;; ;;; ;; ;;; ;; ;;;;; ;;; ;; ;;; ;;;
548+
; ;;;;;;;;;;; ;;;;; ;;;;;;;;;;; ;;;;;;; ;;;;; ;;;;; ;;;;;;; ;;;;;;; ;;;;;;;;;;; ;;;;;
549+
; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
550+
; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;; ;;; ;;; ;;;; ;;; ;;; ;;; ;;; ;;;
551+
; ;;; ;;; ;;; ;;;;;;; ;;; ;;; ;;; ;;; ;;; ;;;;;;; ;;; ;;;; ;;; ;;; ;; ;;; ;;; ;;; ;;; ;;;;;;;
552+
; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;
553+
; ;;; ;;; ;;; ;;;;;; ;;; ;;; ;;; ;;;;;;; ;;;;;; ;;; ;;; ;;; ;;;;;;; ;;; ;;; ;;; ;;;;;;
554+
; ;;; ;;; ;;; ;;;; ;;; ;;; ;;; ;;; ;; ;;;; ;;; ;;; ;;; ;;;;;; ;;; ;;; ;;; ;;;;
555+
;
556+
;
557+
;
558+
;
559+
;
560+
561+
562+
(check-equal?
563+
(for/set ([e (in-set
564+
(get-binding-arrows
565+
(string-append
566+
"(module m racket\n"
567+
" (define-local-member-name the-method-name)\n"
568+
" (class object% (define/public (the-method-name x) 0))\n"
569+
" (send #f the-method-name))\n")))]
570+
;; filter out arrows that don't start on `the-method-name`
571+
#:when (equal? '(45 60) (car e)))
572+
e)
573+
(set
574+
'((45 60) (129 144))
575+
'((45 60) (95 110))))
576+
577+
(check-equal?
578+
(for/set ([e (in-set
579+
(get-binding-arrows
580+
(string-append
581+
"(module m racket\n"
582+
" (define-local-member-name the-method-name)\n"
583+
" (class object%\n"
584+
" (define/public (the-method-name n)\n"
585+
" (unless (zero? n)\n"
586+
" (if (even? n)\n"
587+
" (send this the-method-name (- n 1))\n"
588+
" (the-method-name (- n 1)))))))\n")))]
589+
;; filter out arrows that don't start on the
590+
;; `the-method-name` that appears inside
591+
;; `define-local-member-name`
592+
#:when (equal? '(45 60) (car e)))
593+
e)
594+
(set
595+
'((45 60) (99 114))
596+
'((45 60) (187 202))
597+
'((45 60) (225 240))))
598+
599+
(check-equal?
600+
(for/set ([e (in-set
601+
(get-binding-arrows
602+
(string-append
603+
"(module m racket\n"
604+
" (define-local-member-name the-method-name)\n"
605+
" (define c%\n"
606+
" (class object%\n"
607+
" (define/pubment (the-method-name n)\n"
608+
" (inner 0 the-method-name n))\n"
609+
" (super-new))))\n")))]
610+
;; filter out arrows that don't start on the
611+
;; `the-method-name` that appears inside
612+
;; `define-local-member-name`
613+
#:when (equal? '(45 60) (car e)))
614+
e)
615+
(set
616+
'((45 60) (117 132))
617+
'((45 60) (153 168))))
618+
619+
(check-equal?
620+
(for/set ([e (in-set
621+
(get-binding-arrows
622+
(string-append
623+
"(module m racket\n"
624+
" (define-local-member-name the-method-name)\n"
625+
" (define c%\n"
626+
" (class object%\n"
627+
" (define/override (the-method-name n)\n"
628+
" (super the-method-name n))\n"
629+
" (super-new))))\n")))]
630+
;; filter out arrows that don't start on the
631+
;; `the-method-name` that appears inside
632+
;; `define-local-member-name`
633+
#:when (equal? '(45 60) (car e)))
634+
e)
635+
(set
636+
'((45 60) (118 133))
637+
'((45 60) (152 167))))
638+
639+
(check-equal?
640+
(for/set ([e (in-set
641+
(get-binding-arrows
642+
(string-append
643+
"(module m racket\n"
644+
" (define-local-member-name the-method-name)\n"
645+
" (class* object% ()\n"
646+
" (define/public the-method-name\n"
647+
" (letrec ([f (λ ()\n"
648+
" (the-method-name)\n"
649+
" (send this the-method-name))])\n"
650+
" f))\n"
651+
" (super-new)))\n")))]
652+
;; filter out arrows that don't start on the
653+
;; `the-method-name` that appears inside
654+
;; `define-local-member-name`
655+
#:when (equal? '(45 60) (car e)))
656+
e)
657+
(set
658+
'((45 60) (102 117))
659+
'((45 60) (163 178))
660+
'((45 60) (211 226))))
661+
662+
663+
664+
(check-equal?
665+
(for/set ([e (in-set
666+
(get-binding-arrows
667+
(string-append
668+
"(module m racket\n"
669+
" (define-local-member-name the-init-name)\n"
670+
" (define c%\n"
671+
" (class* object% ()\n"
672+
" (init [the-init-name (λ (x) x)])\n"
673+
" (set! the-init-name void)\n"
674+
" (list the-init-name)\n"
675+
" (the-init-name 5)\n"
676+
" (super-new))))\n")))]
677+
;; filter out arrows that don't start on the
678+
;; `the-init-name` that appears inside
679+
;; `define-local-member-name`
680+
#:when (equal? '(45 58) (car e)))
681+
e)
682+
(set
683+
'((45 58) (109 122))
684+
'((45 58) (147 160))
685+
'((45 58) (179 192))
686+
'((45 58) (201 214))))
687+
688+
(check-equal?
689+
(for/set ([e (in-set
690+
(get-binding-arrows
691+
(string-append
692+
"(module m racket\n"
693+
" (define-local-member-name the-field-name)\n"
694+
" (define c%\n"
695+
" (class* object% ()\n"
696+
" (field [the-field-name (λ (x) x)])\n"
697+
" (set! the-field-name void)\n"
698+
" (list the-field-name)\n"
699+
" (the-field-name 5)\n"
700+
" (super-new)))\n"
701+
"\n"
702+
" (class c%\n"
703+
" (inherit-field the-field-name)\n"
704+
" (super-new)))\n")))]
705+
;; filter out arrows that don't start on the
706+
;; `the-init-name` that appears inside
707+
;; `define-local-member-name`
708+
#:when (equal? '(45 59) (car e)))
709+
e)
710+
(set
711+
'((45 59) (111 125))
712+
'((45 59) (150 164))
713+
'((45 59) (183 197))
714+
'((45 59) (206 220))
715+
'((45 59) (276 290))))
716+
717+
(check-equal?
718+
(for/set ([e (in-set
719+
(get-binding-arrows
720+
(string-append
721+
"(module m racket\n"
722+
" (define-local-member-name\n"
723+
" the-method-name1\n"
724+
" the-method-name2)\n"
725+
" (define (m %)\n"
726+
" (class* % ()\n"
727+
" (rename-super [the-super-method-name the-method-name1])\n"
728+
" (rename-inner [the-inner-method-name the-method-name2])\n"
729+
" (define/public (m x)\n"
730+
" (the-super-method-name x)\n"
731+
" (the-inner-method-name (lambda () 0) x))\n"
732+
" (super-new))))\n")))]
733+
;; filter out arrows that don't start on the
734+
;; `the-init-name` that appears inside
735+
;; `define-local-member-name`
736+
#:when (member (car e) (list '(49 65) '(70 86))))
737+
e)
738+
(set
739+
'((49 65) (164 180))
740+
'((70 86) (226 242))))
741+
742+
743+
523744
;
524745
;
525746
;

0 commit comments

Comments
 (0)