diff --git a/compiler/basicTypes/UniqSupply.hs b/compiler/basicTypes/UniqSupply.hs
index 9697566efc3aca122ef65fbd4e5aff4276d9bfeb..2ab80e99bd6090ae4fb65bb62de1f2aab2204008 100644
--- a/compiler/basicTypes/UniqSupply.hs
+++ b/compiler/basicTypes/UniqSupply.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE BangPatterns #-}
 
 #if !defined(GHC_LOADED_INTO_GHCI)
 {-# LANGUAGE UnboxedTuples #-}
@@ -88,7 +89,7 @@ takeUniqFromSupply :: UniqSupply -> (Unique, UniqSupply)
 
 mkSplitUniqSupply c
   = case ord c `shiftL` uNIQUE_BITS of
-     mask -> let
+     !mask -> let
         -- here comes THE MAGIC:
 
         -- This is one of the most hammered bits in the whole compiler
diff --git a/testsuite/tests/perf/should_run/UniqLoop.hs b/testsuite/tests/perf/should_run/UniqLoop.hs
new file mode 100644
index 0000000000000000000000000000000000000000..d4455f99b6c927b656010b22190578a01716e2cb
--- /dev/null
+++ b/testsuite/tests/perf/should_run/UniqLoop.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE BangPatterns #-}
+
+module Main where
+
+import UniqSupply
+import Unique
+
+-- Generate a lot of uniques
+main = do
+    us <- mkSplitUniqSupply 'v'
+    seq (churn us 10000000) (return ())
+
+churn :: UniqSupply -> Int -> Int
+churn !us 0 = getKey $ uniqFromSupply us
+churn us n =
+  let (!x,!us') = takeUniqFromSupply us
+  in churn us' (n-1)
diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T
index 2273ddd400d14d4dc97a6642faf9630c08b7266f..eecd15f57f6e75552d83eaf00525a4bd2183befa 100644
--- a/testsuite/tests/perf/should_run/all.T
+++ b/testsuite/tests/perf/should_run/all.T
@@ -367,3 +367,11 @@ test('T15578',
      only_ways(['normal'])],
     compile_and_run,
     ['-O2'])
+
+# Test performance of creating Uniques.
+test('UniqLoop',
+     [collect_stats('bytes allocated',5),
+      only_ways(['normal'])
+      ],
+     compile_and_run,
+     ['-O -package ghc'])
\ No newline at end of file