From b9dffc169ddb7a3a32a071c4a004420814fa3a3f Mon Sep 17 00:00:00 2001
From: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
Date: Mon, 14 May 2018 14:04:01 -0300
Subject: [PATCH] Bug 20767: Display a stack trace when a method is not covered
 by tests

When a method is not allowed yet (not covered by tests), developers get
an error the is not really useful: "The method XXX is not covered by
tests!"
It would be more useful to have a stack trace in order to know where
this error come from.

Test plan:
Modify some code to display this stack trace and confirm it makes sense
to have it, i.e. it will make debug easier

Signed-off-by: Mark Tompsett <mtompset@hotmail.com>

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>

Signed-off-by: Nick Clemens <nick@bywatersolutions.com>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>
---
 Koha/Object.pm                |  6 +++++-
 Koha/Objects.pm               | 10 +++++++++-
 t/db_dependent/Koha/Objects.t | 27 +++++++++++++++++++++------
 3 files changed, 35 insertions(+), 8 deletions(-)

diff --git a/Koha/Object.pm b/Koha/Object.pm
index 1f54273493..b9208f07ac 100644
--- a/Koha/Object.pm
+++ b/Koha/Object.pm
@@ -392,7 +392,11 @@ sub AUTOLOAD {
 
     my @known_methods = qw( is_changed id in_storage get_column discard_changes update related_resultset make_column_dirty );
 
-    Koha::Exceptions::Object::MethodNotCoveredByTests->throw( "The method $method is not covered by tests!" ) unless grep {/^$method$/} @known_methods;
+    Koha::Exceptions::Object::MethodNotCoveredByTests->throw(
+        error      => sprintf("The method %s->%s is not covered by tests!", ref($self), $method),
+        show_trace => 1
+    ) unless grep { /^$method$/ } @known_methods;
+
 
     my $r = eval { $self->_result->$method(@_) };
     if ( $@ ) {
diff --git a/Koha/Objects.pm b/Koha/Objects.pm
index 8c79afda1a..da43003c88 100644
--- a/Koha/Objects.pm
+++ b/Koha/Objects.pm
@@ -383,7 +383,15 @@ sub AUTOLOAD {
     my $method = our $AUTOLOAD;
     $method =~ s/.*:://;
 
-    carp "The method $method is not covered by tests" and return unless grep {/^$method$/} @known_methods;
+
+    unless ( grep { /^$method$/ } @known_methods ) {
+        my $class = ref($self) ? ref($self) : $self;
+        Koha::Exceptions::Object::MethodNotCoveredByTests->throw(
+            error      => sprintf("The method %s->%s is not covered by tests!", $class, $method),
+            show_trace => 1
+        );
+    }
+
     my $r = eval { $self->_resultset->$method(@params) };
     if ( $@ ) {
         carp "No method $method found for " . ref($self) . " " . $@;
diff --git a/t/db_dependent/Koha/Objects.t b/t/db_dependent/Koha/Objects.t
index 9c41d9f145..bfa6f7d912 100644
--- a/t/db_dependent/Koha/Objects.t
+++ b/t/db_dependent/Koha/Objects.t
@@ -19,7 +19,7 @@
 
 use Modern::Perl;
 
-use Test::More tests => 15;
+use Test::More tests => 14;
 use Test::Exception;
 use Test::Warn;
 
@@ -95,10 +95,6 @@ subtest 'delete' => sub {
     is( Koha::Patrons->search({ -or => { borrowernumber => [ $patron_1->{borrowernumber}, $patron_2->{borrowernumber}]}})->count, 0, '');
 };
 
-subtest 'not_covered_yet' => sub {
-    plan tests => 1;
-    warning_is { Koha::Patrons->search->not_covered_yet } { carped => 'The method not_covered_yet is not covered by tests' }, "If a method is not covered by tests, the AUTOLOAD method won't execute the method";
-};
 subtest 'new' => sub {
     plan tests => 2;
     my $a_cat_code = 'A_CAT_CODE';
@@ -188,16 +184,18 @@ subtest 'get_column' => sub {
 };
 
 subtest 'Exceptions' => sub {
-    plan tests => 2;
+    plan tests => 7;
 
     my $patron_borrowernumber = $builder->build({ source => 'Borrower' })->{ borrowernumber };
     my $patron = Koha::Patrons->find( $patron_borrowernumber );
 
+    # Koha::Object
     try {
         $patron->blah('blah');
     } catch {
         ok( $_->isa('Koha::Exceptions::Object::MethodNotCoveredByTests'),
             'Calling a non-covered method should raise a Koha::Exceptions::Object::MethodNotCoveredByTests exception' );
+        is( $_->message, 'The method Koha::Patron->blah is not covered by tests!', 'The message raised should contain the package and the method' );
     };
 
     try {
@@ -206,6 +204,23 @@ subtest 'Exceptions' => sub {
         ok( $_->isa('Koha::Exceptions::Object::PropertyNotFound'),
             'Setting a non-existent property should raise a Koha::Exceptions::Object::PropertyNotFound exception' );
     };
+
+    # Koha::Objects
+    try {
+        Koha::Patrons->search->not_covered_yet;
+    } catch {
+        ok( $_->isa('Koha::Exceptions::Object::MethodNotCoveredByTests'),
+            'Calling a non-covered method should raise a Koha::Exceptions::Object::MethodNotCoveredByTests exception' );
+        is( $_->message, 'The method Koha::Patrons->not_covered_yet is not covered by tests!', 'The message raised should contain the package and the method' );
+    };
+
+    try {
+        Koha::Patrons->not_covered_yet;
+    } catch {
+        ok( $_->isa('Koha::Exceptions::Object::MethodNotCoveredByTests'),
+            'Calling a non-covered method should raise a Koha::Exceptions::Object::MethodNotCoveredByTests exception' );
+        is( $_->message, 'The method Koha::Patrons->not_covered_yet is not covered by tests!', 'The message raised should contain the package and the method' );
+    };
 };
 
 $schema->storage->txn_rollback;
-- 
2.39.5