diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2020-08-11 10:01:24 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-09-01 12:39:36 -0400 |
| commit | 884245dd29265b7bee12cda8c915da9c916251ce (patch) | |
| tree | aa7550b63d3894527ebd01ec22f5348fcbbd1c8e | |
| parent | a8a2568b7b64e5b9fca5b12df7da759de4db39ae (diff) | |
| download | haskell-884245dd29265b7bee12cda8c915da9c916251ce.tar.gz | |
Fix FastString lexicographic ordering (fix #18562)
| -rw-r--r-- | compiler/GHC/Data/FastString.hs | 4 | ||||
| -rw-r--r-- | testsuite/tests/ghci/should_run/T18562.script | 4 | ||||
| -rw-r--r-- | testsuite/tests/ghci/should_run/T18562.stdout | 3 | ||||
| -rw-r--r-- | testsuite/tests/ghci/should_run/all.T | 1 |
4 files changed, 11 insertions, 1 deletions
diff --git a/compiler/GHC/Data/FastString.hs b/compiler/GHC/Data/FastString.hs index fbd69d426f..1907ef91c9 100644 --- a/compiler/GHC/Data/FastString.hs +++ b/compiler/GHC/Data/FastString.hs @@ -231,10 +231,12 @@ instance Data FastString where instance NFData FastString where rnf fs = seq fs () +-- | Compare FastString lexicographically cmpFS :: FastString -> FastString -> Ordering cmpFS fs1 fs2 = if uniq fs1 == uniq fs2 then EQ else - compare (fs_sbs fs1) (fs_sbs fs2) + compare (unpackFS fs1) (unpackFS fs2) + -- compare as String, not as ShortByteString (cf #18562) -- ----------------------------------------------------------------------------- -- Construction diff --git a/testsuite/tests/ghci/should_run/T18562.script b/testsuite/tests/ghci/should_run/T18562.script new file mode 100644 index 0000000000..613f0958f7 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T18562.script @@ -0,0 +1,4 @@ +:set -XDataKinds +import GHC.TypeLits +:kind! CmpSymbol "a" "\0" +compare "a" "\0" diff --git a/testsuite/tests/ghci/should_run/T18562.stdout b/testsuite/tests/ghci/should_run/T18562.stdout new file mode 100644 index 0000000000..0f1937e33b --- /dev/null +++ b/testsuite/tests/ghci/should_run/T18562.stdout @@ -0,0 +1,3 @@ +CmpSymbol "a" "\0" :: Ordering += 'GT +GT diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T index 3de49c1f34..dc125dd828 100644 --- a/testsuite/tests/ghci/should_run/all.T +++ b/testsuite/tests/ghci/should_run/all.T @@ -76,3 +76,4 @@ test('T18064', ghci_script, ['T18064.script']) test('T18594', just_ghci, ghci_script, ['T18594.script']) +test('T18562', just_ghci, ghci_script, ['T18562.script']) |