Merge pull request #38 from charsbar/github_actions

comewalk · web-flow · commit 5d9401964b23 · 2020-10-29T11:36:41.000+09:00
Add GitHub actions
diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
@@ -0,0 +1,50 @@
+name: build
+
+on:
+  push:
+    branches:
+      - '*'
+    tags-ignore:
+      - '*'
+  pull_request:
+
+jobs:
+  sqlite:
+    runs-on: ubuntu-latest
+
+    steps:
+      - uses: actions/checkout@v1
+      - name: perl -V
+        run: perl -V
+      - name: Install dependencies
+        run: curl -sL https://git.io/cpm | sudo perl - install -g --with-recommends --with-test --with-configure --show-build-log-on-failure --feature=test_sqlite
+      - name: Run tests
+        run: prove -lr -j4 t
+
+  mysql:
+    runs-on: ubuntu-latest
+
+    steps:
+      - uses: actions/checkout@v1
+      - name: perl -V
+        run: perl -V
+      - name: apt-get
+        run: sudo apt-get update && sudo apt-get install -y libdbd-mysql-perl mysql-server
+      - name: Install dependencies
+        run: curl -sL https://git.io/cpm | sudo perl - install -g --with-recommends --with-test --with-configure --show-build-log-on-failure --feature=test_mysql
+      - name: Run tests
+        run: DOD_TEST_DRIVER=MySQL prove -lr -j4 t
+
+  postgresql:
+    runs-on: ubuntu-latest
+
+    steps:
+      - uses: actions/checkout@v1
+      - name: perl -V
+        run: perl -V
+      - name: apt-get
+        run: sudo apt-get update && sudo apt-get install -y libdbd-pg-perl postgresql
+      - name: Install dependencies
+        run: curl -sL https://git.io/cpm | sudo perl - install -g --with-recommends --with-test --with-configure --show-build-log-on-failure --feature=test_postgresql
+      - name: Run tests
+        run: DOD_TEST_DRIVER=PostgreSQL prove -lr -j4 t
diff --git a/cpanfile b/cpanfile
@@ -23,3 +23,19 @@ on develop => sub {
 on test => sub {
     requires 'version';
 };
+
+feature 'test_sqlite', 'Test SQLite' => sub {
+    requires 'DBD::SQLite';
+};
+
+feature 'test_mysql', 'Test MySQL' => sub {
+    requires 'DBD::mysql';
+    requires 'Test::mysqld';
+    requires 'SQL::Translator';
+};
+
+feature 'test_postgresql', 'Test PostgreSQL' => sub {
+    requires 'DBD::Pg';
+    requires 'Test::PostgreSQL';
+    requires 'SQL::Translator';
+};
diff --git a/t/01-col-inheritance.t b/t/01-col-inheritance.t
@@ -36,6 +36,6 @@ ok ($wine->has_column("id")) ;
 ok ($wine->has_column("rating")) ;
 
 END {
-    Wine->driver->dbh->disconnect;
+    disconnect_all(qw( Wine ));
     teardown_dbs(qw( global ));
 }
diff --git a/t/02-basic.t b/t/02-basic.t
@@ -281,9 +281,7 @@ setup_dbs({
 }
 
 END {
-    for (qw/Wine Recipe/) {
-        $_->driver->rw_handle->disconnect;
-    }
+    disconnect_all(qw/Wine Recipe/);
     teardown_dbs(qw( global ));
 }
 
diff --git a/t/03-primary-keys.t b/t/03-primary-keys.t
@@ -106,9 +106,7 @@ SKIP: {
 }
 
 END {
-    for (qw/Wine Recipe Ingredient PkLess/) {
-        $_->driver->rw_handle->disconnect;
-    }
+    disconnect_all(qw/Wine Recipe Ingredient PkLess/);
     teardown_dbs(qw( global ));
 }
 
diff --git a/t/04-clone.t b/t/04-clone.t
@@ -88,9 +88,7 @@ test_basic_cloning('clone_all');
 }
 
 END {
-    for (qw/Wine Recipe Ingredient/) {
-        $_->driver->rw_handle->disconnect;
-    }
+    disconnect_all(qw/Wine Recipe Ingredient/);
     teardown_dbs(qw( global ));
 }
 
diff --git a/t/05-deflate.t b/t/05-deflate.t
@@ -93,8 +93,6 @@ is $is->[1]->name, 'Milk';
 ok $is->[1]->{__cached};
 
 END {
-    for (qw/Recipe Ingredient/) {
-        $_->driver->rw_handle->disconnect;
-    }
+    disconnect_all(qw( Recipe Ingredient ));
     teardown_dbs(qw( global ));
 }
diff --git a/t/06-errors.t b/t/06-errors.t
@@ -30,6 +30,6 @@ is(ErrorTest->driver->last_error,
    'Failed because of a unique constraint');
 
 END {
-    ErrorTest->driver->rw_handle->disconnect;
+    disconnect_all(qw( ErrorTest ));
     teardown_dbs(qw( global ));
 }
diff --git a/t/07-has-a-cached.t b/t/07-has-a-cached.t
@@ -66,8 +66,6 @@ $i3->save;
 is $ingredient->{__cache_recipe}, undef, "cache has effectively been destroyed";
 
 END {
-    for (qw/Recipe Ingredient/) {
-        $_->driver->rw_handle->disconnect;
-    }
+    disconnect_all(qw/Recipe Ingredient/);
     teardown_dbs(qw( global ));
 }
diff --git a/t/07-has-a.t b/t/07-has-a.t
@@ -65,8 +65,6 @@ my $r = $ingredient->recipe;
 is $r->recipe_id, $recipe->recipe_id, "recipe id back using 'parent_method'";
 
 END {
-    for (qw/Recipe Ingredient/) {
-        $_->driver->rw_handle->disconnect;
-    }
+    disconnect_all(qw/Recipe Ingredient/);
     teardown_dbs(qw( global ));
 }
diff --git a/t/09-resultset.t b/t/09-resultset.t
@@ -169,8 +169,8 @@ $result->rewind;
     my $result = Wine->result({rating => { op => '<=', 'value' => 4}}, { sort => 'rating', direction => 'descend' });
     $result->_load_results;
     $result->add_term({rating => { op => '<=', 'value' => 3}});
-    diag "calling next() after add_term() with 'op'" . $result->next; ## this should return the object which has "rating == 3".
+    note "calling next() after add_term() with 'op'" . $result->next; ## this should return the object which has "rating == 3".
 }
 
