Skip to content

Commit b111aee

Browse files
NadiaYvetteNadiaYvette
committed
add testcases for -XImpredicativeTypes failures
With -XImpredicativeTypes, the following occurs: basic_typeclass.i.hs:877:28: error: [GHC-36495] • tagToEnum# must appear applied to one value argument • In the first argument of ‘(&&)’, namely ‘(GHC.Exts.tagToEnum# (offset >=# 0#))’ In the expression: (GHC.Exts.tagToEnum# (offset >=# 0#)) && let check = alexIndexInt16OffAddr alex_check offset in (GHC.Exts.tagToEnum# (check ==# ord_c)) In the expression: if (GHC.Exts.tagToEnum# (offset >=# 0#)) && let check = alexIndexInt16OffAddr alex_check offset in (GHC.Exts.tagToEnum# (check ==# ord_c)) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s | 877 | new_s = if GTE(offset,ILIT(0)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1 parent 13839ec commit b111aee

File tree

3 files changed

+129
-3
lines changed

3 files changed

+129
-3
lines changed

‎alex.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -80,6 +80,7 @@ extra-source-files:
8080
tests/gscan_typeclass.x
8181
tests/posn_typeclass.x
8282
tests/monad_typeclass.x
83+
tests/monadic_expr.x
8384
tests/monad_typeclass_bytestring.x
8485
tests/monadUserState_typeclass.x
8586
tests/monadUserState_typeclass_bytestring.x

‎tests/Makefile‎

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -86,6 +86,7 @@ ifeq "$(GHC_SHIPS_WITH_TEXT)" "yes"
8686
TEXT_DEP = -package text
8787

8888
TEXT_TESTS = \
89+
monadic_expr.x \
8990
strict_text_typeclass.x \
9091
posn_typeclass_strict_text.x \
9192
tokens_monadUserState_strict_text.x
@@ -105,12 +106,15 @@ TEST_ALEX_OPTS=
105106
%.g.hs : %.x
106107
$(ALEX) $(TEST_ALEX_OPTS) -g $< -o $@
107108

109+
%.i.hs : %.x
110+
$(ALEX) $(TEST_ALEX_OPTS) -g $< -o $@
111+
108112
%.d.hs : %.x
109113
$(ALEX) $(TEST_ALEX_OPTS) --debug $< -o $@
110114

111-
CLEAN_FILES += *.n.hs *.g.hs *.d.hs *.info *.hi *.o *.bin *.exe
115+
CLEAN_FILES += *.n.hs *.g.hs *.i.hs *.d.hs *.info *.hi *.o *.bin *.exe
112116

113-
TESTS_HS = $(shell echo $(TESTS) $(TEXT_TESTS) | sed -e 's/\([^\. ]*\)\.\(l\)\{0,1\}x/\1.n.hs \1.g.hs/g')
117+
TESTS_HS = $(shell echo $(TESTS) $(TEXT_TESTS) | sed -e 's/\([^\. ]*\)\.\(l\)\{0,1\}x/\1.n.hs \1.g.hs \1.i.hs/g')
114118
TESTS_HS_DEBUG = $(shell echo $(TESTS) $(TEXT_TESTS) | sed -e 's/\([^\. ]*\)\.\(l\)\{0,1\}x/\1.d.hs/g')
115119
TESTS_HS_ALL = $(TESTS_HS) $(TESTS_HS_DEBUG)
116120

@@ -122,7 +126,7 @@ ALL_TESTS = $(BASIC_TESTS) $(DEBUG_TESTS)
122126
./$<
123127

124128
%$(HS_PROG_EXT) : %.hs
125-
$(HC) $(HC_OPTS) -package array -package bytestring $(TEXT_DEP) $($*_LD_OPTS) $< -o $@
129+
$(HC) $(if $(findstring .i.,$@),-XImpredicativeTypes,) $(HC_OPTS) -package array -package bytestring $(TEXT_DEP) $($*_LD_OPTS) $< -o $@
126130

127131
all :: $(ALL_TESTS)
128132

‎tests/monadic_expr.x‎

