summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2019-10-29 09:49:29 -0400
committerBen Gamari <ben@smart-cactus.org>2019-10-30 16:57:06 -0400
commit1ce3d98213902ccb483d5c5f426484e0d7be0245 (patch)
tree5c7803e95226051434ab0b8d4a98486c743be397
parent08810f123eb3b49bcfb3dd1d46284ec9d53d2612 (diff)
downloadhaskell-wip/T17414.tar.gz
testsuite: Add test for #17414wip/T17414
-rw-r--r--libraries/base/tests/IO/T17414.hs18
-rw-r--r--libraries/base/tests/IO/all.T2
2 files changed, 20 insertions, 0 deletions
diff --git a/libraries/base/tests/IO/T17414.hs b/libraries/base/tests/IO/T17414.hs
new file mode 100644
index 0000000000..59d40720ec
--- /dev/null
+++ b/libraries/base/tests/IO/T17414.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+import Foreign.Ptr (Ptr)
+import Foreign.Marshal.Alloc (mallocBytes, free)
+import System.IO (hPutBuf, withBinaryFile, IOMode (WriteMode))
+
+-- more than 2GiB
+numBytes :: Int
+numBytes = 2264375889
+
+main :: IO ()
+main = do
+ (ptr :: Ptr ()) <- mallocBytes numBytes
+ -- the next line produces the exception on macOS
+ withBinaryFile "test.out" WriteMode (\h -> hPutBuf h ptr numBytes)
+ free ptr
+
+ -- Truncate file in case it doesn't get deleted
+ writeFile "test.out" ""
diff --git a/libraries/base/tests/IO/all.T b/libraries/base/tests/IO/all.T
index cea513823b..427631c933 100644
--- a/libraries/base/tests/IO/all.T
+++ b/libraries/base/tests/IO/all.T
@@ -132,3 +132,5 @@ test('encodingerror001', normal, compile_and_run, [''])
test('T4808', [fragile_for(16909, ['threaded2']), exit_code(1)], compile_and_run, [''])
test('T4895', normal, compile_and_run, [''])
test('T7853', normal, compile_and_run, [''])
+# Tests ability to perform >32-bit IO operations
+test('T17414', [when(wordsize(32), skip), high_memory_usage], compile_and_run, [''])