1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
From e647752e7b99c2fb198b652bc00c531cf31878cf Mon Sep 17 00:00:00 2001
From: Ben Gamari <ben@smart-cactus.org>
Date: Tue, 11 Jun 2019 13:09:55 -0400
Subject: testsuite: Ensure that ffi005 output order is predictable
The libc output buffer wasn't being flushed, making the order
system-depedent.
---
testsuite/tests/ffi/should_run/all.T | 4 ++--
testsuite/tests/ffi/should_run/ffi005.hs | 7 +++++--
testsuite/tests/ffi/should_run/ffi005.stdout | 4 ++--
testsuite/tests/ffi/should_run/ffi005_c.c | 5 +++++
4 files changed, 14 insertions(+), 6 deletions(-)
create mode 100644 testsuite/tests/ffi/should_run/ffi005_c.c
diff --git a/testsuite/tests/ffi/should_run/all.T b/testsuite/tests/ffi/should_run/all.T
index fa78c56b80..1a85e8ac66 100644
--- a/testsuite/tests/ffi/should_run/all.T
+++ b/testsuite/tests/ffi/should_run/all.T
@@ -28,11 +28,11 @@ test('ffi004', skip, compile_and_run, [''])
# On x86, the test suffers from floating-point differences due to the
# use of 80-bit internal precision when using the native code generator.
#
-test('ffi005', [ omit_ways(prof_ways),
+test('ffi005', [ omit_ways(prof_ways + ['ghci']),
when(arch('i386'), skip),
when(platform('i386-apple-darwin'), expect_broken(4105)),
exit_code(3) ],
- compile_and_run, [''])
+ compile_and_run, ['ffi005_c.c'])
test('ffi006', normal, compile_and_run, [''])
diff --git a/testsuite/tests/ffi/should_run/ffi005.hs b/testsuite/tests/ffi/should_run/ffi005.hs
index 9c17441954..85437a422f 100644
--- a/testsuite/tests/ffi/should_run/ffi005.hs
+++ b/testsuite/tests/ffi/should_run/ffi005.hs
@@ -20,10 +20,12 @@ main = do
-- putStrLn $ "errno == " ++ show err
putStrLn "\nTesting puts (and withString)"
- withCString "Test successful" puts
+ hFlush stdout
+ withCString "Test puts successful" puts
+ flushStdout -- Flush the libc output buffer
putStrLn "\nTesting peekArray0"
- s <- withCString "Test successful" (peekArray0 (castCharToCChar '\0'))
+ s <- withCString "Test peekArray0 successful" (peekArray0 (castCharToCChar '\0'))
putStr (map castCCharToChar s)
-- disabled due to use of non-portable constants in arguments to open:
@@ -71,6 +73,7 @@ withBuffer sz m = do
return s
foreign import ccall puts :: CString -> IO CInt
+foreign import ccall "flush_stdout" flushStdout :: IO ()
-- foreign import ccall "open" open' :: CString -> CInt -> IO CInt
-- foreign import ccall "open" open2' :: CString -> CInt -> CInt -> IO CInt
diff --git a/testsuite/tests/ffi/should_run/ffi005.stdout b/testsuite/tests/ffi/should_run/ffi005.stdout
index bc0a137514..bc29221ccf 100644
--- a/testsuite/tests/ffi/should_run/ffi005.stdout
+++ b/testsuite/tests/ffi/should_run/ffi005.stdout
@@ -3,9 +3,10 @@ Testing sin==mysin (should return lots of Trues)
[True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True]
Testing puts (and withString)
+Test puts successful
Testing peekArray0
-Test successful
+Test peekArray0 successful
Testing sin==dynamic_sin (should return lots of Trues)
[True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True]
@@ -16,4 +17,3 @@ Testing sin==Id wrapped_sin (should return lots of Trues)
[True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True]
Testing exit
-Test successful
diff --git a/testsuite/tests/ffi/should_run/ffi005_c.c b/testsuite/tests/ffi/should_run/ffi005_c.c
new file mode 100644
index 0000000000..e5a88e1b4e
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/ffi005_c.c
@@ -0,0 +1,5 @@
+#include <stdio.h>
+void flush_stdout(void)
+{
+ fflush(stdout);
+}
--
2.17.1
|
