diff --git a/testsuite/tests/profiling/should_run/Makefile b/testsuite/tests/profiling/should_run/Makefile
index 19a682fb97ee2dc18efa74de90ad3cb6c3d5e24c..25b352c1974b01b7e78c2a69c62055b7e8e3a209 100644
--- a/testsuite/tests/profiling/should_run/Makefile
+++ b/testsuite/tests/profiling/should_run/Makefile
@@ -30,3 +30,15 @@ T15897:
 	"$(TEST_HC)" -prof -fprof-auto -debug -v0 T15897.hs
 	./T15897 10000000 +RTS -s -hc 2>/dev/null
 	./T15897 10000000 +RTS -s -hr 2>/dev/null
+
+.PHONY: T17877-locale
+T17877-locale:
+	"$(HSC2HS)" "$@.hsc"
+	"$(TEST_HC)" $(TEST_HC_OPTS) -rtsopts "$@.hs"
+	"./$@" +RTS -h
+	sed -ne '/BEGIN_SAMPLE/,/END_SAMPLE/ p' "$@.hp" | grep -qv _SAMPLE
+	"$(HP2PS_ABS)" "$@.hp"
+	# In some locales (e.g. mine is fr_FR), printf format sample times as:
+	#   BEGIN_SAMPLE 0,022049
+	# which is unreadable to hp2ps:
+	# hp2ps: prof-locale.hp, line 7, floating point number must follow BEGIN_SAMPLE
diff --git a/testsuite/tests/profiling/should_run/T17877-locale.hsc b/testsuite/tests/profiling/should_run/T17877-locale.hsc
new file mode 100644
index 0000000000000000000000000000000000000000..2b7df19b09c859ce09827ebde88652d0c41ce9ea
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/T17877-locale.hsc
@@ -0,0 +1,24 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+import Control.Exception
+import Foreign.C.Types
+import Foreign.C.String
+import Foreign.C.Error
+
+#include <locale.h>
+lcAll = #const LC_ALL
+foreign import ccall "locale.h setlocale" c_setlocale :: CInt -> CString -> IO CString
+foreign import ccall  "stdio.h printf"    c_printf :: CString -> CDouble -> IO ()
+
+main = do
+  throwErrnoIfNull "setlocale" $ withCString "fr_FR.utf8" $ c_setlocale lcAll
+
+  -- allocate some junk to get a heap profile
+  s <- getLine
+  evaluate $ last $ scanl1 (+) $ map fromEnum $ concat $ replicate 100000 s
+  -- check 0 (test validity): ensure we got a profile (sed|grep in Makefile)
+
+  -- check 1: RTS doesn't override user's locale setting
+  withCString "%'.3f\n" $ \fmt -> c_printf fmt (read s)
+
+  -- check 2: heap profile is readable by hp2ps (hp2ps in Makefile)
diff --git a/testsuite/tests/profiling/should_run/T17877-locale.stdin b/testsuite/tests/profiling/should_run/T17877-locale.stdin
new file mode 100644
index 0000000000000000000000000000000000000000..eeb84a1b7a99ccc7f2a16a391929ed5c5adbf1c4
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/T17877-locale.stdin
@@ -0,0 +1 @@
+3141.592653589793
diff --git a/testsuite/tests/profiling/should_run/T17877-locale.stdout b/testsuite/tests/profiling/should_run/T17877-locale.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..6f27694fe57fcbee53eff46e181a4a1bca66e76d
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/T17877-locale.stdout
@@ -0,0 +1,3 @@
+[1 of 1] Compiling Main             ( T17877-locale.hs, T17877-locale.o )
+Linking T17877-locale ...
+3 141,593
diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T
index fe98517d961c9fea01c0332b849fd42f322e804f..111fd67aa1fd7c6bca1610d200c1cfb2ee8868bb 100644
--- a/testsuite/tests/profiling/should_run/all.T
+++ b/testsuite/tests/profiling/should_run/all.T
@@ -151,3 +151,5 @@ test('T15897',
      makefile_test, ['T15897'])
 
 test('T17572', [], compile_and_run, [''])
+
+test('T17877-locale', normal, makefile_test, [])