diff --git a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs b/libraries/ghc-bignum/src/GHC/Num/BigNat.hs
index 21b07cb8300f14ced57bca5fca9203836b068ce3..c7f8afa027562e89c5c27d412928336d904c21ae 100644
--- a/libraries/ghc-bignum/src/GHC/Num/BigNat.hs
+++ b/libraries/ghc-bignum/src/GHC/Num/BigNat.hs
@@ -135,13 +135,8 @@ bigNatIsTwo# ba =
 bigNatIsPowerOf2# :: BigNat# -> (# (# #) | Word# #)
 bigNatIsPowerOf2# a
    | bigNatIsZero a                      = (# (# #) | #)
-   | True = case wordIsPowerOf2# msw of
-               (# (# #) | #) -> (# (# #) | #)
-               (# | c  #) -> case checkAllZeroes (imax -# 1#) of
-                  0# -> (# (# #) | #)
-                  _  -> (# | c `plusWord#`
-                              (int2Word# imax `uncheckedShiftL#` WORD_SIZE_BITS_SHIFT#) #)
-   where
+   | True =
+    let
       msw  = bigNatIndex# a imax
       sz   = bigNatSize# a
       imax = sz -# 1#
@@ -150,6 +145,12 @@ bigNatIsPowerOf2# a
          | True = case bigNatIndex# a i of
                      0## -> checkAllZeroes (i -# 1#)
                      _   -> 0#
+    in case wordIsPowerOf2# msw of
+               (# (# #) | #) -> (# (# #) | #)
+               (# | c  #) -> case checkAllZeroes (imax -# 1#) of
+                  0# -> (# (# #) | #)
+                  _  -> (# | c `plusWord#`
+                              (int2Word# imax `uncheckedShiftL#` WORD_SIZE_BITS_SHIFT#) #)
 
 -- | Return the Word# at the given index
 bigNatIndex# :: BigNat# -> Int# -> Word#
diff --git a/testsuite/tests/numeric/should_run/T24066.hs b/testsuite/tests/numeric/should_run/T24066.hs
new file mode 100644
index 0000000000000000000000000000000000000000..dc173154bab20ffeb1de89ca5250d6a1666e15f9
--- /dev/null
+++ b/testsuite/tests/numeric/should_run/T24066.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Main where
+
+import GHC.Num.BigNat
+import GHC.Exts
+
+-- just to ensure that (future) rewrite rules don't mess with the test
+{-# NOINLINE foo #-}
+foo (# #) = bigNatZero# (# #)
+
+main = do
+  case bigNatIsPowerOf2# (foo (# #)) of
+    (# _ | #) -> putStrLn "Zero isn't a power of two"
+    (# | w #) -> putStrLn $ "Zero is 2^" ++ show (W# w)
diff --git a/testsuite/tests/numeric/should_run/T24066.stdout b/testsuite/tests/numeric/should_run/T24066.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..73aeea9203d474c6b86b94e8cb732f5b051323cc
--- /dev/null
+++ b/testsuite/tests/numeric/should_run/T24066.stdout
@@ -0,0 +1 @@
+Zero isn't a power of two
diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T
index 26bb1fe2c62a84f361248942b3ce84b43100528a..074155bb6ec8f3b9cafde3b18bac568743ee6f3c 100644
--- a/testsuite/tests/numeric/should_run/all.T
+++ b/testsuite/tests/numeric/should_run/all.T
@@ -81,3 +81,4 @@ test('T20291', normal, compile_and_run, [''])
 test('T22282', normal, compile_and_run, [''])
 test('T22671', normal, compile_and_run, [''])
 test('foundation', [when(js_arch(), run_timeout_multiplier(2))], compile_and_run, ['-O -package transformers'])
+test('T24066', normal, compile_and_run, [''])