diff options
| author | Joachim Breitner <mail@joachim-breitner.de> | 2014-01-14 09:36:34 +0000 |
|---|---|---|
| committer | Joachim Breitner <breitner@kit.edu> | 2014-02-04 16:20:09 +0100 |
| commit | 3336339b03e5961a3064c43a8ab062f080b6ef55 (patch) | |
| tree | d74348dbee6a583a685f4a02f65cedc2cbbaf788 | |
| parent | 2e6a0d80451a0f3e5d676c5424a82859b1974a60 (diff) | |
| download | haskell-3336339b03e5961a3064c43a8ab062f080b6ef55.tar.gz | |
CPR test case: Case binder CPR
| -rw-r--r-- | testsuite/tests/stranal/sigs/CaseBinderCPR.hs | 15 | ||||
| -rw-r--r-- | testsuite/tests/stranal/sigs/CaseBinderCPR.stderr | 5 | ||||
| -rw-r--r-- | testsuite/tests/stranal/sigs/all.T | 1 |
3 files changed, 21 insertions, 0 deletions
diff --git a/testsuite/tests/stranal/sigs/CaseBinderCPR.hs b/testsuite/tests/stranal/sigs/CaseBinderCPR.hs new file mode 100644 index 0000000000..13f216347d --- /dev/null +++ b/testsuite/tests/stranal/sigs/CaseBinderCPR.hs @@ -0,0 +1,15 @@ +module CaseBinderCPR where + +-- This example, taken from nofib's transform (and heavily reduced) ensures that +-- CPR information is added to a case binder + +f_list_cmp::(t1 -> t1 -> Int) -> [t1] -> [t1] -> Int; +f_list_cmp a_cmp [] []= 0 +f_list_cmp a_cmp [] a_ys= -1 +f_list_cmp a_cmp a_xs []= 1 +f_list_cmp a_cmp (a_x:a_xs) (a_y:a_ys)= + if r_order == 0 + then f_list_cmp a_cmp a_xs a_ys + else r_order + where + r_order = a_cmp a_x a_y diff --git a/testsuite/tests/stranal/sigs/CaseBinderCPR.stderr b/testsuite/tests/stranal/sigs/CaseBinderCPR.stderr new file mode 100644 index 0000000000..f2ea61d178 --- /dev/null +++ b/testsuite/tests/stranal/sigs/CaseBinderCPR.stderr @@ -0,0 +1,5 @@ + +==================== Strictness signatures ==================== +CaseBinderCPR.f_list_cmp: <L,C(C1(U(U)))><S,1*U><S,1*U>m() + + diff --git a/testsuite/tests/stranal/sigs/all.T b/testsuite/tests/stranal/sigs/all.T index 9d36479c17..81a8d4b1b8 100644 --- a/testsuite/tests/stranal/sigs/all.T +++ b/testsuite/tests/stranal/sigs/all.T @@ -15,3 +15,4 @@ test('FacState', expect_broken(1600), compile, ['']) test('UnsatFun', normal, compile, ['']) test('BottomFromInnerLambda', normal, compile, ['']) test('DmdAnalGADTs', normal, compile, ['']) +test('CaseBinderCPR', normal, compile, ['']) |