-$wine->driver->dbh->disconnect;
+disconnect_all($wine);
 teardown_dbs(qw( global ));
diff --git a/t/10-resultset-peek.t b/t/10-resultset-peek.t
@@ -146,5 +146,5 @@ is $result->peek_next->name, 'Stags Leap', 'the next one will be Stags Leap';
 is $result->next->name, 'Stags Leap';
 ok ! $result->peek_next, "Stags Leap was the last one";
 
-$wine->driver->dbh->disconnect;
+disconnect_all($wine);
 teardown_dbs(qw( global ));
diff --git a/t/12-windows.t b/t/12-windows.t
@@ -97,8 +97,7 @@ ok( !$iter->(), "No third row; limit argument respected" );
 is( $load_count, 2, "2 objects loaded; limit argument respected");
 $iter->end;
 
-$r->driver->dbh->disconnect;
-$i->driver->dbh->disconnect;
+disconnect_all($r, $i);
 teardown_dbs(qw( global ));
 
 print Dumper( Data::ObjectDriver->profiler->query_log ) if $ENV{DOD_PROFILE};
diff --git a/t/20-driver-sqlite.t b/t/20-driver-sqlite.t
@@ -63,6 +63,6 @@ ok $result, 'Found Stags Leap';
 is $result->rating, 3, 'Stags Leap is a 3';
 
 END {
-    Wine->driver->rw_handle->disconnect;
+    disconnect_all(qw( Wine ));
     teardown_dbs(qw( global ));
 }
diff --git a/t/31-cached.t b/t/31-cached.t
@@ -188,8 +188,6 @@ is($recipe2->remove, 1, 'Recipe removed successfully');
 require './t/txn-common.pl';
 
 END {
-    for (qw/Recipe Ingredient/) {
-        $_->driver->rw_handle->disconnect;
-    }
+    disconnect_all(qw/Recipe Ingredient/);
     teardown_dbs(qw( global ));
 }
diff --git a/t/32-partitioned.t b/t/32-partitioned.t
@@ -126,7 +126,6 @@ is $recipe2->remove, 1, 'Recipe removed successfully';
 require './t/txn-common.pl';
 
 END {
-    Recipe->driver->rw_handle->disconnect;
-    $_->rw_handle->disconnect for @{ Ingredient->driver->get_driver->(undef, {multi_partition => 1})->partitions };
+    disconnect_all(qw( Recipe Ingredient ));
     teardown_dbs(qw( global cluster1 cluster2 ));
 }
diff --git a/t/33-views.t b/t/33-views.t
@@ -54,8 +54,6 @@ SKIP: {
 }
 
 END {
-    for (qw/Recipe Ingredient Ingredient2Recipe IngredientsWeighted/) {
-        $_->driver->rw_handle->disconnect;
-    }
+    disconnect_all(qw/Recipe Ingredient Ingredient2Recipe IngredientsWeighted/);
     teardown_dbs(qw( global ));
 }
