From 60c0a0a6225bcd02f3a0860d466df98e12ab5e7a Mon Sep 17 00:00:00 2001 From: Martin Renvoize Date: Fri, 3 Jan 2025 14:39:29 +0000 Subject: [PATCH] Bug 38818: Add diag option to t::lib::Mocks::Logger This patch adds a diag method to the Mocks::Logger object. This aids in debugging logging errors by simply outputting all log lines to screen in a diag statement. --- t/lib/Mocks/Logger.pm | 37 ++++++++++++++++++++++++++++++++----- 1 file changed, 32 insertions(+), 5 deletions(-) diff --git a/t/lib/Mocks/Logger.pm b/t/lib/Mocks/Logger.pm index 22c967a58c6..c94507e0d0a 100644 --- a/t/lib/Mocks/Logger.pm +++ b/t/lib/Mocks/Logger.pm @@ -72,7 +72,8 @@ sub new { $level, sub { my $message = $_[1]; - push @{ $self->{$level} }, $message; + my @caller_info = caller(2); + push @{ $self->{$level} }, { message => $message, caller => \@caller_info }; return $message; } ); @@ -81,6 +82,32 @@ sub new { return $self; } +=head3 diag + + $logger->diag(); + +Method to output all recieved logs. + +=cut + +sub diag { + my ($self) = @_; + my $tb = $CLASS->builder; + + foreach my $level (levels()) { + $tb->diag("$level:"); + if ( @{ $self->{$level} }) { + foreach my $log_entry ( @{ $self->{$level} } ) { + my ($package, $filename, $line) = @{$log_entry->{caller}}; + $tb->diag( " \"" . $log_entry->{message} . "\" at $filename line $line"); + } + } else { + $tb->diag(" (No $level messages)"); + } + } + return; +} + =head3 debug_is $logger->debug_is($expected); @@ -287,8 +314,8 @@ sub generic_is { local $Test::Builder::Level = $Test::Builder::Level + 1; - my $string = shift @{ $self->{$level} }; - $string //= ''; + my $log = shift @{ $self->{$level} }; + my $string = defined($log) ? $log->{message} : ''; my $tb = $CLASS->builder; return $tb->is_eq( $string, $expect, $name); } @@ -304,8 +331,8 @@ sub generic_like { local $Test::Builder::Level = $Test::Builder::Level + 1; - my $string = shift @{ $self->{$level} }; - $string //= ''; + my $log = shift @{ $self->{$level} }; + my $string = defined($log) ? $log->{message} : ''; my $tb = $CLASS->builder; return $tb->like( $string, $expect, $name); } -- 2.47.1