Skip to content

Commit ac9cc47

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

File tree

1 file changed

+283
-0
lines changed

1 file changed

+283
-0
lines changed

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

Lines changed: 283 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -520,6 +520,289 @@
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+
(check-equal?
743+
(for/set ([e (in-set
744+
(get-binding-arrows
745+
(string-append
746+
"(module m racket\n"
747+
" (define-local-member-name the-method-name)\n"
748+
" (define %\n"
749+
" (class* object% ()\n"
750+
" (define/public (the-method-name x)\n"
751+
" (class object%\n"
752+
" (define/public (the-method-name x)\n"
753+
" x)\n"
754+
" (super-new)))\n"
755+
" (define/public (another-method)\n"
756+
" (class object%\n"
757+
" (define/public (the-method-name x)\n"
758+
" x)\n"
759+
" (super-new)))\n"
760+
" (super-new))))\n")))]
761+
;; filter out arrows that don't start on the
762+
;; `the-init-name` that appears inside
763+
;; `define-local-member-name`
764+
#:when (equal? (car e) '(45 60)))
765+
e)
766+
(set
767+
'((45 60) (119 134))
768+
'((45 60) (187 202))
769+
'((45 60) (332 347))))
770+
771+
(check-equal?
772+
(for/set ([e (in-set
773+
(get-binding-arrows
774+
(string-append
775+
"(module m racket\n"
776+
" (define-local-member-name the-method-name)\n"
777+
" (define %\n"
778+
" (class* object% ()\n"
779+
" (define/public (the-method-name x)\n"
780+
" (class object%\n"
781+
" (define/public (the-method-name x)\n"
782+
" (the-method-name x)\n"
783+
" (send this the-method-name x))\n"
784+
" (super-new)))\n"
785+
" (define/public (another-method)\n"
786+
" (class object%\n"
787+
" (define/public (the-method-name x)\n"
788+
" (the-method-name x)\n"
789+
" (send this the-method-name x))\n"
790+
" (super-new)))\n"
791+
" (super-new))))\n")))]
792+
;; `the-init-name` that appears inside
793+
;; `define-local-member-name`
794+
#:when (equal? (car e) '(45 60)))
795+
e)
796+
(set
797+
'((45 60) (119 134))
798+
'((45 60) (187 202))
799+
'((45 60) (219 234))
800+
'((45 60) (261 276))
801+
'((45 60) (392 407))
802+
'((45 60) (424 439))
803+
'((45 60) (466 481))))
804+
805+
523806
;
524807
;
525808
;

0 commit comments

Comments
 (0)