From 53e5e32d40a16923ba1d362f405015c3a679bfeb Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Wed, 22 Jan 2014 20:44:51 -0500 Subject: [PATCH] Implement the other ON DELETE CASCADE tests and update the TODO. --- doc/TODO | 4 +-- src/TSN/XML/News.hs | 8 ++--- src/TSN/XML/Odds.hs | 67 ++++++++++++++++++++++++++++++++++++++++-- src/TSN/XML/Weather.hs | 42 ++++++++++++++++++++++++-- 4 files changed, 109 insertions(+), 12 deletions(-) diff --git a/doc/TODO b/doc/TODO index 42f3b2c..7a64789 100644 --- a/doc/TODO +++ b/doc/TODO @@ -4,6 +4,4 @@ 2. Write a test for test/xml/Odds_XML-long-import.xml once it no longer takes 10 minutes to import (Postgres only?). -3. Write a test for the ON DELETE CASCADE behavior (Odds_XML, weatherxml). - -4. Add support the the second type of weatherxml (see man page). +3. Add support the the second type of weatherxml (see man page). diff --git a/src/TSN/XML/News.hs b/src/TSN/XML/News.hs index 2cc9698..8026dcd 100644 --- a/src/TSN/XML/News.hs +++ b/src/TSN/XML/News.hs @@ -505,9 +505,11 @@ test_unpickle_succeeds = testGroup "unpickle tests" test_on_delete_cascade :: TestTree test_on_delete_cascade = testGroup "cascading delete tests" [ check "deleting news deletes its children" - "test/xml/newsxml.xml" ] + "test/xml/newsxml.xml" + 4 -- 2 news_teams and 2 news_locations that should remain. + ] where - check desc path = testCase desc $ do + check desc path expected = testCase desc $ do news <- unsafe_unpickle path pickle_message let a = undefined :: News let b = undefined :: NewsTeam @@ -530,6 +532,4 @@ test_on_delete_cascade = testGroup "cascading delete tests" count_d <- countAll d count_e <- countAll e return $ count_a + count_b + count_c + count_d + count_e - -- There are 2 news_teams and 2 news_locations that should remain. - let expected = 4 actual @?= expected diff --git a/src/TSN/XML/Odds.hs b/src/TSN/XML/Odds.hs index 9cc3818..8cfe4ce 100644 --- a/src/TSN/XML/Odds.hs +++ b/src/TSN/XML/Odds.hs @@ -31,10 +31,16 @@ import Data.Tuple.Curry ( uncurryN ) import Database.Groundhog ( (=.), (==.), + countAll, + executeRaw, insert_, migrate, + runMigration, + silentMigrationLogger, update ) import Database.Groundhog.Core ( DefaultKey ) +import Database.Groundhog.Generic ( runDbConn ) +import Database.Groundhog.Sqlite ( withSqliteConn ) import Database.Groundhog.TH ( groundhog, mkPersist ) @@ -67,7 +73,8 @@ import Xml ( FromXmlFk(..), ToDb(..), pickle_unpickle, - unpickleable ) + unpickleable, + unsafe_unpickle ) -- @@ -731,7 +738,8 @@ odds_tests :: TestTree odds_tests = testGroup "Odds tests" - [ test_pickle_of_unpickle_is_identity, + [ test_on_delete_cascade, + test_pickle_of_unpickle_is_identity, test_unpickle_succeeds ] @@ -778,3 +786,58 @@ test_unpickle_succeeds = testGroup "unpickle tests" actual <- unpickleable path pickle_message let expected = True actual @?= expected + + +-- | Make sure everything gets deleted when we delete the top-level +-- record. +-- +test_on_delete_cascade :: TestTree +test_on_delete_cascade = testGroup "cascading delete tests" + [ check "deleting odds deleted its children" + "test/xml/Odds_XML.xml" + 13 -- 5 casinos, 8 teams + , + + check "deleting odds deleted its children (non-int team_id)" + "test/xml/Odds_XML-noninteger-team-id.xml" + 51 -- 5 casinos, 46 teams + , + + check "deleting odds deleted its children (positive(+) line)" + "test/xml/Odds_XML-positive-line.xml" + 17 -- 5 casinos, 12 teams + , + + check "deleting odds deleted its children (large file)" + "test/xml/Odds_XML-largefile.xml" + 189 -- 5 casinos, 184 teams + ] + where + check desc path expected = testCase desc $ do + odds <- unsafe_unpickle path pickle_message + let a = undefined :: Odds + let b = undefined :: OddsCasino + let c = undefined :: OddsGameTeam + let d = undefined :: OddsGame + let e = undefined :: OddsGame_OddsGameTeam + let f = undefined :: OddsGameLine + actual <- withSqliteConn ":memory:" $ runDbConn $ do + runMigration silentMigrationLogger $ do + migrate a + migrate b + migrate c + migrate d + migrate e + migrate f + _ <- dbimport odds + -- No idea how 'delete' works, so do this instead. + executeRaw False "DELETE FROM odds;" [] + count_a <- countAll a + count_b <- countAll b + count_c <- countAll c + count_d <- countAll d + count_e <- countAll e + count_f <- countAll f + return $ sum [count_a, count_b, count_c, + count_d, count_e, count_f ] + actual @?= expected diff --git a/src/TSN/XML/Weather.hs b/src/TSN/XML/Weather.hs index e9515ed..2561377 100644 --- a/src/TSN/XML/Weather.hs +++ b/src/TSN/XML/Weather.hs @@ -23,8 +23,15 @@ where import Control.Monad ( forM_ ) import Data.Time ( UTCTime ) import Data.Tuple.Curry ( uncurryN ) -import Database.Groundhog ( migrate ) +import Database.Groundhog ( + countAll, + executeRaw, + migrate, + runMigration, + silentMigrationLogger ) import Database.Groundhog.Core ( DefaultKey ) +import Database.Groundhog.Generic ( runDbConn ) +import Database.Groundhog.Sqlite ( withSqliteConn ) import Database.Groundhog.TH ( groundhog, mkPersist ) @@ -53,7 +60,8 @@ import Xml ( FromXmlFk(..), ToDb(..), pickle_unpickle, - unpickleable ) + unpickleable, + unsafe_unpickle ) -- @@ -351,7 +359,8 @@ weather_tests :: TestTree weather_tests = testGroup "Weather tests" - [ test_pickle_of_unpickle_is_identity, + [ test_on_delete_cascade, + test_pickle_of_unpickle_is_identity, test_unpickle_succeeds ] @@ -376,3 +385,30 @@ test_unpickle_succeeds = actual <- unpickleable path pickle_message let expected = True actual @?= expected + + +-- | Make sure everything gets deleted when we delete the top-level +-- record. +-- +test_on_delete_cascade :: TestTree +test_on_delete_cascade = + testCase "deleting weather deletes its children" $ do + let path = "test/xml/weatherxml.xml" + weather <- unsafe_unpickle path pickle_message + let a = undefined :: Weather + let b = undefined :: WeatherForecast + let c = undefined :: WeatherForecastListing + actual <- withSqliteConn ":memory:" $ runDbConn $ do + runMigration silentMigrationLogger $ do + migrate a + migrate b + migrate c + _ <- dbimport weather + -- No idea how 'delete' works, so do this instead. + executeRaw False "DELETE FROM weather;" [] + count_a <- countAll a + count_b <- countAll b + count_c <- countAll c + return $ count_a + count_b + count_c + let expected = 0 + actual @?= expected -- 2.44.2