Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package perl-Carp-Assert-More for
openSUSE:Factory checked in at 2023-02-16 16:56:00
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Carp-Assert-More (Old)
and /work/SRC/openSUSE:Factory/.perl-Carp-Assert-More.new.22824 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Carp-Assert-More"
Thu Feb 16 16:56:00 2023 rev:14 rq:1066004 version:2.2.0
Changes:
--------
---
/work/SRC/openSUSE:Factory/perl-Carp-Assert-More/perl-Carp-Assert-More.changes
2022-08-24 15:11:56.288549388 +0200
+++
/work/SRC/openSUSE:Factory/.perl-Carp-Assert-More.new.22824/perl-Carp-Assert-More.changes
2023-02-16 16:56:12.766787174 +0100
@@ -1,0 +2,18 @@
+Tue Jan 31 03:06:13 UTC 2023 - Tina Müller <[email protected]>
+
+- updated to 2.2.0
+ see /usr/share/doc/packages/perl-Carp-Assert-More/Changes
+
+ 2.2.0 Sun Jan 29 20:23:59 CST 2023
+ [ENHANCEMENTS]
+ Added assert_cmp( $x, $op, $y [, $msg] ), analogous to cmp_ok in
Test::More, so you can do
+ assert_cmp( $n, '>', 10 );
+ which will give better diagnostics than just
+ assert( $n > 10 );
+ Operators supported are: lt le gt ge == != > >= < <=
+
+ assert_all_keys_in() now lists all key failures in the message, not
just the first one.
+
+ assert_keys_are() now lists all key failures in the message, not
just the first one.
+
+-------------------------------------------------------------------
Old:
----
Carp-Assert-More-2.1.0.tar.gz
New:
----
Carp-Assert-More-2.2.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Carp-Assert-More.spec ++++++
--- /var/tmp/diff_new_pack.s7J6hk/_old 2023-02-16 16:56:13.286789252 +0100
+++ /var/tmp/diff_new_pack.s7J6hk/_new 2023-02-16 16:56:13.294789284 +0100
@@ -1,7 +1,7 @@
#
# spec file for package perl-Carp-Assert-More
#
-# Copyright (c) 2022 SUSE LLC
+# Copyright (c) 2023 SUSE LLC
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -18,7 +18,7 @@
%define cpan_name Carp-Assert-More
Name: perl-Carp-Assert-More
-Version: 2.1.0
+Version: 2.2.0
Release: 0
License: Artistic-2.0
Summary: Convenience assertions for common situations
++++++ Carp-Assert-More-2.1.0.tar.gz -> Carp-Assert-More-2.2.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Carp-Assert-More-2.1.0/Changes
new/Carp-Assert-More-2.2.0/Changes
--- old/Carp-Assert-More-2.1.0/Changes 2022-08-16 02:54:26.000000000 +0200
+++ new/Carp-Assert-More-2.2.0/Changes 2023-01-30 03:24:08.000000000 +0100
@@ -1,6 +1,19 @@
Revision history for Perl extension Carp::Assert::More.
+2.2.0 Sun Jan 29 20:23:59 CST 2023
+ [ENHANCEMENTS]
+ Added assert_cmp( $x, $op, $y [, $msg] ), analogous to cmp_ok in
Test::More, so you can do
+ assert_cmp( $n, '>', 10 );
+ which will give better diagnostics than just
+ assert( $n > 10 );
+ Operators supported are: lt le gt ge == != > >= < <=
+
+ assert_all_keys_in() now lists all key failures in the message, not
just the first one.
+
+ assert_keys_are() now lists all key failures in the message, not just
the first one.
+
+
2.1.0 Mon Aug 15 19:54:27 CDT 2022
[ENHANCEMENTS]
Add diagnostic strings to the failures. For example:
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Carp-Assert-More-2.1.0/MANIFEST
new/Carp-Assert-More-2.2.0/MANIFEST
--- old/Carp-Assert-More-2.1.0/MANIFEST 2022-08-16 02:55:47.000000000 +0200
+++ new/Carp-Assert-More-2.2.0/MANIFEST 2023-01-30 03:25:34.000000000 +0100
@@ -10,6 +10,7 @@
t/assert_aoh.t
t/assert_arrayref.t
t/assert_arrayref_nonempty.t
+t/assert_cmp.t
t/assert_coderef.t
t/assert_context_nonvoid.t
t/assert_context_scalar.t
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Carp-Assert-More-2.1.0/META.json
new/Carp-Assert-More-2.2.0/META.json
--- old/Carp-Assert-More-2.1.0/META.json 2022-08-16 02:55:47.000000000
+0200
+++ new/Carp-Assert-More-2.2.0/META.json 2023-01-30 03:25:34.000000000
+0100
@@ -10,7 +10,7 @@
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec";,
- "version" : "2"
+ "version" : 2
},
"name" : "Carp-Assert-More",
"no_index" : {
@@ -48,6 +48,6 @@
"https://opensource.org/licenses/artistic-license-2.0.php";
]
},
- "version" : "v2.1.0",
- "x_serialization_backend" : "JSON::PP version 2.27400"
+ "version" : "v2.2.0",
+ "x_serialization_backend" : "JSON::PP version 4.07"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Carp-Assert-More-2.1.0/META.yml
new/Carp-Assert-More-2.2.0/META.yml
--- old/Carp-Assert-More-2.1.0/META.yml 2022-08-16 02:55:47.000000000 +0200
+++ new/Carp-Assert-More-2.2.0/META.yml 2023-01-30 03:25:33.000000000 +0100
@@ -25,5 +25,5 @@
resources:
bugtracker: https://github.com/petdance/carp-assert-more/issues
license: https://opensource.org/licenses/artistic-license-2.0.php
-version: v2.1.0
-x_serialization_backend: 'CPAN::Meta::YAML version 0.012'
+version: v2.2.0
+x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Carp-Assert-More-2.1.0/Makefile.PL
new/Carp-Assert-More-2.2.0/Makefile.PL
--- old/Carp-Assert-More-2.1.0/Makefile.PL 2021-08-13 18:43:34.000000000
+0200
+++ new/Carp-Assert-More-2.2.0/Makefile.PL 2023-01-30 03:23:03.000000000
+0100
@@ -1,6 +1,6 @@
package main;
-use 5.10.0;
+use 5.10.1;
use strict;
use warnings;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Carp-Assert-More-2.1.0/More.pm
new/Carp-Assert-More-2.2.0/More.pm
--- old/Carp-Assert-More-2.1.0/More.pm 2022-08-16 02:49:00.000000000 +0200
+++ new/Carp-Assert-More-2.2.0/More.pm 2023-01-30 03:24:29.000000000 +0100
@@ -1,10 +1,11 @@
package Carp::Assert::More;
-use warnings;
+use 5.010;
use strict;
+use warnings;
use Exporter;
-use Scalar::Util;
+use Scalar::Util qw( looks_like_number );;
use vars qw( $VERSION @ISA @EXPORT );
@@ -14,18 +15,19 @@
=head1 VERSION
-Version 2.1.0
+Version 2.2.0
=cut
BEGIN {
- $VERSION = '2.1.0';
+ $VERSION = '2.2.0';
@ISA = qw(Exporter);
@EXPORT = qw(
assert_all_keys_in
assert_aoh
assert_arrayref
assert_arrayref_nonempty
+ assert_cmp
assert_coderef
assert_context_nonvoid
assert_context_scalar
@@ -140,6 +142,105 @@
}
+=head2 assert_cmp( $x, $op, $y [,$name] )
+
+Asserts that the relation C<$x $op $y> is true. For example:
+
+ assert_cmp( $divisor, '!=', 0, 'Divisor must not be zero' );
+
+is the same as:
+
+ assert( $divisor != 0, 'Divisor must not be zero' );
+
+but with better error reporting.
+
+The following operators are supported:
+
+=over 4
+
+=item * == numeric equal
+
+=item * != numeric not equal
+
+=item * > numeric greater than
+
+=item * >= numeric greater than or equal
+
+=item * < numeric less than
+
+=item * <= numeric less than or equal
+
+=item * lt string less than
+
+=item * le string less than or equal
+
+=item * gt string less than
+
+=item * ge string less than or equal
+
+=back
+
+There is no support for C<eq> or C<ne> because those already have
+C<assert_is> and C<assert_isnt>, respectively.
+
+If either C<$x> or C<$y> is undef, the assertion will fail.
+
+If the operator is numeric, and C<$x> or C<$y> are not numbers, the assertion
will fail.
+
+=cut
+
+sub assert_cmp($$$;$) {
+ my $x = shift;
+ my $op = shift;
+ my $y = shift;
+ my $name = shift;
+
+ my $why;
+
+ if ( !defined($op) ) {
+ $why = 'Invalid operator <undef>';
+ }
+ elsif ( $op eq '==' ) {
+ return if looks_like_number($x) && looks_like_number($y) && ($x == $y);
+ }
+ elsif ( $op eq '!=' ) {
+ return if looks_like_number($x) && looks_like_number($y) && ($x != $y);
+ }
+ elsif ( $op eq '<' ) {
+ return if looks_like_number($x) && looks_like_number($y) && ($x < $y);
+ }
+ elsif ( $op eq '<=' ) {
+ return if looks_like_number($x) && looks_like_number($y) && ($x <= $y);
+ }
+ elsif ( $op eq '>' ) {
+ return if looks_like_number($x) && looks_like_number($y) && ($x > $y);
+ }
+ elsif ( $op eq '>=' ) {
+ return if looks_like_number($x) && looks_like_number($y) && ($x >= $y);
+ }
+ elsif ( $op eq 'lt' ) {
+ return if defined($x) && defined($y) && ($x lt $y);
+ }
+ elsif ( $op eq 'le' ) {
+ return if defined($x) && defined($y) && ($x le $y);
+ }
+ elsif ( $op eq 'gt' ) {
+ return if defined($x) && defined($y) && ($x gt $y);
+ }
+ elsif ( $op eq 'ge' ) {
+ return if defined($x) && defined($y) && ($x ge $y);
+ }
+ else {
+ $why = qq{Invalid operator "$op"};
+ }
+
+ $why //= "Failed: " . ($x // 'undef') . ' ' . $op . ' ' . ($y // 'undef');
+
+ require Carp;
+ &Carp::confess( _failure_msg($name, $why) );
+}
+
+
=head2 assert_like( $string, qr/regex/ [,$name] )
Asserts that I<$string> matches I<qr/regex/>.
@@ -995,7 +1096,7 @@
my $keys = shift;
my $name = shift;
- my $why;
+ my @why;
my $ok = 0;
if ( ref($hash) eq 'HASH' || (Scalar::Util::blessed( $hash ) &&
$hash->isa( 'HASH' )) ) {
if ( ref($keys) eq 'ARRAY' ) {
@@ -1004,23 +1105,22 @@
for my $key ( keys %{$hash} ) {
if ( !exists $keys{$key} ) {
$ok = 0;
- $why = qq{Key "$key" is not a valid key.};
- last;
+ push @why, qq{Key "$key" is not a valid key.};
}
}
}
else {
- $why = 'Argument for array of keys is not an arrayref.';
+ push @why, 'Argument for array of keys is not an arrayref.';
}
}
else {
- $why = 'Argument for hash is not a hashref.';
+ push @why, 'Argument for hash is not a hashref.';
}
return if $ok;
require Carp;
- &Carp::confess( _failure_msg($name, $why) );
+ &Carp::confess( _failure_msg($name, @why) );
}
@@ -1035,7 +1135,7 @@
my $keys = shift;
my $name = shift;
- my $why;
+ my @why;
my $ok = 0;
if ( ref($hash) eq 'HASH' || (Scalar::Util::blessed( $hash ) &&
$hash->isa( 'HASH' )) ) {
if ( ref($keys) eq 'ARRAY' ) {
@@ -1046,8 +1146,7 @@
for my $key ( keys %{$hash} ) {
if ( !exists $keys{$key} ) {
$ok = 0;
- $why = qq{Key "$key" is not a valid key.};
- last;
+ push @why, qq{Key "$key" is not a valid key.};
}
}
@@ -1055,23 +1154,22 @@
for my $key ( @{$keys} ) {
if ( !exists $hash->{$key} ) {
$ok = 0;
- $why = qq{Key "$key" is not in the hash.};
- last;
+ push @why, qq{Key "$key" is not in the hash.};
}
}
}
else {
- $why = 'Argument for array of keys is not an arrayref.';
+ push @why, 'Argument for array of keys is not an arrayref.';
}
}
else {
- $why = 'Argument for hash is not a hashref.';
+ push @why, 'Argument for hash is not a hashref.';
}
return if $ok;
require Carp;
- &Carp::confess( _failure_msg($name, $why) );
+ &Carp::confess( _failure_msg($name, @why) );
}
@@ -1173,13 +1271,12 @@
# Can't call confess() here or the stack trace will be wrong.
sub _failure_msg {
- my $name = shift;
- my $why = shift;
+ my ($name, @why) = @_;
my $msg = 'Assertion';
$msg .= " ($name)" if defined $name;
$msg .= " failed!\n";
- $msg .= "$why\n" if defined($why);
+ $msg .= "$_\n" for @why;
return $msg;
}
@@ -1187,7 +1284,7 @@
=head1 COPYRIGHT & LICENSE
-Copyright 2005-2022 Andy Lester.
+Copyright 2005-2023 Andy Lester
This program is free software; you can redistribute it and/or modify
it under the terms of the Artistic License version 2.0.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Carp-Assert-More-2.1.0/t/assert_all_keys_in.t
new/Carp-Assert-More-2.2.0/t/assert_all_keys_in.t
--- old/Carp-Assert-More-2.1.0/t/assert_all_keys_in.t 2022-08-16
02:48:30.000000000 +0200
+++ new/Carp-Assert-More-2.2.0/t/assert_all_keys_in.t 2023-01-30
03:23:03.000000000 +0100
@@ -3,57 +3,76 @@
use warnings;
use strict;
-use Test::More tests => 7;
+use Test::More tests => 9;
use Carp::Assert::More;
use Test::Exception;
-my $monolith = {
- depth => 1,
- width => 4,
- height => 9,
-};
-my $shaq = {
- firstname => 'Shaquille',
- lastname => 'O\'Neal',
- height => 85,
-};
-
-my @object_keys = qw( height width depth );
-my @person_keys = qw( firstname lastname height );
-
-lives_ok( sub { assert_all_keys_in( $monolith, \@object_keys ) }, 'Monolith
object has valid keys' );
-lives_ok( sub { assert_all_keys_in( $shaq, \@person_keys ) }, 'Shaq object
has valid keys' );
-
-throws_ok(
- sub { assert_all_keys_in( $monolith, \@person_keys ) },
- qr/Assertion.*failed!.+Key "(depth|width)" is not a valid key\./sm,
- 'Monolith fails on person keys'
-);
-
-
-throws_ok(
- sub { assert_all_keys_in( $monolith, [] ) },
- qr/Assertion.*failed!.+Key "(depth|width|height)" is not a valid key\./sm,
- 'Monolith fails on empty list of keys'
-);
-
-
-throws_ok(
- sub { assert_all_keys_in( $monolith, {} ) },
- qr/Assertion.*failed!.+Argument for array of keys is not an arrayref\./sm,
- 'Fails on a non-array list of keys'
-);
-
-
-throws_ok(
- sub { assert_all_keys_in( [], \@object_keys ) },
- qr/Assertion.*failed!.+Argument for hash is not a hashref\./sm,
- 'Fails on a non-hashref hash'
-);
+my $af = qr/Assertion failed!\n/;
+MAIN: {
+ my $monolith = {
+ depth => 1,
+ width => 4,
+ height => 9,
+ };
+ my $shaq = {
+ firstname => 'Shaquille',
+ lastname => 'O\'Neal',
+ height => 85,
+ };
+
+ my @object_keys = keys %{$monolith};
+ my @person_keys = keys %{$shaq};
+
+ lives_ok( sub { assert_all_keys_in( $monolith, \@object_keys ) },
'Monolith object has valid keys' );
+ lives_ok( sub { assert_all_keys_in( $shaq, \@person_keys ) }, 'Shaq
object has valid keys' );
+
+ throws_ok(
+ sub { assert_all_keys_in( $monolith, \@person_keys ) },
+ qr/${af}Key "(depth|width)" is not a valid key\./sm,
+ 'Monolith fails on person keys'
+ );
+
+
+ throws_ok(
+ sub { assert_all_keys_in( $monolith, [] ) },
+ qr/${af}Key "(depth|width|height)" is not a valid key\./sm,
+ 'Monolith fails on empty list of keys'
+ );
+
+
+ throws_ok(
+ sub { assert_all_keys_in( $monolith, {} ) },
+ qr/${af}Argument for array of keys is not an arrayref\./sm,
+ 'Fails on a non-array list of keys'
+ );
+
+
+ throws_ok(
+ sub { assert_all_keys_in( [], \@object_keys ) },
+ qr/${af}Argument for hash is not a hashref\./sm,
+ 'Fails on a non-hashref hash'
+ );
+
+
+ lives_ok( sub { assert_all_keys_in( {}, [] ) }, 'Empty hash and empty
keys' );
+
+
+ # Check that all keys get reported.
+ my @expected = (
+ qr/Key "depth" is not a valid key/,
+ qr/Key "width" is not a valid key/,
+ );
+ for my $expected ( @expected ) {
+ throws_ok(
+ sub { assert_all_keys_in( $monolith, \@person_keys ) },
+ qr/${af}.*$expected/sm,
+ "Message found: $expected"
+ );
+ }
+}
-lives_ok( sub { assert_all_keys_in( {}, [] ) }, 'Empty hash and empty keys' );
exit 0;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Carp-Assert-More-2.1.0/t/assert_cmp.t
new/Carp-Assert-More-2.2.0/t/assert_cmp.t
--- old/Carp-Assert-More-2.1.0/t/assert_cmp.t 1970-01-01 01:00:00.000000000
+0100
+++ new/Carp-Assert-More-2.2.0/t/assert_cmp.t 2023-01-30 03:23:03.000000000
+0100
@@ -0,0 +1,161 @@
+#!perl -Tw
+
+use warnings;
+use strict;
+
+use Test::More tests => 113;
+
+use Test::Exception;
+
+use Carp::Assert::More;
+
+my $af = qr/Assertion failed!\n/;
+my $failed = qr/${af}Failed:/;
+
+
+NUMERIC_EQ: {
+ lives_ok( sub { assert_cmp( 1, '==', 1 ) }, 'num == num' );
+ lives_ok( sub { assert_cmp( 2, '==', '2' ) }, 'num == str' );
+ lives_ok( sub { assert_cmp( '3', '==', 3 ) }, 'str == num' );
+ lives_ok( sub { assert_cmp( '4', '==', '4' ) }, 'str == str' );
+ lives_ok( sub { assert_cmp( 5, '==', 5.0 ) }, 'int == float' );
+
+ throws_ok( sub { assert_cmp( -1, '==', 1 ) }, qr/$failed -1 == 1/,
'num == num' );
+ throws_ok( sub { assert_cmp( -2, '==', '2' ) }, qr/$failed -2 == 2/,
'num == str' );
+ throws_ok( sub { assert_cmp( '-3', '==', 3 ) }, qr/$failed -3 == 3/,
'str == num' );
+ throws_ok( sub { assert_cmp( '-4', '==', '4' ) }, qr/$failed -4 == 4/,
'str == str' );
+ throws_ok( sub { assert_cmp( -5, '==', 5.0 ) }, qr/$failed -5 == 5/,
'int == float' );
+}
+
+
+NUMERIC_NE: {
+ lives_ok( sub { assert_cmp( -1, '!=', 1 ) }, 'num != num' );
+ lives_ok( sub { assert_cmp( -2, '!=', '2' ) }, 'num != str' );
+ lives_ok( sub { assert_cmp( '-3', '!=', 3 ) }, 'str != num' );
+ lives_ok( sub { assert_cmp( '-4', '!=', '4' ) }, 'str != str' );
+ lives_ok( sub { assert_cmp( -5, '!=', 5.0 ) }, 'int != float' );
+
+ throws_ok( sub { assert_cmp( 1, '!=', 1 ) }, qr/$failed 1 != 1/, 'num
!= num' );
+ throws_ok( sub { assert_cmp( 2, '!=', '2' ) }, qr/$failed 2 != 2/, 'num
!= str' );
+ throws_ok( sub { assert_cmp( '3', '!=', 3 ) }, qr/$failed 3 != 3/, 'str
!= num' );
+ throws_ok( sub { assert_cmp( '4', '!=', '4' ) }, qr/$failed 4 != 4/, 'str
!= str' );
+ throws_ok( sub { assert_cmp( 5, '!=', 5.0 ) }, qr/$failed 5 != 5/, 'int
!= float' );
+}
+
+
+NUMERIC_LT: {
+ lives_ok( sub { assert_cmp( 1, '<', 2 ) }, 'num < num' );
+ lives_ok( sub { assert_cmp( 2, '<', '3' ) }, 'num < str' );
+ lives_ok( sub { assert_cmp( '3', '<', 4 ) }, 'str < num' );
+ lives_ok( sub { assert_cmp( '4', '<', '5' ) }, 'str < str' );
+ lives_ok( sub { assert_cmp( 5, '<', 6.0 ) }, 'int < float' );
+ lives_ok( sub { assert_cmp( 6.0, '<', 7 ) }, 'float < int' );
+ lives_ok( sub { assert_cmp( 7.0, '<', 8.0 ) }, 'float < float' );
+
+ throws_ok( sub { assert_cmp( 1, '<', 1 ) }, qr/$failed 1 < 1/, 'num <
num' );
+ throws_ok( sub { assert_cmp( 2, '<', '2' ) }, qr/$failed 2 < 2/, 'num <
str' );
+ throws_ok( sub { assert_cmp( '3', '<', 3 ) }, qr/$failed 3 < 3/, 'str <
num' );
+ throws_ok( sub { assert_cmp( '4', '<', '4' ) }, qr/$failed 4 < 4/, 'str <
str' );
+ throws_ok( sub { assert_cmp( 5, '<', 5.0 ) }, qr/$failed 5 < 5/, 'int <
float' );
+ throws_ok( sub { assert_cmp( 6.0, '<', 6 ) }, qr/$failed 6 < 6/, 'float
< int' );
+ throws_ok( sub { assert_cmp( 7.0, '<', 7.0 ) }, qr/$failed 7 < 7/, 'float
< float' );
+}
+
+
+NUMERIC_LE: {
+ lives_ok( sub { assert_cmp( 1, '<=', 2 ) }, 'num <= num' );
+ lives_ok( sub { assert_cmp( 2, '<=', '3' ) }, 'num <= str' );
+ lives_ok( sub { assert_cmp( '3', '<=', 4 ) }, 'str <= num' );
+ lives_ok( sub { assert_cmp( '4', '<=', '5' ) }, 'str <= str' );
+ lives_ok( sub { assert_cmp( 5, '<=', 6.0 ) }, 'int <= float' );
+ lives_ok( sub { assert_cmp( 6.0, '<=', 7 ) }, 'float <= int' );
+ lives_ok( sub { assert_cmp( 7.0, '<=', 8.0 ) }, 'float <= float' );
+
+ throws_ok( sub { assert_cmp( 1, '<=', 0 ) }, qr/$failed 1 <= 0/, 'num
<= num' );
+ throws_ok( sub { assert_cmp( 2, '<=', '1' ) }, qr/$failed 2 <= 1/, 'num
<= str' );
+ throws_ok( sub { assert_cmp( '3', '<=', 2 ) }, qr/$failed 3 <= 2/, 'str
<= num' );
+ throws_ok( sub { assert_cmp( '4', '<=', '3' ) }, qr/$failed 4 <= 3/, 'str
<= str' );
+ throws_ok( sub { assert_cmp( 5, '<=', 4.0 ) }, qr/$failed 5 <= 4/, 'int
<= float' );
+ throws_ok( sub { assert_cmp( 6.0, '<=', 5 ) }, qr/$failed 6 <= 5/,
'float <= int' );
+ throws_ok( sub { assert_cmp( 7.0, '<=', 6.0 ) }, qr/$failed 7 <= 6/,
'float <= float' );
+}
+
+
+NUMERIC_GT: {
+ lives_ok( sub { assert_cmp( 1, '>', 0 ) }, 'num > num' );
+ lives_ok( sub { assert_cmp( 2, '>', '1' ) }, 'num > str' );
+ lives_ok( sub { assert_cmp( '3', '>', 2 ) }, 'str > num' );
+ lives_ok( sub { assert_cmp( '4', '>', '3' ) }, 'str > str' );
+ lives_ok( sub { assert_cmp( 5, '>', 4.0 ) }, 'int > float' );
+ lives_ok( sub { assert_cmp( 6.0, '>', 5 ) }, 'float > int' );
+ lives_ok( sub { assert_cmp( 7.0, '>', 6.0 ) }, 'float > float' );
+
+ throws_ok( sub { assert_cmp( 1, '>', 1 ) }, qr/$failed 1 > 1/, 'num >
num' );
+ throws_ok( sub { assert_cmp( 2, '>', '2' ) }, qr/$failed 2 > 2/, 'num >
str' );
+ throws_ok( sub { assert_cmp( '3', '>', 3 ) }, qr/$failed 3 > 3/, 'str >
num' );
+ throws_ok( sub { assert_cmp( '4', '>', '4' ) }, qr/$failed 4 > 4/, 'str >
str' );
+ throws_ok( sub { assert_cmp( 5, '>', 5.0 ) }, qr/$failed 5 > 5/, 'int >
float' );
+ throws_ok( sub { assert_cmp( 6.0, '>', 6 ) }, qr/$failed 6 > 6/, 'float
> int' );
+ throws_ok( sub { assert_cmp( 7.0, '>', 7.0 ) }, qr/$failed 7 > 7/, 'float
> float' );
+}
+
+
+
+NUMERIC_GE: {
+ lives_ok( sub { assert_cmp( 1, '>=', 1 ) }, 'num >= num' );
+ lives_ok( sub { assert_cmp( 2, '>=', '2' ) }, 'num >= str' );
+ lives_ok( sub { assert_cmp( '3', '>=', 3 ) }, 'str >= num' );
+ lives_ok( sub { assert_cmp( '4', '>=', '4' ) }, 'str >= str' );
+ lives_ok( sub { assert_cmp( 5, '>=', 5.0 ) }, 'int >= float' );
+ lives_ok( sub { assert_cmp( 6.0, '>=', 6 ) }, 'float >= int' );
+ lives_ok( sub { assert_cmp( 7.0, '>=', 7.0 ) }, 'float >= float' );
+
+ throws_ok( sub { assert_cmp( 0, '>=', 1 ) }, qr/$failed 0 >= 1/, 'num
>= num' );
+ throws_ok( sub { assert_cmp( 1, '>=', '2' ) }, qr/$failed 1 >= 2/, 'num
>= str' );
+ throws_ok( sub { assert_cmp( '2', '>=', 3 ) }, qr/$failed 2 >= 3/, 'str
>= num' );
+ throws_ok( sub { assert_cmp( '3', '>=', '4' ) }, qr/$failed 3 >= 4/, 'str
>= str' );
+ throws_ok( sub { assert_cmp( 4, '>=', 5.0 ) }, qr/$failed 4 >= 5/, 'int
>= float' );
+ throws_ok( sub { assert_cmp( 5.0, '>=', 6 ) }, qr/$failed 5 >= 6/,
'float >= int' );
+ throws_ok( sub { assert_cmp( 6.0, '>=', 7.0 ) }, qr/$failed 6 >= 7/,
'float >= float' );
+}
+
+
+BAD_NUMBERS: {
+ my @operators = qw( == != > >= < <= );
+
+ for my $op ( @operators ) {
+ throws_ok( sub { assert_cmp( 12, $op, undef ) }, qr/$failed 12 $op
undef/, "num $op undef" );
+ throws_ok( sub { assert_cmp( undef, $op, 14 ) }, qr/$failed undef
$op 14/, "undef $op num" );
+ throws_ok( sub { assert_cmp( undef, $op, undef) }, qr/$failed undef
$op undef/, "undef $op undef" );
+ }
+}
+
+
+STRINGS: {
+ lives_ok( sub { assert_cmp( 'a', 'lt', 'b' ) }, 'lt' );
+ lives_ok( sub { assert_cmp( 'a', 'le', 'a' ) }, 'le' );
+ lives_ok( sub { assert_cmp( 'b', 'gt', 'a' ) }, 'gt' );
+ lives_ok( sub { assert_cmp( 'a', 'ge', 'a' ) }, 'ge' );
+
+ throws_ok( sub { assert_cmp( 'a', 'lt', 'a' ) }, qr/$failed a lt a/ );
+ throws_ok( sub { assert_cmp( 'b', 'le', 'a' ) }, qr/$failed b le a/ );
+ throws_ok( sub { assert_cmp( 'a', 'gt', 'a' ) }, qr/$failed a gt a/ );
+ throws_ok( sub { assert_cmp( 'a', 'ge', 'b' ) }, qr/$failed a ge b/ );
+}
+
+
+
+BAD_OPERATOR: {
+ for my $op ( qw( xx eq ne lte gte LT LE GT GE ), undef ) {
+ my $dispop = $op ? qq{"$op"} : '<undef>';
+ throws_ok( sub { assert_cmp( 3, $op, 3 ) }, qr/${af}Invalid operator
$dispop/ );
+ }
+}
+
+
+BAD_VALUES: {
+ throws_ok( sub { assert_cmp( 9, '>', undef ) }, qr/$failed 9 > undef/ );
+}
+
+
+exit 0;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Carp-Assert-More-2.1.0/t/assert_keys_are.t
new/Carp-Assert-More-2.2.0/t/assert_keys_are.t
--- old/Carp-Assert-More-2.1.0/t/assert_keys_are.t 2022-08-16
02:48:30.000000000 +0200
+++ new/Carp-Assert-More-2.2.0/t/assert_keys_are.t 2023-01-30
03:23:03.000000000 +0100
@@ -3,15 +3,16 @@
use warnings;
use strict;
-use Test::More tests => 1;
+use Test::More tests => 15;
use Carp::Assert::More;
use Test::Exception;
-subtest assert_keys_are => sub {
- plan tests => 10;
+my $af = qr/Assertion failed!\n/;
+my $failed = qr/${af}Failed:/;
+BASICS: {
my $monolith = {
depth => 1,
width => 4,
@@ -32,42 +33,59 @@
throws_ok(
sub { assert_keys_are( $monolith, \@person_keys ) },
- qr/Assertion.*failed!/,
+ qr/$af/,
'Monolith fails on person keys'
);
throws_ok(
sub { assert_keys_are( $monolith, [@object_keys[0..1]] ) },
- qr/Assertion.*failed/,
+ qr/$af/,
'Hash has too many keys'
);
throws_ok(
sub { assert_keys_are( $monolith, [@object_keys, 'wavelength'] ) },
- qr/Assertion.*failed/,
+ qr/$af/,
'Hash has one key too many'
);
throws_ok(
sub { assert_keys_are( $monolith, [] ) },
- qr/Assertion.*failed.+Key "(depth|height|width)" is not a valid
key\./sm,
+ qr/${af}Key "(depth|height|width)" is not a valid key\./sm,
'Empty key list fails for non-empty object'
);
throws_ok(
sub { assert_keys_are( {}, \@object_keys ) },
- qr/Assertion.*failed.+Key "(depth|height|width)" is not in the
hash\./sm,
+ qr/${af}Key "(depth|height|width)" is not in the hash\./sm,
'Empty hash fails for non-empty key list'
);
throws_ok(
sub { assert_keys_are( $monolith, {} ) },
- qr/Assertion.*failed!.+Argument for array of keys is not an
arrayref\./sm,
+ qr/${af}Argument for array of keys is not an arrayref\./sm,
'Fails on a non-array list of keys'
);
throws_ok(
sub { assert_keys_are( [], \@object_keys ) },
- qr/Assertion.*failed!.+Argument for hash is not a hashref\./sm,
+ qr/${af}Argument for hash is not a hashref\./sm,
'Fails on a non-hashref hash'
);
-};
+
+ my @keys = qw( a b c height );
+ my @expected = (
+ qr/Key "depth" is not a valid key/,
+ qr/Key "width" is not a valid key/,
+ qr/Key "a" is not in the hash/,
+ qr/Key "b" is not in the hash/,
+ qr/Key "c" is not in the hash/,
+ );
+ for my $expected ( @expected ) {
+ throws_ok(
+ sub { assert_keys_are( $monolith, \@keys ) },
+ qr/${af}.*$expected/sm,
+ "Message found: $expected"
+ );
+ }
+}
+
exit 0;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Carp-Assert-More-2.1.0/t/test-coverage.t
new/Carp-Assert-More-2.2.0/t/test-coverage.t
--- old/Carp-Assert-More-2.1.0/t/test-coverage.t 2021-08-13
18:43:34.000000000 +0200
+++ new/Carp-Assert-More-2.2.0/t/test-coverage.t 2023-01-30
03:23:03.000000000 +0100
@@ -1,6 +1,6 @@
#!perl -Tw
-use Test::More tests => 39;
+use Test::More tests => 40;
use Carp::Assert::More;
