[commit: ghc] wip/monoidal/odd-linking: first version of test (be534b0)

git at git.haskell.org git at git.haskell.org
Fri Jul 27 13:07:14 UTC 2018


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

On branch  : wip/monoidal/odd-linking
Link       : http://ghc.haskell.org/trac/ghc/changeset/be534b04202e00c259763dae5d5fc761beb9d8a4/ghc

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

commit be534b04202e00c259763dae5d5fc761beb9d8a4
Author: Krzysztof Gogolewski <krz.gogolewski at gmail.com>
Date:   Sat Jul 21 02:00:46 2018 +0200

    first version of test


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

be534b04202e00c259763dae5d5fc761beb9d8a4
 compiler/main/Ar.hs                                     | 11 +++++++++--
 testsuite/tests/cabal/.gitignore                        |  1 +
 testsuite/tests/cabal/Makefile                          | 10 ++++++++++
 testsuite/tests/{driver/T10219.hspp => cabal/T15396.hs} |  0
 testsuite/tests/cabal/T15396.pkg                        |  6 ++++++
 testsuite/tests/cabal/T15396.stdout                     |  3 +++
 testsuite/tests/cabal/all.T                             |  2 ++
 testsuite/tests/cabal/libT15396_odd.a                   |  2 ++
 8 files changed, 33 insertions(+), 2 deletions(-)

diff --git a/compiler/main/Ar.hs b/compiler/main/Ar.hs
index 51655c0..cf3a02e 100644
--- a/compiler/main/Ar.hs
+++ b/compiler/main/Ar.hs
@@ -95,7 +95,7 @@ getBSDArchEntries = do
         st_size <- getPaddedInt <$> getByteString 10
         end     <- getByteString 2
         when (end /= "\x60\x0a") $
-          fail "Invalid archive header end marker"
+          fail $ "[BSD Archive] Invalid archive header end marker for name: " ++ C.unpack name
         off1    <- liftM fromIntegral bytesRead :: Get Int
         -- BSD stores extended filenames, by writing #1/<length> into the
         -- name field, the first @length@ bytes then represent the file name
@@ -106,6 +106,10 @@ getBSDArchEntries = do
                         return $ C.unpack $ C.takeWhile (/= ' ') name
         off2    <- liftM fromIntegral bytesRead :: Get Int
         file    <- getByteString (st_size - (off2 - off1))
+        -- data sections are two byte aligned (see Trac #15396)
+        when (odd st_size) $
+          void (getByteString 1)
+
         rest    <- getBSDArchEntries
         return $ (ArchiveEntry name time own grp mode (st_size - (off2 - off1)) file) : rest
 
@@ -128,8 +132,11 @@ getGNUArchEntries extInfo = do
       st_size <- getPaddedInt <$> getByteString 10
       end     <- getByteString 2
       when (end /= "\x60\x0a") $
-        fail "Invalid archive header end marker"
+        fail $ "[GNU Archive] Invalid archive header end marker for name: " ++ C.unpack name
       file <- getByteString st_size
+      -- data sections are two byte aligned (see Trac #15396)
+      when (odd st_size) $
+        void (getByteString 1)
       name <- return . C.unpack $
         if C.unpack (C.take 1 name) == "/"
         then case C.takeWhile (/= ' ') name of
diff --git a/testsuite/tests/cabal/.gitignore b/testsuite/tests/cabal/.gitignore
new file mode 100644
index 0000000..b26082d
--- /dev/null
+++ b/testsuite/tests/cabal/.gitignore
@@ -0,0 +1 @@
+!libT15396_odd.a
diff --git a/testsuite/tests/cabal/Makefile b/testsuite/tests/cabal/Makefile
index 791e326..b39c38d 100644
--- a/testsuite/tests/cabal/Makefile
+++ b/testsuite/tests/cabal/Makefile
@@ -295,3 +295,13 @@ T13703:
 	'$(GHC_PKG)' --no-user-package-db -f T13703.package.conf register --force test13703b.pkg 2>/dev/null
 	'$(GHC_PKG)' --no-user-package-db -f T13703.package.conf field z-p-z-q lib-name
 	'$(GHC_PKG)' --no-user-package-db -f T13703.package.conf field z-p-z-r lib-name
+
+PKGCONFT15396=localT15396.package.conf
+LOCAL_GHC_PKGT15396 = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONFT15396)
+
+T15396:
+	rm -rf $(PKGCONFT15396) T15396.hs T15396.o T15396.hi
+	$(LOCAL_GHC_PKGT15396) init $(PKGCONFT15396)
+	$(LOCAL_GHC_PKGT15396) register --force T15396.pkg
+	echo "main = return ()" >T15396.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -package-db $(PKGCONFT15396) T15396.hs -package T15396 -staticlib
diff --git a/testsuite/tests/driver/T10219.hspp b/testsuite/tests/cabal/T15396.hs
similarity index 100%
copy from testsuite/tests/driver/T10219.hspp
copy to testsuite/tests/cabal/T15396.hs
diff --git a/testsuite/tests/cabal/T15396.pkg b/testsuite/tests/cabal/T15396.pkg
new file mode 100644
index 0000000..c088cde
--- /dev/null
+++ b/testsuite/tests/cabal/T15396.pkg
@@ -0,0 +1,6 @@
+name: T15396
+version: 1
+id: T15396-1-XXX
+key: T15396-1-XXX
+extra-libraries: T15396_odd
+library-dirs: ${pkgroot}
diff --git a/testsuite/tests/cabal/T15396.stdout b/testsuite/tests/cabal/T15396.stdout
new file mode 100644
index 0000000..61b2dd6
--- /dev/null
+++ b/testsuite/tests/cabal/T15396.stdout
@@ -0,0 +1,3 @@
+Reading package info from "T15396.pkg" ... done.
+[1 of 1] Compiling Main             ( T15396.hs, T15396.o )
+Linking T15396.a ...
diff --git a/testsuite/tests/cabal/all.T b/testsuite/tests/cabal/all.T
index 5f1b308..38e0c17 100644
--- a/testsuite/tests/cabal/all.T
+++ b/testsuite/tests/cabal/all.T
@@ -57,3 +57,5 @@ test('shadow', [], run_command, ['$MAKE -s --no-print-directory shadow'])
 test('T12485a', [extra_files(['shadow1.pkg', 'shadow2.pkg', 'shadow3.pkg'])], run_command, ['$MAKE -s --no-print-directory T12485a'])
 
 test('T13703', [extra_files(['test13703a.pkg', 'test13703b.pkg'])], run_command, ['$MAKE -s --no-print-directory T13703'])
+
+test('T15396', [extra_files(['T15396.pkg', 'libT15396_odd.a'])], run_command, ['$MAKE -s --no-print-directory T15396'])
diff --git a/testsuite/tests/cabal/libT15396_odd.a b/testsuite/tests/cabal/libT15396_odd.a
new file mode 100644
index 0000000..749b80d
--- /dev/null
+++ b/testsuite/tests/cabal/libT15396_odd.a
@@ -0,0 +1,2 @@
+!<arch>
+NAMENAMENAMENAME0000000000000000000000000000000000000000000`



More information about the ghc-commits mailing list