git.iko.soy/typeable/postgresql-simple
on master help sign in
Merge pull request #189 from silkapp/master

Fix wrong parsing of arrays with text "NULL"

commitb40cd4f1726f716b5d9b0dfaa4d9ad3b4b9803b4 authorLeon P Smith <leon.p.smith+github@gmail.com> dateFri 10 Jun 2016, 17:10 (10 years ago) parent86ef90b74b2f4a
2 files changed+26−17
compare with master
unifiedsplit
src/Database/PostgreSQL/Simple/FromField.hs+1−1 test/Main.hs+25−16
src/Database/PostgreSQL/Simple/FromField.hs+1−1
@@ -526,7 +526,7 @@ fromArray fieldParser typeInfo f = sequence . (parseIt <$>) <$> array delim
526526 fElem = f{ typeOid = typoid (typelem typeInfo) }
527527
528528 parseIt item =
529− fieldParser f' $ if item' == "NULL" then Nothing else Just item'
529+ fieldParser f' $ if item == Arrays.Plain "NULL" then Nothing else Just item'
530530 where
531531 item' = fmt delim item
532532 f' | Arrays.Array _ <- item = f
test/Main.hs+25−16
@@ -39,23 +39,24 @@ tests :: TestEnv -> TestTree
3939tests env = testGroup "tests"
4040 $ map ($ env)
4141 [ testBytea
42− , testCase "ExecuteMany" . testExecuteMany
43− , testCase "Fold" . testFold
44− , testCase "Notify" . testNotify
45− , testCase "Serializable" . testSerializable
46− , testCase "Time" . testTime
47− , testCase "Array" . testArray
48− , testCase "HStore" . testHStore
49− , testCase "JSON" . testJSON
50− , testCase "Savepoint" . testSavepoint
51− , testCase "Unicode" . testUnicode
52− , testCase "Values" . testValues
53− , testCase "Copy" . testCopy
42+ , testCase "ExecuteMany" . testExecuteMany
43+ , testCase "Fold" . testFold
44+ , testCase "Notify" . testNotify
45+ , testCase "Serializable" . testSerializable
46+ , testCase "Time" . testTime
47+ , testCase "Array" . testArray
48+ , testCase "Array of nullables" . testNullableArray
49+ , testCase "HStore" . testHStore
50+ , testCase "JSON" . testJSON
51+ , testCase "Savepoint" . testSavepoint
52+ , testCase "Unicode" . testUnicode
53+ , testCase "Values" . testValues
54+ , testCase "Copy" . testCopy
5455 , testCopyFailures
55− , testCase "Double" . testDouble
56− , testCase "1-ary generic" . testGeneric1
57− , testCase "2-ary generic" . testGeneric2
58− , testCase "3-ary generic" . testGeneric3
56+ , testCase "Double" . testDouble
57+ , testCase "1-ary generic" . testGeneric1
58+ , testCase "2-ary generic" . testGeneric2
59+ , testCase "3-ary generic" . testGeneric3
5960 ]
6061
6162testBytea :: TestEnv -> TestTree
@@ -177,6 +178,14 @@ testArray TestEnv{..} = do
177178 queryFailure conn "SELECT '{1,2,3,4}'::_int4" (undefined :: V.Vector Bool)
178179 queryFailure conn "SELECT '{{1,2},{3,4}}'::_int4" (undefined :: V.Vector Int)
179180
181+testNullableArray :: TestEnv -> Assertion
182+testNullableArray TestEnv{..} = do
183+ xs <- query_ conn "SELECT '{sometext, \"NULL\"}'::_text"
184+ xs @?= [Only (V.fromList ["sometext", "NULL" :: Text])]
185+ xs <- query_ conn "SELECT '{sometext, NULL}'::_text"
186+ xs @?= [Only (V.fromList [Just "sometext", Nothing :: Maybe Text])]
187+ queryFailure conn "SELECT '{sometext, NULL}'::_text" (undefined :: V.Vector Text)
188+
180189testHStore :: TestEnv -> Assertion
181190testHStore TestEnv{..} = do
182191 execute_ conn "CREATE EXTENSION IF NOT EXISTS hstore"