Lines changed: 121 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,121 @@
1+
{
2+
module Main (main) where
3+
import {- "containers" -} Data.Set (Set)
4+
import {- "containers" -} qualified Data.Set as Set
5+
import {- "text" -} Data.Text (Text)
6+
import {- "text" -} qualified Data.Text as Text
7+
import {- "text" -} qualified Data.Text.Read as Text
8+
import {- "base" -} Control.Arrow hiding (arr)
9+
import {- "base" -} Control.Monad
10+
import {- "base" -} Control.Monad.Fail
11+
import {- "base" -} Numeric.Natural
12+
import {- "base" -} System.Exit
13+
}
14+
15+
%wrapper "monadUserState-strict-text"
16+
%token "Token integer"
17+
%typeclass "Integral integer, Read integer, Show integer"
18+
19+
-- ugh
20+
$digit = 0-9
21+
$unidigit = 1-9
22+
@number = [0] | $unidigit $digit*
23+
24+
tokens :-
25+
$white+ { skip }
26+
@number { \(_, _, _, s) len -> case Text.decimal (Text.take len s) of
27+
Left e -> fail e
28+
Right (n, txt)
29+
| Text.null txt -> pure $ TokenInt n
30+
| otherwise -> fail "got incomplete prefix " }
31+
[a-z]+ { \(_, _, _, s) len -> do
32+
let name = Text.take len s
33+
alexSeenVar name
34+
pure $ TokenVar name }
35+
[\+] { mk0ary TokenAdd }
36+
[\-] { mk0ary TokenSub }
37+
[\*] { mk0ary TokenMul }
38+
[\/] { mk0ary TokenDiv }
39+
[\^] { mk0ary TokenPow }
40+
[\(] { mk0ary TokenLPar }
41+
[\)] { mk0ary TokenRPar }
42+
43+
{
44+
mk0ary :: (Read integer, Integral integer) => Token integer -> AlexInput -> Int -> Alex (Token integer)
45+
mk0ary tok _ _ = pure tok
46+
47+
data AlexUserState
48+
= AlexUserState {
49+
ausVars :: Set Text
50+
} deriving (Eq, Read, Show)
51+
52+
alexSeenVar :: Text -> Alex ()
53+
alexSeenVar txt = do
54+
AlexUserState { ausVars = set } <- alexGetUserState
55+
alexSetUserState $ AlexUserState { ausVars = txt `Set.insert` set }
56+
57+
alexInitUserState :: AlexUserState
58+
alexInitUserState = AlexUserState { ausVars = Set.empty }
59+
60+
data Token integer
61+
= TokenInt integer
62+
| TokenVar Text
63+
| TokenLPar
64+
| TokenRPar
65+
| TokenPow
66+
| TokenDiv
67+
| TokenMul
68+
| TokenSub
69+
| TokenAdd
70+
| EOF
71+
deriving (Eq, Read, Show)
72+
73+
alexEOF :: (Read integer, Integral integer) => Alex (Token integer)
74+
alexEOF = pure EOF
75+
76+
instance MonadFail Alex where
77+
fail s = Alex . const $ Left s
78+
79+
evalAlex :: Text -> Alex t -> Either String (AlexUserState, t)
80+
evalAlex txt alex = right (first getUserState) $ f state where
81+
f = unAlex alex
82+
getUserState AlexState { alex_ust = userState } = userState
83+
state = AlexState
84+
{ alex_bytes = []
85+
, alex_pos = alexStartPos
86+
, alex_inp = txt
87+
, alex_chr = '\n'
88+
, alex_ust = alexInitUserState
89+
, alex_scd = 0 }
90+
91+
scanAll :: (Eq integer, Integral integer, Read integer, Show integer) => Alex [Token integer]
92+
scanAll = alexMonadScan >>= \result -> case result of
93+
EOF -> pure []
94+
tok -> (tok :) <$> scanAll
95+
96+
tests :: [(Text, Set Text, [Token Natural])]
97+
tests = [ (Text.pack "x*y/(x^3+y^3)"
98+
, Set.fromList [x, y]
99+
, [TokenVar x, TokenMul, TokenVar y, TokenDiv, TokenLPar, TokenVar x, TokenPow, TokenInt 3, TokenAdd, TokenVar y, TokenPow, TokenInt 3, TokenRPar])] where
100+
x = Text.pack "x"
101+
y = Text.pack "y"
102+
103+
main :: IO ()
104+
main = do
105+
forM_ tests $ \(txt, vars, toks) -> do
106+
case evalAlex txt scanAll of
107+
Right (AlexUserState { ausVars = tokVars }, tokList)
108+
| tokVars == vars && toks == tokList -> pure ()
109+
| otherwise -> do
110+
when (toks /= tokList) $ do
111+
putStrLn $ "got " <> show tokList
112+
putStrLn $ "wanted " <> show toks
113+
when (tokVars /= vars) $ do
114+
putStrLn $ "got " <> show tokVars
115+
putStrLn $ "wanted " <> show vars
116+
exitFailure
117+
Left errorString -> do
118+
putStrLn $ "got error " <> errorString
119+
exitFailure
120+
exitSuccess
121+
}

0 commit comments

Comments
 (0)