Fix contracts for structs with the same name (PR 15330) (#410)

Fix contracts for structs with the same name

Closes PR 15330

typed-racket-lib/typed-racket/static-contracts/combinators/simple.rkt

@@ -30,16 +30,26 @@
   (display close port))
 
 
+;; check equality of two syntax objects by structural traversal
+;; where identifiers are compared by free-identifier=?
+;;
+;; Note: does not handle cycles but there shouldn't be any
+(define (stx-equal? s1 s2)
+  (cond [(and (identifier? s1) (identifier? s2))
+         (free-identifier=? s1 s2)]
+        [else
+         (if (and (syntax? s1) (syntax? s2))
+             (equal?/recur (syntax-e s1) (syntax-e s2) stx-equal?)
+             (equal?/recur s1 s2 stx-equal?))]))
 
 (struct simple-contract static-contract (syntax kind name)
         #:transparent
         #:methods gen:equal+hash
          [(define (equal-proc s1 s2 recur)
-            (and ;; only check s-expression equality because it's
-                 ;; unlikely that TR will compile contracts that are
-                 ;; s-exp equal but aren't actually the same contract
-                 (recur (syntax->datum (simple-contract-syntax s1))
-                        (syntax->datum (simple-contract-syntax s2)))
+            (and ;; have to make sure identifiers are compared by free-id=?
+                 ;; because of struct predicates, opaque, etc.
+                 (stx-equal? (simple-contract-syntax s1)
+                             (simple-contract-syntax s2))
                  (recur (simple-contract-kind s1)
                         (simple-contract-kind s2))
                  (recur (simple-contract-name s1)

typed-racket-test/succeed/pr15330.rkt

@@ -0,0 +1,22 @@
+#lang racket/base
+
+;; Test for PR 15330
+;;
+;; Make sure struct contracts with the same name bound in different
+;; places will work correctly
+
+(module base typed/racket/base
+ 
+  (provide (struct-out Record))
+  (struct Record ([id : Integer]) #:transparent))
+
+(module yy typed/racket/base
+ 
+  (require (prefix-in roles: (submod ".." base)))
+  (provide (struct-out Record))
+  (struct Record ([subrec : roles:Record]) #:transparent))
+
+(require (prefix-in role: 'yy)
+         (prefix-in roles: 'base))
+         
+(role:Record-subrec (role:Record (roles:Record 0)))

typed-racket-test/unit-tests/static-contract-equality-tests.rkt

@@ -0,0 +1,27 @@
+#lang racket/base
+
+;; Tests for equality predicates on static contract values
+
+(require rackunit
+         typed-racket/static-contracts/combinators)
+
+;; these should be equal for optimizations to kick in
+(check-equal? (flat/sc #'(quote 3)) (flat/sc #'(quote 3)))
+(check-equal? (flat/sc #'(lambda (x) (integer? x)))
+              (flat/sc #'(lambda (x) (integer? x))))
+
+(define (make-stx id)
+  #`(lambda (x) (#,id x)))
+(define foo-stx-1 (make-stx #'foo?))
+(define foo-stx-2 (make-stx #'foo?))
+
+(parameterize ([current-namespace (make-base-namespace)])
+  (eval #'(struct foo (x)))
+  (define foo-stx-3 (make-stx (expand #'foo?)))
+  (define foo-stx-4 (make-stx (expand #'foo?)))
+
+  (check-equal? (flat/sc foo-stx-1) (flat/sc foo-stx-2))
+  (check-equal? (flat/sc foo-stx-3) (flat/sc foo-stx-4))
+
+  ;; these shouldn't be equal because bindings are different
+  (check-not-equal? (flat/sc foo-stx-1) (flat/sc foo-stx-3)))