what

yesodweb · May 13, 2019 · 37d2d25 · 37d2d25
1 parent 10ff69c
commit 37d2d25
Show file tree

Hide file tree

Showing 3 changed files with 40 additions and 13 deletions.
diff --git a/persistent-mysql/test/main.hs b/persistent-mysql/test/main.hs
@@ -31,6 +31,7 @@ import qualified LargeNumberTest
 import qualified MaxLenTest
 import qualified MigrationColumnLengthTest
 import qualified MigrationIdempotencyTest
+import qualified MigrationTest
 import qualified MigrationOnlyTest
 import qualified MpsNoPrefixTest
 import qualified PersistentTest
@@ -153,6 +154,7 @@ main = do
     MaxLenTest.specsWith db
     Recursive.specsWith db
     SumTypeTest.specsWith db (Just (runMigrationSilent SumTypeTest.sumTypeMigrate))
+    MigrationTest.specsWith db
     MigrationOnlyTest.specsWith db
         (Just
             $ runMigrationSilent MigrationOnlyTest.migrateAll1

diff --git a/persistent-postgresql/test/main.hs b/persistent-postgresql/test/main.hs
@@ -34,6 +34,7 @@ import qualified MaxLenTest
 import qualified MigrationColumnLengthTest
 import qualified MigrationOnlyTest
 import qualified MpsNoPrefixTest
+import qualified MigrationTest
 import qualified PersistentTest
 import qualified PersistUniqueTest
 import qualified PrimaryTest
@@ -146,6 +147,7 @@ main = do
     MaxLenTest.specsWith db
     Recursive.specsWith db
     SumTypeTest.specsWith db (Just (runMigrationSilent SumTypeTest.sumTypeMigrate))
+    MigrationTest.specsWith db
     MigrationOnlyTest.specsWith db
         (Just
             $ runMigrationSilent MigrationOnlyTest.migrateAll1

diff --git a/persistent-test/src/MigrationTest.hs b/persistent-test/src/MigrationTest.hs
@@ -17,6 +17,7 @@ Target
 Source
     field3 Int
     field4 TargetId
+
 |]
 
 share [mkPersist sqlSettings, mkMigrate "migrationAddCol", mkDeleteCascade sqlSettings] [persistLowerCase|
@@ -30,21 +31,43 @@ Source1 sql=source
     field3 Int
     extra  Int
     field4 Target1Id
+
 |]
 
-specsWith :: (MonadIO m) => RunDb SqlBackend m -> Spec
+share [mkPersist sqlSettings, mkMigrate "addPrimKey", mkDeleteCascade sqlSettings] [persistLowerCase|
+FromRawMigration
+    name T.Text
+    age  Int
+
+    Primary name
+
+|]
+
+specsWith :: (MonadIO m, MonadFail m) => RunDb SqlBackend m -> Spec
 specsWith runDb = describe "Migration" $ do
     it "is idempotent" $ runDb $ do
-      again <- getMigration migrationMigrate
-      liftIO $ again @?= []
-    it "really is idempotent" $ runDb $ do
-      runMigration migrationMigrate
-      again <- getMigration migrationMigrate
-      liftIO $ again @?= []
+        _ <- runMigration migrateionMigrate
+        again <- getMigration migrationMigrate
+        liftIO $ again @?= []
     it "can add an extra column" $ runDb $ do
-      -- Failing test case for #735.  Foreign-key checking, switched on in
-      -- version 2.6.1, caused persistent-sqlite to generate a `references`
-      -- constraint in a *temporary* table during migration, which fails.
-      _ <- runMigration migrationAddCol
-      again <- getMigration migrationAddCol
-      liftIO $ again @?= []
+        -- Failing test case for #735.  Foreign-key checking, switched on in
+        -- version 2.6.1, caused persistent-sqlite to generate a `references`
+        -- constraint in a *temporary* table during migration, which fails.
+        _ <- runMigration migrationMigrate
+        _ <- runMigration migrationAddCol
+        again <- getMigration migrationAddCol
+        liftIO $ again @?= []
+    describe "Add Primary key constraint on raw table" $ do
+        it "should not be considered safe" $ runDb $ do
+            rawExecute "CREATE TABLE from_raw_migration (name VARCHAR NOT NULL, age INT8 NOT NULL)" []
+            Right migration <- parseMigration addPrimKey
+            liftIO $ migration
+                `shouldSatisfy`
+                    (\cm -> True `elem` map fst cm)
+
+        it "works" $ runDb $ do
+            rawExecute "CREATE TABLE from_raw_migration (name VARCHAR NOT NULL, age INT NOT NULL)" []
+            Right migration <- parseMigration addPrimKey
+            () <- runMigration addPrimKey
+            again <- getMigration addPrimKey
+            liftIO $ again @?= []