Fix intersection bug #420 (#427)

Fixes #420.

Co-authored-by: Brian Shu <[email protected]>

Author: sjakobi

Data/HashMap/Internal.hs

@@ -1873,7 +1873,11 @@ intersectionArrayBy f !b1 !b2 !ary1 !ary2
     (len, bFinal) <- go 0 0 0 bCombined bIntersect
     case len of
       0 -> pure Empty
-      1 -> A.read mary 0
+      1 -> do
+        l <- A.read mary 0
+        if isLeafOrCollision l
+          then pure l
+          else BitmapIndexed bFinal <$> (A.unsafeFreeze =<< A.shrink mary 1)
       _ -> bitmapIndexedOrFull bFinal <$> (A.unsafeFreeze =<< A.shrink mary len)
   where
     bCombined = b1 .|. b2
@@ -1927,7 +1931,6 @@ searchSwap toFind start = go start toFind start
           else go i0 k (i + 1) mary
 {-# INLINE searchSwap #-}
 
-
 ------------------------------------------------------------------------
 -- * Folds
 

tests/Regressions.hs

@@ -7,6 +7,7 @@ module Regressions (tests) where
 
 import Control.Exception     (evaluate)
 import Control.Monad         (replicateM)
+import Data.Bits             (shiftL)
 import Data.Hashable         (Hashable (..))
 import Data.List             (delete)
 import Data.Maybe            (isJust, isNothing)
@@ -24,6 +25,7 @@ import Test.Tasty.QuickCheck (testProperty)
 
 import qualified Data.HashMap.Lazy   as HML
 import qualified Data.HashMap.Strict as HMS
+import qualified Data.HashSet        as HS
 
 #if MIN_VERSION_base(4,12,0)
 -- nothunks requires base >= 4.12
@@ -248,6 +250,18 @@ issue383 = do
 
 #endif
 
+------------------------------------------------------------------------
+-- Issue #420
+
+issue420 :: Assertion
+issue420 = do
+  let k1 :: Int = 1 `shiftL` 10
+  let k2 :: Int = 2 `shiftL` 10
+  let s0 = HS.fromList [k1, k2]
+  let s1 = s0 `HS.intersection` s0
+  assert $ k1 `HS.member` s1
+  assert $ k2 `HS.member` s1
+
 ------------------------------------------------------------------------
 -- * Test list
 
@@ -277,4 +291,5 @@ tests = testGroup "Regression tests"
 #ifdef HAVE_NOTHUNKS
     , testCase "issue383" issue383
 #endif
+    , testCase "issue420" issue420
     ]