The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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 ");