The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
use Test::More;

note( 'Regression tests for CPP.pm to assure refactoring breaks nothing.' );

require Inline::CPP;

{
    no warnings 'once';  ## no critic (warnings)
    ok(defined($Inline::CPP::Parser::RecDescent::TYPEMAP_KIND), 'TYPEMAP_KIND defined.');
}

# Test Inline::CPP::register().
subtest 'Inline::CPP::register() tests.'  => sub {
    note 'Testing Inline::CPP::register()';
    plan tests => 12;
    my @ALIASES = qw/ cpp C++ c++ Cplusplus cplusplus CXX cxx /;
    my $rv;
    eval { $rv = Inline::CPP::register(); };
    ok( ! $@, 'Call to Inline::CPP::register() succeeds.' );
    diag 'Failure was: ' . $@ if $@;
    is( $rv->{language}, 'CPP', 'Language CPP properly defined.' );
    is( scalar @{$rv->{aliases}},
        scalar @ALIASES,
        'Got proper number of aliases.' );
    foreach my $alias ( @ALIASES ) {
        ok( ( grep { $_ eq $alias } @{$rv->{aliases}} ),
            "Found alias $alias."                        );
    }
    is( $rv->{type}, 'compiled', 'Proper language type.' );
    ok( defined( $rv->{suffix} ),
        'An extension suffix is defined by $Config{dlext}.' );
    return;
};


# Test const_cast().
subtest 'Inline::CPP::const_cast() tests.' => sub {
    note 'Testing Inline::CPP::const_cast()';
    plan tests => 13;
    my @tests = (
        [ 'THIS->secr(s)', '0', '', 'THIS->secr(s)' ],
        [ 'prn()', '0', '', 'prn()' ],
        [ 'THIS->dat()', '2', 'char *','const_cast<char *>(THIS->dat())' ],
        [ 'THIS->dat(a)', '2', 'char *','const_cast<char *>(THIS->dat(a))' ],
        [ 'THIS->foo(a)', '', 'int', 'THIS->foo(a)' ],
        [ 'THIS->foo(a,b)', '', 'int', 'THIS->foo(a,b)' ],
        [ 'THIS->foo(a,b,c)', '', 'int', 'THIS->foo(a,b,c)' ],
        [ 'THIS->foo2(a,b,c)', '0', 'int', 'THIS->foo2(a,b,c)' ],
        [ 'foo(a)', '', 'int', 'foo(a)' ],
        [ 'new Fizzl(Q)', '', '', 'new Fizzl(Q)' ],
        [ 'new Fizzl(Q,Fooz)', '', '', 'new Fizzl(Q,Fooz)' ],
        [ 'delete Fizzl()', '', '', 'delete Fizzl()' ],
        [ 'THIS->test()', '3', 'int', 'THIS->test()' ],
    );
    foreach my $test ( @tests ) {
        my( $value, $const, $type, $expect ) = @{$test};
        is( Inline::CPP::const_cast( $value, $const, $type ),
            $expect,
            sprintf( "%-45s => %-32s",
                "const_cast('$value','$const','$type')", $expect
            )
        );
    }
    return;
};


# Test call_or_instantiate().
subtest 'Inline::CPP::call_or_instantiate() tests.' => sub {
    note 'Testing Inline::CPP::call_or_instantiate()';
    plan tests => 14;
    my @tests = (
        #   name     ctor dtor class    const type      args
        # output
        [ [ 'secr',  0,   0,   'Foo',   0,    '',       qw( s     ) ],
          'THIS->secr(s);'                                                  ],
        [ [ 'secr',  0,   0,   'Bar',   0,    '',       qw( s     ) ],
          'THIS->secr(s);'                                                  ],
        [ [ 'prn',   0,   0,   '',      0,    '',       qw(       ) ],
          'prn();'                                                          ],
        [ [ 'dat',   0,   0,   'Foo',   2,    'char *', qw(       ) ],
          'const_cast<char *>(THIS->dat());'                                ],
        [ [ 'dat',   0,   0,   'Foo',   2,    'char *', qw( a     ) ],
          'const_cast<char *>(THIS->dat(a));'                               ],
        [ [ 'foo',   0,   0,   'Freak', '',   'int',    qw( a     ) ],
          'THIS->foo(a);'                                                   ],
        [ [ 'foo',   0,   0,   'Freak', '',   'int',    qw( a b   ) ],
          'THIS->foo(a,b);'                                                 ],
        [ [ 'foo',   0,   0,   'Freak', '',   'int',    qw( a b c ) ],
          'THIS->foo(a,b,c);'                                               ],
        [ [ 'foo2',  0,   0,   'Freak', 0,    'int',    qw( a b c ) ],
          'THIS->foo2(a,b,c);'                                              ],
        [ [ 'foo',   0,   0,   '',      '',   'int',    qw( a     ) ],
          'foo(a);'                                                         ],
        [ [ 'Fizzl', 1,   0,   'Fizzl', '',   '',       qw( Q     ) ],
          'new Fizzl(Q);'                                                   ],
        [ [ 'Fizzl', 1,   0,   'Fizzl', '',   '',       qw( Q Fooz) ],
          'new Fizzl(Q,Fooz);'                                              ],
        [ [ 'Fizzl', 0,   1,   'Fizzl', '',   '',       qw(       ) ],
          'delete Fizzl();'                                                 ], # This may exercise unused code.
        [ [ 'test',  0,   0,   'Bar',   3,    'int',    qw(       ) ],
          'THIS->test();'                                                   ],
    );
    foreach my $test ( @tests ) {
        is( Inline::CPP::call_or_instantiate( @{$test->[0]} ),
            $test->[1] . "\n",
            sprintf( "%-65s => %-33s",
                "call_or_instantiate('" . join( "','", @{$test->[0]} ) . "')",
                $test->[1]
            )
        );
    }
    return;
};


done_testing();