From 03900fe84fafdb78ce087dda49eceedf32a5938f Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Tue, 21 Jun 2011 14:02:05 -0400 Subject: [PATCH] Fixes TR regexp regression. Closes PR11991. original commit: 0f6fde5003c1594c468b82df8cf64a2ce17f65f5 --- .../unit-tests/typecheck-tests.rkt | 57 +++++++++++++ .../base-env/base-env-indexing-abs.rkt | 85 +++++++++---------- 2 files changed, 95 insertions(+), 47 deletions(-) diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt index 1447816b..f525e25c 100644 --- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt +++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt @@ -980,6 +980,63 @@ (tc-e (eq? 1 2) B) (tc-e (equal?/recur 'foo 'bar eq?) B) + ;Regexps + (tc-e (regexp-match "foo" "foobar") (-opt (-pair -String (-lst (-opt -String))))) + (tc-e (regexp-match #"foo" #"foobar") (-opt (-pair -Bytes (-lst (-opt -Bytes))))) + (tc-e (regexp-match #rx"foo" "foobar") (-opt (-pair -String (-lst (-opt -String))))) + (tc-e (regexp-match #rx#"foo" #"foobar") (-opt (-pair -Bytes (-lst (-opt -Bytes))))) + (tc-e (regexp-match #px"foo" "foobar") (-opt (-pair -String (-lst (-opt -String))))) + (tc-e (regexp-match #px#"foo" #"foobar") (-opt (-pair -Bytes (-lst (-opt -Bytes))))) + + (tc-e (regexp-match "foo" #"foobar") (-opt (-pair -Bytes (-lst (-opt -Bytes))))) + (tc-e (regexp-match #"foo" "foobar") (-opt (-pair -Bytes (-lst (-opt -Bytes))))) + (tc-e (regexp-match #rx"foo" #"foobar") (-opt (-pair -Bytes (-lst (-opt -Bytes))))) + (tc-e (regexp-match #rx#"foo" "foobar") (-opt (-pair -Bytes (-lst (-opt -Bytes))))) + (tc-e (regexp-match #px"foo" #"foobar") (-opt (-pair -Bytes (-lst (-opt -Bytes))))) + (tc-e (regexp-match #px#"foo" "foobar") (-opt (-pair -Bytes (-lst (-opt -Bytes))))) + + (tc-e (regexp-match "foo" (string->path "tmp")) (-opt (-pair -String (-lst (-opt -String))))) + (tc-e (regexp-match #"foo" (string->path "tmp")) (-opt (-pair -Bytes (-lst (-opt -Bytes))))) + (tc-e (regexp-match "foo" (open-input-string "tmp")) (-opt (-pair -Bytes (-lst (-opt -Bytes))))) + (tc-e (regexp-match #"foo" (open-input-string "tmp")) (-opt (-pair -Bytes (-lst (-opt -Bytes))))) + + (tc-e (regexp-match* "foo" "foobar") (-lst -String)) + (tc-e (regexp-match* "foo" #"foobar") (-lst -Bytes)) + (tc-e (regexp-match* #"foo" "foobar") (-lst -Bytes)) + (tc-e (regexp-match* #"foo" #"foobar") (-lst -Bytes)) + + + (tc-err (regexp-try-match "foo" "foobar")) + (tc-e (regexp-try-match "foo" (open-input-string "foobar")) (-opt (-pair -Bytes (-lst (-opt -Bytes))))) + + (tc-err (regexp-match-peek "foo" "foobar")) + (tc-e (regexp-match-peek "foo" (open-input-string "foobar")) (-opt (-pair -Bytes (-lst (-opt -Bytes))))) + + (tc-err (regexp-match-peek-immediate "foo" "foobar")) + (tc-e (regexp-match-peek-immediate "foo" (open-input-string "foobar")) (-opt (-pair -Bytes (-lst (-opt -Bytes))))) + + + + [tc-e (regexp-match/end "foo" "foobar") #:ret (ret (list (-opt (-pair -String (-lst (-opt -String)))) (-opt -Bytes)) (list (-FS -top -top) (-FS -top -top)))] + + (tc-e (regexp-split "foo" "foobar") (-pair -String (-lst -String))) + (tc-e (regexp-split "foo" #"foobar") (-pair -Bytes (-lst -Bytes))) + (tc-e (regexp-split #"foo" "foobar") (-pair -Bytes (-lst -Bytes))) + (tc-e (regexp-split #"foo" #"foobar") (-pair -Bytes (-lst -Bytes))) + + (tc-err (regexp-split "foo" (path->string "foobar"))) + + (tc-e (regexp-replace "foo" "foobar" "rep") -String) + (tc-e (regexp-replace #"foo" "foobar" "rep") -Bytes) + (tc-e (regexp-replace "foo" #"foobar" "rep") -Bytes) + (tc-e (regexp-replace "foo" #"foobar" #"rep") -Bytes) + + (tc-err (regexp-replace "foo" "foobar" #"rep")) + (tc-e (regexp-replace "foo" "foobar" (lambda: (args : String *) "foo")) -String) + (tc-e (regexp-replace "foo" #"foobar" (lambda: (args : Bytes *) #"foo")) -Bytes) + (tc-err (regexp-replace "foo" "foobar" (lambda: (args : Bytes *) #"foo"))) + (tc-err (regexp-replace #"foo" "foobar" (lambda: (args : String *) "foo"))) + ) (test-suite "check-type tests" diff --git a/collects/typed-scheme/base-env/base-env-indexing-abs.rkt b/collects/typed-scheme/base-env/base-env-indexing-abs.rkt index 4e87bd5e..8fc6e602 100644 --- a/collects/typed-scheme/base-env/base-env-indexing-abs.rkt +++ b/collects/typed-scheme/base-env/base-env-indexing-abs.rkt @@ -75,30 +75,33 @@ [optlist (lambda (t) (-opt (-pair t (-lst (-opt t)))))] [-StrRx (Un -String -Regexp)] [-BtsRx (Un -Bytes -Byte-Regexp)] - [-Input (Un -String -Input-Port -Bytes -Path)]) + [-StrInput (Un -String -Path)] + [-BtsInput (Un -Input-Port -Bytes)]) (cl->* - (-StrRx -Input [N ?N ?outp -Bytes] . ->opt . (optlist -String)) - (-BtsRx -Input [N ?N ?outp -Bytes] . ->opt . (optlist -Bytes))))] + (-StrRx -StrInput [N ?N ?outp -Bytes] . ->opt . (optlist -String)) + (-BtsRx (Un -StrInput -BtsInput) [N ?N ?outp -Bytes] . ->opt . (optlist -Bytes)) + (-Pattern -BtsInput [N ?N ?outp -Bytes] . ->opt . (optlist -Bytes))))] + [regexp-match* (let ([N index-type] [?N (-opt index-type)] [-StrRx (Un -String -Regexp)] [-BtsRx (Un -Bytes -Byte-Regexp)] - [-Input (Un -String -Input-Port -Bytes -Path)]) + [-StrInput (Un -String -Path)] + [-BtsInput (Un -Input-Port -Bytes)]) (cl->* - (-StrRx -Input [N ?N -Bytes] . ->opt . (-lst -String)) - (-BtsRx -Input [N ?N -Bytes] . ->opt . (-lst -Bytes))))] + (-StrRx -StrInput [N ?N -Bytes] . ->opt . (-lst -String)) + (-BtsRx (Un -StrInput -BtsInput) [N ?N -Bytes] . ->opt . (-lst -Bytes)) + (-Pattern -BtsInput [N ?N -Bytes] . ->opt . (-lst -Bytes))))] + [regexp-try-match (let ([?outp (-opt -Output-Port)] [N index-type] [?N (-opt index-type)] [optlist (lambda (t) (-opt (-pair t (-lst (-opt t)))))] [-StrRx (Un -String -Regexp)] - [-BtsRx (Un -Bytes -Byte-Regexp)] - [-Input (Un -String -Input-Port -Bytes -Path)]) - (cl->* - (-StrRx -Input [N ?N ?outp -Bytes] . ->opt . (optlist -String)) - (-BtsRx -Input [N ?N ?outp -Bytes] . ->opt . (optlist -Bytes))))] + [-BtsRx (Un -Bytes -Byte-Regexp)]) + ((Un -BtsRx -StrRx) -Input-Port [N ?N ?outp -Bytes] . ->opt . (optlist -Bytes)))] [regexp-match-positions @@ -135,13 +138,8 @@ (let ([progress (-val #f)] [N index-type] [?N (-opt index-type)] - [optlist (lambda (t) (-opt (-pair t (-lst (-opt t)))))] - [-StrRx (Un -String -Regexp)] - [-BtsRx (Un -Bytes -Byte-Regexp)] - [-Input (Un -String -Input-Port -Bytes -Path)]) - (cl->* - (-StrRx -Input [N ?N progress -Bytes] . ->opt . (optlist -String)) - (-BtsRx -Input [N ?N progress -Bytes] . ->opt . (optlist -Bytes))))] + [optlist (lambda (t) (-opt (-pair t (-lst (-opt t)))))]) + (-Pattern -Input-Port [N ?N progress -Bytes] . ->opt . (optlist -Bytes)))] [regexp-match-peek-positions @@ -149,22 +147,16 @@ [N index-type] [?N (-opt index-type)] [ind-pair (-pair -Index -Index)] - [output (-opt (-pair ind-pair (-lst (-opt ind-pair))))] - [-Input (Un -String -Input-Port -Bytes -Path)]) - (->opt -Pattern -Input [N ?N progress -Bytes] output))] + [output (-opt (-pair ind-pair (-lst (-opt ind-pair))))]) + (->opt -Pattern -Input-Port [N ?N progress -Bytes] output))] [regexp-match-peek-immediate (let ([progress (-val #f)] [N index-type] [?N (-opt index-type)] - [optlist (lambda (t) (-opt (-pair t (-lst (-opt t)))))] - [-StrRx (Un -String -Regexp)] - [-BtsRx (Un -Bytes -Byte-Regexp)] - [-Input (Un -String -Input-Port -Bytes -Path)]) - (cl->* - (-StrRx -Input [N ?N progress -Bytes] . ->opt . (optlist -String)) - (-BtsRx -Input [N ?N progress -Bytes] . ->opt . (optlist -Bytes))))] + [optlist (lambda (t) (-opt (-pair t (-lst (-opt t)))))]) + (-Pattern -Input-Port [N ?N progress -Bytes] . ->opt . (optlist -Bytes)))] [regexp-match-peek-positions-immediate @@ -172,9 +164,8 @@ [N index-type] [?N (-opt index-type)] [ind-pair (-pair -Index -Index)] - [output (-opt (-pair ind-pair (-lst (-opt ind-pair))))] - [-Input (Un -String -Input-Port -Bytes -Path)]) - (->opt -Pattern -Input [N ?N progress -Bytes] output))] + [output (-opt (-pair ind-pair (-lst (-opt ind-pair))))]) + (->opt -Pattern -Input-Port [N ?N progress -Bytes] output))] @@ -183,9 +174,8 @@ [N index-type] [?N (-opt index-type)] [ind-pair (-pair -Index -Index)] - [output (-lst ind-pair)] - [-Input (Un -String -Input-Port -Bytes -Path)]) - (->opt -Pattern -Input [N ?N progress -Bytes] output))] + [output (-lst ind-pair)]) + (->opt -Pattern -Input-Port [N ?N progress -Bytes] output))] [regexp-match/end @@ -195,10 +185,12 @@ [optlist (lambda (t) (-opt (-pair t (-lst (-opt t)))))] [-StrRx (Un -String -Regexp)] [-BtsRx (Un -Bytes -Byte-Regexp)] - [-Input (Un -String -Input-Port -Bytes -Path)]) + [-StrInput (Un -String -Path)] + [-BtsInput (Un -Input-Port -Bytes)]) (cl->* - (-StrRx -Input [N ?N ?outp -Bytes N] . ->opt . (-values (list (optlist -String) (-opt -Bytes)))) - (-BtsRx -Input [N ?N ?outp -Bytes N] . ->opt . (-values (list (optlist -Bytes) (-opt -Bytes))))))] + (-StrRx -StrInput [N ?N ?outp -Bytes N] . ->opt . (-values (list (optlist -String) (-opt -Bytes)))) + (-BtsRx (Un -StrInput -BtsInput) [N ?N ?outp -Bytes N] . ->opt . (-values (list (optlist -Bytes) (-opt -Bytes)))) + (-Pattern -BtsInput [N ?N ?outp -Bytes N] . ->opt . (-values (list (optlist -Bytes) (-opt -Bytes))))))] [regexp-match-positions/end @@ -218,9 +210,8 @@ [N index-type] [?N (-opt index-type)] [ind-pair (-pair -Index -Index)] - [output (-opt (-pair ind-pair (-lst (-opt ind-pair))))] - [-Input (Un -String -Input-Port -Bytes -Path)]) - (->opt -Pattern -Input [N ?N progress -Bytes N] (-values (list output (-opt -Bytes)))))] + [output (-opt (-pair ind-pair (-lst (-opt ind-pair))))]) + (->opt -Pattern -Input-Port [N ?N progress -Bytes N] (-values (list output (-opt -Bytes)))))] [regexp-match-peek-positions-immediate/end @@ -228,22 +219,22 @@ [N index-type] [?N (-opt index-type)] [ind-pair (-pair -Index -Index)] - [output (-opt (-pair ind-pair (-lst (-opt ind-pair))))] - [-Input (Un -String -Input-Port -Bytes -Path)]) - (->opt -Pattern -Input [N ?N progress -Bytes N] (-values (list output (-opt -Bytes)))))] + [output (-opt (-pair ind-pair (-lst (-opt ind-pair))))]) + (->opt -Pattern -Input-Port [N ?N progress -Bytes N] (-values (list output (-opt -Bytes)))))] [regexp-split (let ([N index-type] [?N (-opt index-type)] - [output (lambda (t) (-opt (-pair t (-lst t))))] + [output (lambda (t) (-pair t (-lst t)))] [-StrRx (Un -String -Regexp)] [-BtsRx (Un -Bytes -Byte-Regexp)] - [-Input (Un -String -Input-Port -Bytes -Path)]) + [-BtsInput (Un -Input-Port -Bytes)]) (cl->* - (-StrRx -Input [N ?N -Bytes] . ->opt . (output -String)) - (-BtsRx -Input [N ?N -Bytes] . ->opt . (output -Bytes))))] + (-StrRx -String [N ?N -Bytes] . ->opt . (output -String)) + (-BtsRx (Un -String -BtsInput) [N ?N -Bytes] . ->opt . (output -Bytes)) + (-Pattern -BtsInput [N ?N -Bytes] . ->opt . (output -Bytes))))]