diff --git a/t/34-both.t b/t/34-both.t
@@ -187,7 +187,6 @@ is $replaced->title, 'Cup Cake';
 require './t/txn-common.pl';
 
 END {
-    Recipe->driver->rw_handle->disconnect;
-    $_->rw_handle->disconnect for @{ Ingredient->driver->get_driver->(undef, {multi_partition => 1})->partitions };
+    disconnect_all(qw( Recipe Ingredient ));
     teardown_dbs(qw( global cluster1 cluster2 ));
 }
diff --git a/t/35-multiplexed.t b/t/35-multiplexed.t
@@ -139,7 +139,5 @@ sub _check_object {
     is $obj2->recipe_id, $obj->recipe_id;
 }
 
-for my $driver (@{ Ingredient2Recipe->driver->drivers }) {
-    $driver->dbh->disconnect;
-}
+disconnect_all(qw( Ingredient2Recipe ));
 teardown_dbs(qw( global1 global2 ));
diff --git a/t/41-callbacks.t b/t/41-callbacks.t
@@ -118,7 +118,7 @@ sub clear_triggers {
 
 
 END {
-    Wine->driver->rw_handle->disconnect;
+    disconnect_all(qw( Wine ));
     teardown_dbs(qw( global ));
 }
 
diff --git a/t/42-callbacks-multi-pk.t b/t/42-callbacks-multi-pk.t
@@ -77,8 +77,7 @@ use Ingredient;
 };
 
 END {
-    Recipe->driver->rw_handle->disconnect;
-    $_->rw_handle->disconnect for @{ Ingredient->driver->get_driver->(undef, {multi_partition => 1})->partitions };
+    disconnect_all(qw( Recipe Ingredient ));
     teardown_dbs(qw( global cluster1 cluster2 ));
 }
 
diff --git a/t/50-profiling.t b/t/50-profiling.t
@@ -123,7 +123,6 @@ SKIP: {
 };
 
 END {
-    Recipe->driver->rw_handle->disconnect;
-    $_->rw_handle->disconnect for @{ Ingredient->driver->get_driver->(undef, {multi_partition => 1})->partitions };
+    disconnect_all(qw( Recipe Ingredient ));
     teardown_dbs(qw( global cluster1 cluster2 ));
 }
diff --git a/t/lib/DodTestUtil.pm b/t/lib/DodTestUtil.pm
@@ -5,7 +5,7 @@ use Exporter qw/import/;
 use File::Spec;
 use Test::More;
 
