diff options
author | Phuong Trinh <lolotp@fb.com> | 2019-04-25 18:44:02 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-06-13 02:48:50 -0400 |
commit | fc6b23be509e290f8d27775a1c637284a335ed81 (patch) | |
tree | e977d63250a03296011b58434034cb2c471bf43f | |
parent | 5ffc266e9c5ec8ed6010835165a65bd1f6b56dd4 (diff) | |
download | haskell-fc6b23be509e290f8d27775a1c637284a335ed81.tar.gz |
Fix #16525: ObjectCode freed wrongly because of lack of info header check
`checkUnload` currently doesn't check the info header of static objects.
Thus, it may free an `ObjectCode` struct wrongly even if there's still a
live static object whose info header lies in a mapped section of that
`ObjectCode`. This fixes the issue by adding an appropriate check.
-rw-r--r-- | rts/CheckUnload.c | 1 | ||||
-rw-r--r-- | rts/Linker.c | 6 | ||||
-rw-r--r-- | rts/linker/M32Alloc.c | 2 | ||||
-rw-r--r-- | testsuite/tests/ghci/T16525a/A.hs | 12 | ||||
-rw-r--r-- | testsuite/tests/ghci/T16525a/B.hs | 3 | ||||
-rw-r--r-- | testsuite/tests/ghci/T16525a/T16525a.script | 6 | ||||
-rw-r--r-- | testsuite/tests/ghci/T16525a/T16525a.stdout | 0 | ||||
-rw-r--r-- | testsuite/tests/ghci/T16525a/all.T | 5 |
8 files changed, 34 insertions, 1 deletions
diff --git a/rts/CheckUnload.c b/rts/CheckUnload.c index 0af9f464a1..f658d2c73d 100644 --- a/rts/CheckUnload.c +++ b/rts/CheckUnload.c @@ -404,6 +404,7 @@ void checkUnload (StgClosure *static_objects) p = UNTAG_STATIC_LIST_PTR(p); checkAddress(addrs, p, s_indices); info = get_itbl(p); + checkAddress(addrs, info, s_indices); link = *STATIC_LINK(info, p); } diff --git a/rts/Linker.c b/rts/Linker.c index 6f0ba58abb..9fb91bf3ca 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -1185,11 +1185,17 @@ void freeObjectCode (ObjectCode *oc) oc->sections[i].mapped_size); break; case SECTION_M32: + IF_DEBUG(sanity, + memset(oc->sections[i].start, + 0x00, oc->sections[i].size)); m32_free(oc->sections[i].start, oc->sections[i].size); break; #endif case SECTION_MALLOC: + IF_DEBUG(sanity, + memset(oc->sections[i].start, + 0x00, oc->sections[i].size)); stgFree(oc->sections[i].start); break; default: diff --git a/rts/linker/M32Alloc.c b/rts/linker/M32Alloc.c index 52b182e54d..33c4335286 100644 --- a/rts/linker/M32Alloc.c +++ b/rts/linker/M32Alloc.c @@ -24,7 +24,7 @@ Note [Compile Time Trickery] This file implements two versions of each of the `m32_*` functions. At the top of the file there is the real implementation (compiled in when `RTS_LINKER_USE_MMAP` is true) and a dummy implementation that exists only to -satisfy the compiler and which hould never be called. If any of these dummy +satisfy the compiler and which should never be called. If any of these dummy implementations are called the program will abort. The rationale for this is to allow the calling code to be written without using diff --git a/testsuite/tests/ghci/T16525a/A.hs b/testsuite/tests/ghci/T16525a/A.hs new file mode 100644 index 0000000000..dc4ced10cb --- /dev/null +++ b/testsuite/tests/ghci/T16525a/A.hs @@ -0,0 +1,12 @@ +module A where + +import B + +myIntVal :: Int +myIntVal = sum [1,2,3,4] + +value :: [Value] +value = [Value "a;lskdfa;lszkfsd;alkfjas" myIntVal] + +v1 :: Value -> String +v1 (Value a _) = a diff --git a/testsuite/tests/ghci/T16525a/B.hs b/testsuite/tests/ghci/T16525a/B.hs new file mode 100644 index 0000000000..7be77cb1b6 --- /dev/null +++ b/testsuite/tests/ghci/T16525a/B.hs @@ -0,0 +1,3 @@ +module B where + +data Value = Value String Int diff --git a/testsuite/tests/ghci/T16525a/T16525a.script b/testsuite/tests/ghci/T16525a/T16525a.script new file mode 100644 index 0000000000..d48cfd0f2d --- /dev/null +++ b/testsuite/tests/ghci/T16525a/T16525a.script @@ -0,0 +1,6 @@ +:set -fobject-code +:load A +import Control.Concurrent +_ <- forkIO $ threadDelay 1000000 >> (print (map v1 value)) +:l [] +System.Mem.performGC diff --git a/testsuite/tests/ghci/T16525a/T16525a.stdout b/testsuite/tests/ghci/T16525a/T16525a.stdout new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/ghci/T16525a/T16525a.stdout diff --git a/testsuite/tests/ghci/T16525a/all.T b/testsuite/tests/ghci/T16525a/all.T new file mode 100644 index 0000000000..6fbd3e8a4f --- /dev/null +++ b/testsuite/tests/ghci/T16525a/all.T @@ -0,0 +1,5 @@ +test('T16525a', + [extra_files(['A.hs', 'B.hs', ]), + extra_run_opts('+RTS -DS -RTS'), + when(ghc_dynamic(), skip), ], + ghci_script, ['T16525a.script']) |