#!/usr/bin/env perl # Try __ use warnings; use strict; use lib 'lib', '../lib'; use Test::More tests => 69; use Log::Report; # no domains, no translator use Scalar::Util qw/reftype/; ### examples from Log::Report::Message and more # Check overloading sub ol_is($$;$) { # since Test::More 0.95_01, is() does not stringify its arguments. # This means that overloading does not quick in. How to test # overloading now? my ($f, $s, $comment) = @_; overload::Overloaded($f) || overload::Overloaded($s) or die "both not overloaded, in '$f' and '$s'"; is("$f", "$s", $comment); } my $a = __"Hello"; ok(defined $a); is(ref $a, 'Log::Report::Message'); is(reftype $a, 'HASH'); ol_is(__"Hello World", 'Hello World'); ol_is(__"Hello World {a}", 'Hello World {a}'); ol_is(__('Hello World {a}'), 'Hello World {a}'); my $c = __x"Hello"; ok(defined $c); is(ref $c, 'Log::Report::Message'); is(reftype $c, 'HASH'); ol_is(__x("Hello World", a => 42), 'Hello World'); ol_is(__x("Hello World {a}", a => 42), 'Hello World 42'); ol_is((__x"Hello World {a}", a => 42), 'Hello World 42'); ol_is((__x "Hello World {a}", a => 42), 'Hello World 42'); ol_is((__x "{a}{a}{a}", a => 42), '424242'); my $d = __n"Hello","World",3; ok(defined $d); is(ref $d, 'Log::Report::Message'); is(reftype $d, 'HASH'); ol_is(__n("Hello", "World", 1), 'Hello'); ol_is(__n("Hello", "World", 0), 'World'); ol_is(__n("Hello", "World", 2), 'World'); my $e = __nx"Hello","World",3,a=>42; ok(defined $e); is(ref $e, 'Log::Report::Message'); is(reftype $e, 'HASH'); ol_is(__nx("Hel{a}lo", "Wor{a}ld", 1,a=>42), 'Hel42lo'); ol_is(__nx("Hel{a}lo", "Wor{a}ld", 0,a=>42), 'Wor42ld'); ol_is(__nx("Hel{a}lo", "Wor{a}ld", 2,a=>42), 'Wor42ld'); ol_is(__xn("Hel{a}lo", "Wor{a}ld", 2,a=>42), 'Wor42ld'); my $e1 = 1; ol_is((__nx "one", "more", $e1++), "one"); ol_is((__nx "one", "more", $e1), "more"); my @files = 'monkey'; my $nr_files = @files; ol_is((__nx "one file", "{_count} files", $nr_files), 'one file'); ol_is((__nx "one file", "{_count} files", @files), 'one file'); push @files, 'donkey'; $nr_files = @files; ol_is((__nx "one file", "{_count} files", $nr_files), '2 files'); ol_is((__nx "one file", "{_count} files", @files), '2 files'); my $f = N__"Hi"; ok(defined $f); is(ref $f, ''); is(N__"Hi", "Hi"); is((N__"Hi"), "Hi"); is(N__("Hi"), "Hi"); my @g = N__n "Hi", "bye"; cmp_ok(scalar @g, '==', 2); is($g[0], 'Hi'); is($g[1], 'bye'); # # Use _count directly # ol_is(__nx("single {_count}", "multi {_count}", 0), 'multi 0'); ol_is(__nx("single {_count}", "multi {_count}", 1), 'single 1'); ol_is(__nx("single {_count}", "multi {_count}", 2), 'multi 2'); # # Expand arrays # { local $" = ', '; my @one = 'rabbit'; ol_is((__x "files: {f}", f => \@files), "files: monkey, donkey", 'check join on $"'); ol_is((__xn "one file: {f}", "{_count} files: {f}", @files, f => \@files), "2 files: monkey, donkey"); ol_is((__x "files: {f}", f => \@one), "files: rabbit"); ol_is((__xn "one file: {f}", "{_count} files: {f}", @one, f => \@one), "one file: rabbit"); } { local $" = '#'; ol_is((__x "files: {f}", f => \@files), "files: monkey#donkey"); ol_is((__x "files: {f}", f => \@files, _join => ', ') , "files: monkey, donkey", 'check _join'); } # # clone # my $s2 = __x "found {nr} files", nr => 5; my $t2 = $s2->(nr => 3); isa_ok($t2, 'Log::Report::Message'); ol_is($s2, 'found 5 files'); ol_is($t2, 'found 3 files'); # clone by overload my $s = __x "A={a};B={b}", a=>11, b=>12; isa_ok($s, 'Log::Report::Message'); is(reftype $s, 'HASH'); is($s->toString, "A=11;B=12"); my $t = $s->(b=>13); isa_ok($t, 'Log::Report::Message'); is(reftype $t, 'HASH'); isnt("$s", "$t"); is($t->toString, "A=11;B=13"); is($s->toString, "A=11;B=12"); # unchanged # # format # use constant PI => 4 * atan2(1, 1); my $approx = 'approx pi: 3.141593'; is((sprintf "approx pi: %.6f", PI), $approx); ol_is((__x "approx pi: {approx}", approx => sprintf("%.6f", PI)), $approx); ol_is((__x "approx pi: {pi%.6f}", pi => PI), $approx); ol_is((__x "{perms} {links%2d} {user%-8s} {size%8d} {fn}" , perms => '-rw-r--r--', links => 1, user => 'superman' , size => '1234567', fn => '/etc/profile') , '-rw-r--r-- 1 superman 1234567 /etc/profile'); # # trailing newline # my $msg1 = __x"who am i\n \n "; is($msg1->msgid, 'who am i', 'ignore white-space at the end'); is($msg1->append, "\n \n "); my $msg2 = __x"\n \t who am i"; is($msg2->msgid, 'who am i', 'ignore white-space before '); is($msg2->prepend, "\n \t ");