view release on metacpan or  search on metacpan

t/008-parse-xsub-keywords.t  view on Meta::CPAN

        [
            "OVERLOAD unrecognised op",
            Q(<<'EOF'),
                |void
                |foo()
                |    OVERLOAD: []
EOF
            [ERR, qr{\QWarning: unrecognised OVERLOAD op name '[]' ignored},
                "got expected error"   ],
        ],

    );

    test_many($preamble, 'boot_Foo', \@test_fns);
}


{
    # Test POSTCALL keyword

    my $preamble = Q(<<'EOF');
        |MODULE = Foo PACKAGE = Foo
        |
        |PROTOTYPES:  DISABLE
        |
EOF

    my @test_fns = (
        [
            "POSTCALL basic",
            Q(<<'EOF'),
                |int
                |foo(int aaa)
                |  POSTCALL:
                |     YYY
EOF
            [  0, qr{\bint\s+aaa},                  "has aaa decl"      ],
            [  0, qr{^\s+\QRETVAL = foo(aaa);}m,    "has code body"     ],
            [  0, qr{^\s+YYY\n}m,                   "has postcall body" ],
            [  0, qr{aaa.*foo\(aaa\).*YYY.*TARGi}s, "in sequence"       ],
            [  0, qr{\#line 8 .*\n\s+YYY},          "correct #line"     ],
        ],
        [
             "POSTCALL empty",
             Q(<<'EOF'),
                 |void
                 |foo(int aaa)
                 |  POSTCALL:
EOF
            [  0, qr{\bint\s+aaa},                  "has aaa decl"      ],
            [  0, qr{^\s+\Qfoo(aaa);}m,             "has code body"     ],
            [  0, qr{\Qfoo(aaa);\E\n\#line 8 },     "correct #line"     ],
         ],
    );

    test_many($preamble, 'XS_Foo_', \@test_fns);
}


{
    # Test PPCODE keyword

    my $preamble = Q(<<'EOF');
        |MODULE = Foo PACKAGE = Foo
        |
        |PROTOTYPES:  DISABLE
        |
EOF

    my @test_fns = (
        [
            "PPCODE basic",
            Q(<<'EOF'),
                |void
                |foo(int aaa)
                |  PPCODE:
                |     YYY
EOF
            [  0, qr{\bint\s+aaa},           "has aaa decl"   ],
            [  0, qr{YYY},                   "has code body"  ],
            [  0, qr{aaa.*YYY}s,             "in sequence"    ],
            [  0, qr{\#line 8 .*\n\s+YYY},   "correct #line"  ],
        ],
        [
            "PPCODE empty",
            Q(<<'EOF'),
                |void
                |foo(int aaa)
                |  PPCODE:
EOF
            [  0, qr{\bint\s+aaa},               "has aaa decl"   ],
            [  0, qr{aaa.*\n\s*;\s*\n\#line 8 }, "correct #line"  ],
        ],
        [
            "PPCODE trailing keyword",
            Q(<<'EOF'),
                |void
                |foo(int aaa)
                |  PPCODE:
                |     YYY
                |  OUTPUT:
                |     blah
EOF
            [ERR, qr{Error: PPCODE must be the last thing}, "got expected err"  ],
        ],
        [
            "PPCODE code tweaks",
            Q(<<'EOF'),
                |void
                |foo(int aaa)
                |  PPCODE:
                |     YYY
EOF
            [  0, qr{\QPERL_UNUSED_VAR(ax);},   "got PERL_UNUSED_VAR"    ],
            [  0, qr{\QSP -= items;},           "got SP -= items"        ],
            [NOT, qr{\QXSRETURN},               "no XSRETURN"            ],
            [  0, qr{\bPUTBACK\b.*\breturn\b}s, "got PUTBACK and return" ],
        ],

    );

    test_many($preamble, 'XS_Foo_', \@test_fns);
}


{
    # Test PREINIT: keyword

    my $preamble = Q(<<'EOF');
        |MODULE = Foo PACKAGE = Foo
        |
        |PROTOTYPES:  DISABLE
        |
EOF

    my @test_fns = (
        [
            "PREINIT basic",
            Q(<<'EOF'),
                |void
                |foo(aaa, bbb)
                |    int aaa
                |  PREINIT:
                |     XXX
                |     YYY
                |  INPUT:
                |     short bbb
                |  CODE:
                |     ZZZ
EOF
            [  0, qr{\bint\s+aaa},             "has aaa decl"   ],
            [  0, qr{^\s+XXX\n\s+YYY\n}m,      "has XXX, YYY"   ],
            [  0, qr{\bshort\s+bbb},           "has bbb decl"   ],
            [  0, qr{^\s+ZZZ\n}m,              "has ZZZ"        ],
            [  0, qr{int\s+aaa.*XXX.*YYY.*bbb.*ZZZ}s,"in sequence"    ],
        ],

    );

    test_many($preamble, 'XS_Foo_', \@test_fns);
}


{
    # Test XSUB-scoped SCOPE keyword

    my $preamble = Q(<<'EOF');
        |MODULE = Foo PACKAGE = Foo
        |
        |PROTOTYPES:  DISABLE
        |

t/008-parse-xsub-keywords.t  view on Meta::CPAN

                |C_ARGS: a,b,c
                |SCOPE: ENABLE
EOF
            [  0, qr{ENTER;\s+{\s+\Qfoo(a,b,c);\E\s+}\s+LEAVE;},
                    "has ENTER/LEAVE" ],
        ],
        [
            "/* SCOPE */ in typemap",
            Q(<<'EOF'),
                |void
                |foo(i)
                | MyScopeInt i
EOF
            [  0, qr{ENTER;\s+{.+\s+}\s+LEAVE;}s, "has ENTER/LEAVE" ],
        ],
        [
            "xsub duplicate SCOPE",
            Q(<<'EOF'),
                |void
                |foo()
                |SCOPE: ENABLE
                |SCOPE: ENABLE
EOF
            [ERR, qr{\QError: only one SCOPE declaration allowed per XSUB},
                    "got expected error"],
        ],
        [
            "unrecognised file-scoped keyword",
            Q(<<'EOF'),
                |FOO_BAR:
EOF
            [ERR,
                qr{\QError: unrecognised keyword 'FOO_BAR' in (input), line 12\E\n},
                    "got expected error"],
        ],
    );

    test_many($preamble, 'XS_Foo_', \@test_fns);
}


{
    # Test warnings for junk after a codeblock-ish keyword
    # and confirm that such junk is indeed ignored.
    # (BOOT is tested elsewhere as it's not an XSUB keyword)

    my $preamble = Q(<<'EOF');
        |MODULE = Foo PACKAGE = Foo
        |
        |PROTOTYPES:  DISABLE
        |
EOF

    my @test_fns;

    for my $kw (qw(
                    CLEANUP
                    CODE
                    INIT
                    POSTCALL
                    PPCODE
                    PREINIT
                ))
    {
        push @test_fns,
            [
                "Warn if junk after $kw'",
                Q(<<"EOF"),
                    |int foo()
                    |$kw: blah
                    |  codeline
EOF
                [  0, qr{\Q#line 7 "(input)"\E\n  codeline\n#line},
                "junk ignored" ],
                [ERR, qr{Warning: text after keyword ignored: 'blah'}, "" ],
            ];
    }

    test_many($preamble, 'XS_Foo_', \@test_fns);

    @test_fns = (
        [
            "Warn if junk after BOOT'",
            Q(<<"EOF"),
                |BOOT: blah
                |  codeline
EOF
            [ERR, qr{Warning: text after keyword ignored: 'blah'}, "" ],
        ],
    );

    test_many($preamble, undef, \@test_fns);
}


done_testing;