Skip to content

Commit e15eea5

Browse files
authored
Merge pull request #25 from purescript-contrib/tweak-gen-size
Reduce size in `genJson` to prevent excessively large structures
2 parents 7ee12c0 + d7592b8 commit e15eea5

File tree

3 files changed

+15
-12
lines changed

3 files changed

+15
-12
lines changed

bower.json

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,6 @@
3333
"purescript-maps": "^3.0.0"
3434
},
3535
"devDependencies": {
36-
"purescript-strongcheck": "^3.1.0"
36+
"purescript-quickcheck": "^4.6.1"
3737
}
3838
}

src/Data/Argonaut/Gen.purs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -15,15 +15,15 @@ import Data.String as S
1515
import Data.StrMap as SM
1616

1717
genJson :: forall m. MonadGen m => MonadRec m => Lazy (m J.Json) => m J.Json
18-
genJson = Gen.resize (min 10) $ Gen.sized genJson'
18+
genJson = Gen.resize (min 5) $ Gen.sized genJson'
1919
where
2020
genJson' :: Int -> m J.Json
2121
genJson' size
2222
| size > 1 = Gen.resize (_ - 1) (Gen.choose genJArray genJObject)
2323
| otherwise = genLeaf
2424

2525
genLeaf :: m J.Json
26-
genLeaf = Gen.oneOf $ pure J.jsonNull :| [ genJBoolean, genJNumber, genJString]
26+
genLeaf = Gen.oneOf $ pure J.jsonNull :| [genJBoolean, genJNumber, genJString]
2727

2828
genJArray :: m J.Json
2929
genJArray = J.fromArray <$> Gen.unfoldable (defer \_ -> genJson)

test/Test/Main.purs

Lines changed: 12 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -17,8 +17,8 @@ import Control.Monad.Gen as Gen
1717

1818
import Partial.Unsafe (unsafePartial)
1919

20-
import Test.StrongCheck (SC, (===), (<?>), assert, quickCheck, quickCheck', Result)
21-
import Test.StrongCheck.Gen (Gen)
20+
import Test.QuickCheck (class Testable, QC, Result, quickCheck, quickCheck', (<?>), (===))
21+
import Test.QuickCheck.Gen (Gen)
2222

2323
foreign import thisIsNull :: Json
2424
foreign import thisIsBoolean :: Json
@@ -28,7 +28,7 @@ foreign import thisIsArray :: Json
2828
foreign import thisIsObject :: Json
2929
foreign import nil :: JNull
3030

31-
isTest :: SC () Unit
31+
isTest :: QC () Unit
3232
isTest = do
3333
assert (isNull thisIsNull <?> "Error in null test")
3434
assert (isBoolean thisIsBoolean <?> "Error in boolean test")
@@ -37,7 +37,7 @@ isTest = do
3737
assert (isArray thisIsArray <?> "Error in array test")
3838
assert (isObject thisIsObject <?> "Error in object test")
3939

40-
foldTest :: SC () Unit
40+
foldTest :: QC () Unit
4141
foldTest = do
4242
assert (foldFn thisIsNull == "null" <?> "Error in foldJson null")
4343
assert (foldFn thisIsBoolean == "boolean" <?> "Error in foldJson boolean")
@@ -65,7 +65,7 @@ cases =
6565
, thisIsObject
6666
]
6767

68-
foldXXX :: SC () Unit
68+
foldXXX :: QC () Unit
6969
foldXXX = do
7070
assert ((foldJsonNull "not null" (const "null") <$> cases) ==
7171
["null", "not null", "not null", "not null", "not null", "not null"] <?>
@@ -89,7 +89,7 @@ foldXXX = do
8989
"Error in foldJsonObject")
9090

9191

92-
fromTest :: SC () Unit
92+
fromTest :: QC () Unit
9393
fromTest = do
9494
assert ((foldJsonNull false (const true) (fromNull nil)) <?> "Error in fromNull")
9595
quickCheck (\bool -> foldJsonBoolean Nothing Just (fromBoolean bool) == Just bool <?> "Error in fromBoolean")
@@ -106,7 +106,7 @@ fromTest = do
106106
in (foldJsonObject Nothing Just (fromObject sm) == Just sm)
107107
<?> "Error in fromObject")
108108

109-
toTest :: SC () Unit
109+
toTest :: QC () Unit
110110
toTest = do
111111
assert (assertion toNull thisIsNull "Error in toNull")
112112
assert (assertion toBoolean thisIsBoolean "Error in toBoolean")
@@ -122,7 +122,7 @@ toTest = do
122122
in forCases == exact <?> msg
123123

124124

125-
parserTest :: SC () Unit
125+
parserTest :: QC () Unit
126126
parserTest = do
127127
assert ((isLeft (jsonParser "\\\ffff")) <?> "Error in jsonParser")
128128
quickCheck' 10 roundtripTest
@@ -132,7 +132,10 @@ parserTest = do
132132
json <- Gen.resize (const 5) genJson
133133
pure $ jsonParser (stringify json) === Right json
134134

135-
main :: SC () Unit
135+
assert :: forall eff prop. Testable prop => prop -> QC eff Unit
136+
assert = quickCheck' 1
137+
138+
main :: QC () Unit
136139
main = do
137140
log "isXxx tests"
138141
isTest

0 commit comments

Comments
 (0)