[commit: testsuite] master: T5435 test improvements, see #5435 for details. (7520b97)

git at git.haskell.org git at git.haskell.org
Mon Sep 16 08:54:10 CEST 2013


Repository : ssh://git@git.haskell.org/testsuite

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/7520b9775cf57b61208f68a7233449763007ee2f/testsuite

>---------------------------------------------------------------

commit 7520b9775cf57b61208f68a7233449763007ee2f
Author: Edward Z. Yang <ezyang at mit.edu>
Date:   Sun Sep 15 14:07:59 2013 -0700

    T5435 test improvements, see #5435 for details.
    
    Signed-off-by: Edward Z. Yang <ezyang at mit.edu>


>---------------------------------------------------------------

7520b9775cf57b61208f68a7233449763007ee2f
 tests/rts/Makefile                 |   19 +++++++++++++++----
 tests/rts/T5435.c                  |   13 +++----------
 tests/rts/T5435.hs                 |   13 ++++++++++---
 tests/rts/T5435_dyn.stdout         |    3 +--
 tests/rts/T5435_dyn_mingw32.stdout |    2 ++
 tests/rts/T5435_v.stdout           |    3 +--
 tests/rts/all.T                    |    7 ++++++-
 7 files changed, 38 insertions(+), 22 deletions(-)

diff --git a/tests/rts/Makefile b/tests/rts/Makefile
index 0b146a1..ae2a418 100644
--- a/tests/rts/Makefile
+++ b/tests/rts/Makefile
@@ -50,14 +50,25 @@ T5435_v:
 	$(RM) T5435_c_v.o T5435_v$(exeext)
 	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -c T5435.c -o T5435_c_v.o
 	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 T5435.hs -osuf v_o -o T5435_v$(exeext)
-	./T5435_v T5435_c_v.o
+	./T5435_v v ./T5435_c_v.o
 
+# This doesn't work on Windows, which expects *no* file extension
+# File extension here is not right for Mac OS X, where it should be dylib.
+# Note that this is DLL-loading from a *static* executable; we probably
+# also ought to provide the dynamic way via the usual channels.
 .PHONY: T5435_dyn
 T5435_dyn:
 	$(RM) T5435_c_dyn.o T5435_dyn$(exeext)
-	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -dynamic -fPIC -c T5435.c -o T5435_c_dyn.o
-	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -dynamic -fPIC T5435.hs -osuf dyn_o -o T5435_dyn$(exeext)
-	./T5435_dyn T5435_c_dyn.o
+	'$(TEST_HC)' $(filter-out -rtsopts, $(TEST_HC_OPTS)) -v0 -fPIC -shared -c T5435.c -osuf dyn_o -o T5435_c.so
+	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 T5435.hs -osuf dyn_o -o T5435_dyn$(exeext)
+	./T5435_dyn dyn ./T5435_c.so
+
+.PHONY: T5435_dyn_mingw32
+T5435_dyn_mingw32:
+	$(RM) T5435_c_dyn.o T5435_dyn$(exeext)
+	'$(TEST_HC)' $(filter-out -rtsopts, $(TEST_HC_OPTS)) -v0 -fPIC -shared -c T5435.c -osuf dyn_o -o T5435_c.dll
+	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 T5435.hs -osuf dyn_o -o T5435_dyn$(exeext)
+	./T5435_dyn dyn ./T5435_c
 
 T6006_setup :
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c T6006.hs
diff --git a/tests/rts/T5435.c b/tests/rts/T5435.c
index 7e240fe..7aabc0a 100644
--- a/tests/rts/T5435.c
+++ b/tests/rts/T5435.c
@@ -1,15 +1,8 @@
 #include <stdio.h>
-static void initializer1(void) __attribute__((constructor));
-static void initializer2(void) __attribute__((constructor));
+static void initializer(void) __attribute__((constructor));
 
-static void initializer1(void)
+static void initializer(void)
 {
-    printf("initializer1 run\n");
-    fflush(stdout);
-}
-
-static void initializer2(void)
-{
-    printf("initializer2 run\n");
+    printf("initializer run\n");
     fflush(stdout);
 }
diff --git a/tests/rts/T5435.hs b/tests/rts/T5435.hs
index fb54317..6aaa9cf 100644
--- a/tests/rts/T5435.hs
+++ b/tests/rts/T5435.hs
@@ -2,6 +2,7 @@
 import Foreign.C.String
 import Control.Monad
 import System.Environment
+import Foreign.Ptr
 
 #if defined(mingw32_HOST_OS)
 type PathString = CWString
@@ -12,14 +13,20 @@ withPathString = withCString
 #endif
 
 main = do
-    [object] <- getArgs
+    [ty, object] <- getArgs
     initLinker
-    r <- withPathString object $ \s -> loadObj s
-    when (r /= 1) $ error "loadObj failed"
+    if ty == "dyn"
+      then do
+        r <- withPathString object $ \s -> addDLL s
+        when (r /= nullPtr) $ error =<< peekCString r
+      else do
+        r <- withPathString object $ \s -> loadObj s
+        when (r /= 1) $ error "loadObj failed"
     r <- resolveObjs
     when (r /= 1) $ error "resolveObj failed"
     putStrLn "success"
 
 foreign import ccall "initLinker" initLinker :: IO ()
+foreign import ccall "addDLL" addDLL :: PathString -> IO CString
 foreign import ccall "loadObj" loadObj :: PathString -> IO Int
 foreign import ccall "resolveObjs" resolveObjs :: IO Int
diff --git a/tests/rts/T5435_dyn.stdout b/tests/rts/T5435_dyn.stdout
index 4c34470..ef3b86d 100644
--- a/tests/rts/T5435_dyn.stdout
+++ b/tests/rts/T5435_dyn.stdout
@@ -1,3 +1,2 @@
-initializer1 run
-initializer2 run
+initializer run
 success
diff --git a/tests/rts/T5435_dyn_mingw32.stdout b/tests/rts/T5435_dyn_mingw32.stdout
new file mode 100644
index 0000000..ef3b86d
--- /dev/null
+++ b/tests/rts/T5435_dyn_mingw32.stdout
@@ -0,0 +1,2 @@
+initializer run
+success
diff --git a/tests/rts/T5435_v.stdout b/tests/rts/T5435_v.stdout
index 4c34470..ef3b86d 100644
--- a/tests/rts/T5435_v.stdout
+++ b/tests/rts/T5435_v.stdout
@@ -1,3 +1,2 @@
-initializer1 run
-initializer2 run
+initializer run
 success
diff --git a/tests/rts/all.T b/tests/rts/all.T
index 08d4a6b..595821b 100644
--- a/tests/rts/all.T
+++ b/tests/rts/all.T
@@ -136,10 +136,15 @@ test('T5435_v',
      ['$MAKE -s --no-print-directory T5435_v'])
 
 test('T5435_dyn',
-     extra_clean(['T5435_c_dyn.o']),
+     [when(opsys('mingw32'), skip), extra_clean(['T5435_c.so'])],
      run_command,
      ['$MAKE -s --no-print-directory T5435_dyn'])
 
+test('T5435_dyn_mingw32',
+     [when(not opsys('mingw32'), skip), extra_clean(['T5435_c.dll'])],
+     run_command,
+     ['$MAKE -s --no-print-directory T5435_dyn_mingw32'])
+
 test('T5993', extra_run_opts('+RTS -k8 -RTS'), compile_and_run, [''])
 
 test('T6006', [ omit_ways(prof_ways + ['ghci']),




More information about the ghc-commits mailing list