diff options
| -rw-r--r-- | rts/PrimOps.cmm | 2 | ||||
| -rw-r--r-- | testsuite/tests/ghci.debugger/scripts/all.T | 5 | ||||
| -rw-r--r-- | testsuite/tests/ghci.debugger/scripts/hist002.script | 20 | ||||
| -rw-r--r-- | testsuite/tests/ghci.debugger/scripts/hist002.stdout | 37 |
4 files changed, 62 insertions, 2 deletions
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index bcf7b62fb7..ca519b60e7 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -2391,7 +2391,7 @@ stg_noDuplicatezh /* no arg list: explicit stack layout */ stg_getApStackValzh ( P_ ap_stack, W_ offset ) { - if (%INFO_PTR(ap_stack) == stg_AP_STACK_info) { + if (%INFO_PTR(UNTAG(ap_stack)) == stg_AP_STACK_info) { return (1,StgAP_STACK_payload(ap_stack,offset)); } else { return (0,ap_stack); diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T index d62dcd97e0..00a39d704e 100644 --- a/testsuite/tests/ghci.debugger/scripts/all.T +++ b/testsuite/tests/ghci.debugger/scripts/all.T @@ -84,7 +84,10 @@ test('listCommand001', [extra_files(['../Test3.hs']), combined_output], ghci_script, ['listCommand001.script']) test('listCommand002', normal, ghci_script, ['listCommand002.script']) -test('hist001', extra_files(['../Test3.hs']), ghci_script, ['hist001.script']) +test('hist001', [extra_files(['../Test3.hs']), extra_run_opts('+RTS -I0')], + ghci_script, ['hist001.script']) +test('hist002', [extra_files(['../Test3.hs']), extra_run_opts('+RTS -I0')], + ghci_script, ['hist002.script']) test('T2740', normal, ghci_script, ['T2740.script']) diff --git a/testsuite/tests/ghci.debugger/scripts/hist002.script b/testsuite/tests/ghci.debugger/scripts/hist002.script new file mode 100644 index 0000000000..0198207192 --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/hist002.script @@ -0,0 +1,20 @@ +:l Test3.hs +-- set a break on the [] case in map +:b 1 +-- trace an execution +:tr mymap (+1) [1,2] +:hist +:back +:show bindings +:back +:show bindings +:force _result +-- Run a GC so the BLACKHOLE indirection for _result (the AP_STACK) is removed, +-- ensuring _result now points directly to the value (in this case, the integer +-- 3). This will be tagged, so we are checking that the pointer isn't naively +-- dereferenced to generate an unaligned load. +System.Mem.performGC +:back +:forward +-- at this point, we can't retrieve the bindings because _result (the AP_STACK) +-- was evaluated previously. GHCi should not crash, preferably. diff --git a/testsuite/tests/ghci.debugger/scripts/hist002.stdout b/testsuite/tests/ghci.debugger/scripts/hist002.stdout new file mode 100644 index 0000000000..523605b00a --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/hist002.stdout @@ -0,0 +1,37 @@ +Breakpoint 0 activated at Test3.hs:1:14-15 +[2,3Stopped in Main.mymap, Test3.hs:1:14-15 +_result :: [a] = _ +-1 : mymap (Test3.hs:2:22-31) +-2 : mymap (Test3.hs:2:18-20) +-3 : mymap (Test3.hs:2:18-31) +-4 : mymap (Test3.hs:2:22-31) +-5 : mymap (Test3.hs:2:18-20) +-6 : mymap (Test3.hs:2:18-31) +<end of history> +Logged breakpoint at Test3.hs:2:22-31 +_result :: [a] +f :: t -> a +xs :: [t] +Ghci1._result :: [a] = _ +xs :: [t] = [] +f :: t -> a = _ +_result :: [a] = _ +Logged breakpoint at Test3.hs:2:18-20 +_result :: a +f :: Integer -> a +x :: Integer +Ghci1._result :: [a] = _ +xs :: [t] = [] +Ghci2.f :: t -> a = _ +Ghci2._result :: [a] = _ +x :: Integer = 2 +f :: Integer -> a = _ +_result :: a = _ +_result = 3 +Logged breakpoint at Test3.hs:2:18-31 +_result :: [a] +f :: Integer -> a +x :: Integer +xs :: [Integer] +Logged breakpoint at Test3.hs:2:18-20 +_result :: a |