-our @EXPORT = qw/setup_dbs teardown_dbs/;
+our @EXPORT = qw/setup_dbs teardown_dbs disconnect_all/;
 
 my %Requires = (
     SQLite     => 'DBD::SQLite',
@@ -16,12 +16,23 @@ my %Requires = (
 );
 
 my %TestDB;
+my $Driver;
 
-sub driver { $ENV{DOD_TEST_DRIVER} || 'SQLite' }
+sub driver { $Driver ||= _driver() }
+
+sub _driver {
+    my $driver = $ENV{DOD_TEST_DRIVER} || 'SQLite';
+    return $driver if exists $Requires{$driver};
+    return 'PostgreSQL' if lc $driver eq 'pg';
+    for my $key (keys %Requires) {
+        return $key if lc $key eq lc $driver;
+    }
+    plan skip_all => "Unknown driver: $driver";
+}
 
 sub check_driver {
     my $driver = driver();
-    my $module = $Requires{$driver} or plan skip_all => "Uknonwn driver: $driver";
+    my $module = $Requires{$driver};
     unless ( eval "require $module; 1" ) {
         plan skip_all => "Test requires $module";
     }
@@ -96,6 +107,34 @@ sub teardown_dbs {
     }
 }
 
+sub disconnect_all {
+    my @tables = @_;
+    return unless driver() eq 'SQLite';
+    for my $table (@tables) {
+        my $driver = $table->driver;
+        if ($driver->can('fallback')) {
+            $driver = $driver->fallback;
+        }
+        if ($driver->can('dbh')) {
+            my $dbh = $driver->dbh or next;
+            $dbh->disconnect;
+        }
+        elsif ($driver->can('drivers')) {
+            for my $d (@{ $driver->drivers }) {
+                my $dbh = $d->dbh or next;
+                $dbh->disconnect;
+            }
+        }
+        else {
+            my @drivers = @{ $driver->get_driver->(undef, {multi_partition => 1})->partitions };
+            for my $d (@drivers) {
+                my $dbh = $d->dbh or next;
+                $dbh->disconnect;
+            }
+        }
+    }
+}
+
 sub create_sql {
     my($table) = @_;
     my $driver = driver();

Original file line number	Diff line number	Diff line change
`@@ -36,6 +36,6 @@ ok ($wine->has_column("id")) ;`
`36`	`36`	`ok ($wine->has_column("rating")) ;`
`37`	`37`
`38`	`38`	`END {`
`39`		`- Wine->driver->dbh->disconnect;`
	`39`	`+ disconnect_all(qw( Wine ));`
`40`	`40`	`teardown_dbs(qw( global ));`
`41`	`41`	`}`
Original file line number	Diff line number	Diff line change
`@@ -281,9 +281,7 @@ setup_dbs({`
`281`	`281`	`}`
`282`	`282`
`283`	`283`	`END {`
`284`		`- for (qw/Wine Recipe/) {`
`285`		`- $_->driver->rw_handle->disconnect;`
`286`		`- }`
	`284`	`+ disconnect_all(qw/Wine Recipe/);`
`287`	`285`	`teardown_dbs(qw( global ));`
`288`	`286`	`}`
`289`	`287`
Original file line number	Diff line number	Diff line change
`@@ -106,9 +106,7 @@ SKIP: {`
`106`	`106`	`}`
`107`	`107`
`108`	`108`	`END {`
`109`		`- for (qw/Wine Recipe Ingredient PkLess/) {`
`110`		`- $_->driver->rw_handle->disconnect;`
`111`		`- }`
	`109`	`+ disconnect_all(qw/Wine Recipe Ingredient PkLess/);`
`112`	`110`	`teardown_dbs(qw( global ));`
`113`	`111`	`}`
`114`	`112`
Original file line number	Diff line number	Diff line change
`@@ -88,9 +88,7 @@ test_basic_cloning('clone_all');`
`88`	`88`	`}`
`89`	`89`
`90`	`90`	`END {`
`91`		`- for (qw/Wine Recipe Ingredient/) {`
`92`		`- $_->driver->rw_handle->disconnect;`
`93`		`- }`
	`91`	`+ disconnect_all(qw/Wine Recipe Ingredient/);`
`94`	`92`	`teardown_dbs(qw( global ));`
`95`	`93`	`}`
`96`	`94`
Original file line number	Diff line number	Diff line change
`@@ -93,8 +93,6 @@ is $is->[1]->name, 'Milk';`
`93`	`93`	`ok $is->[1]->{__cached};`
`94`	`94`
`95`	`95`	`END {`
`96`		`- for (qw/Recipe Ingredient/) {`
`97`		`- $_->driver->rw_handle->disconnect;`
`98`		`- }`
	`96`	`+ disconnect_all(qw( Recipe Ingredient ));`
`99`	`97`	`teardown_dbs(qw( global ));`
`100`	`98`	`}`
Original file line number	Diff line number	Diff line change
`@@ -30,6 +30,6 @@ is(ErrorTest->driver->last_error,`
`30`	`30`	`'Failed because of a unique constraint');`
`31`	`31`
`32`	`32`	`END {`
`33`		`- ErrorTest->driver->rw_handle->disconnect;`
	`33`	`+ disconnect_all(qw( ErrorTest ));`
`34`	`34`	`teardown_dbs(qw( global ));`
`35`	`35`	`}`
Original file line number	Diff line number	Diff line change
`@@ -66,8 +66,6 @@ $i3->save;`
`66`	`66`	`is $ingredient->{__cache_recipe}, undef, "cache has effectively been destroyed";`
`67`	`67`
`68`	`68`	`END {`
`69`		`- for (qw/Recipe Ingredient/) {`
`70`		`- $_->driver->rw_handle->disconnect;`
`71`		`- }`
	`69`	`+ disconnect_all(qw/Recipe Ingredient/);`
`72`	`70`	`teardown_dbs(qw( global ));`
`73`	`71`	`}`
Original file line number	Diff line number	Diff line change
`@@ -65,8 +65,6 @@ my $r = $ingredient->recipe;`
`65`	`65`	`is $r->recipe_id, $recipe->recipe_id, "recipe id back using 'parent_method'";`
`66`	`66`
`67`	`67`	`END {`
`68`		`- for (qw/Recipe Ingredient/) {`
`69`		`- $_->driver->rw_handle->disconnect;`
`70`		`- }`
	`68`	`+ disconnect_all(qw/Recipe Ingredient/);`
`71`	`69`	`teardown_dbs(qw( global ));`
`72`	`70`	`}`