# This test instantiates tokens directly rather than through the
# tokenizer. It is up to the author of the test to be sure that the
# the contents of each token are consistent with its class. There is
# also the risk that tokens instantiated directly may be set up
# differently than theoretically-equivalent tokens generated by the
# tokenizer, in cases where __PPIX_TOKEN__recognize() is used.
#
# Caveat Auctor.

package main;

use 5.006;

use strict;
use warnings;

use PPIx::Regexp;
use PPIx::Regexp::Constant qw{
    HASH_REF
    SUFFICIENT_UTF8_SUPPORT_FOR_WEIRD_DELIMITERS
};
use Scalar::Util qw{ blessed };

BEGIN {
    # NOTE that this MUST be done before Test::More is loaded.
    if ( SUFFICIENT_UTF8_SUPPORT_FOR_WEIRD_DELIMITERS ) {
	require 'open.pm';
	'open'->import( qw{ :std :encoding(utf-8) } );
    }
}

use Test::More 0.88;

use charnames qw{ :full };

our $REPORT;	# True to report rather than test.

# If $REPORT is true, you get instead of a test a CSV-formatted report
# of the syntax elements and the versions they were introduced and
# retracted. Named arguments to the routines have been added to support
# the report -- perhaps too many of them. All are optional. They are:
#     note => Text describing the thing being reported on. This is
#         described further in the details of the report.
#     text => The text of the thing reported on. If applied to the class
#         it is a sprintf template. The default is the content of the
#         token.
#     report => false to suppress the report. If applied to the class it
#         is a default for all tokens in that class.
# The columns of the report are:
#     Kind => The kind of syntax element. This is the 'note' argument to
#         the class() subroutine, and defaults to the class name.
#     Token => The syntax element itself. This is the 'text' argument of
#         the token() or class() subroutines (the latter suitably
#         processed), defaulting to the actual content of the syntax
#         element.
#     Descr => The description of the syntax element. This is the 'note'
#         argument of the token() subroutine, defaulting to the empty
#         string.
#     Introduced => The version of Perl in which the element was
#         introduced, from the perl_version_introduced() method of the
#         token. Since I have not researched Perl 4, and I have no
#         access to Perls earlier than 5.3, anything in 5.3 is assumed
#         willy-nilly to be in Perl 5.0.
#     Ref => The source of the version introduced, if known. Typically a
#         Perl documentation reference. If a reference other than
#         perl?*delta, the Perl version of the documentation is
#         prefaced, and the version is inferred from the fact that the
#         previous version of the document did not refer to the feature.
#         The default is the empty string.
#     Removed => The version of Perl in which the element was removed.
#         The default is '', indicating that the element is still in
#         Perl.
#     Ref => The source of the version removed, if known, and if the
#         element has in fact been removed.
#
# One way to use this is
#     $ perl -e '$REPORT = 1; do "t/version.t";'

# Trailing empty fields are removed.

use PPIx::Regexp::Constant qw{ COOKIE_CLASS COOKIE_REGEX_SET MINIMUM_PERL };
use PPIx::Regexp::Tokenizer;

klass(	'PPIx::Regexp::Token::Assertion', note => 'Assertion' );
token(	'^', note => 'Matches beginning of string or after newline' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'$', note => 'Matches end of string or newline' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\b', note => 'Matches word/nonword boundary' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\B', note => 'Opposite of \b' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\A', note => 'Matches beginning of string' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\Z', note => 'Matches end of string, or newline before end' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\G', note => 'Matches at pos()' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\z', note => 'Matches end of string' );
m_call(	perl_version_introduced => '5.005', note => 'perl5005delta' );
m_call(	perl_version_removed	=> undef );
token(	'\K', note => 'In s///, keep everything before the \K' );
m_call(	perl_version_introduced => '5.009005', note => 'perl595delta' );
m_call(	perl_version_removed	=> undef );
token(	'\b{gcb}', note => 'Assert grapheme cluster boundary' );
m_call(	perl_version_introduced => '5.021009', note => 'perl5219delta' );
m_call(	perl_version_removed	=> undef );
token(	'\b{g}', note => 'Assert grapheme cluster boundary' );
m_call(	perl_version_introduced => '5.021009', note => 'perl5219delta' );
m_call(	perl_version_removed	=> undef );
token(	'\b{lb}', note => 'Assert line boundary' );
m_call(	perl_version_introduced => '5.023007', note => 'perl5237delta' );
m_call(	perl_version_removed	=> undef );
token(	'\b{wb}', note => 'Assert word boundary' );
m_call(	perl_version_introduced => '5.021009', note => 'perl5219delta' );
m_call(	perl_version_removed	=> undef );
token(	'\b{sb}', note => 'Assert sentence boundary' );
m_call(	perl_version_introduced => '5.021009', note => 'perl5219delta' );
m_call(	perl_version_removed	=> undef );
token(	'\B{gcb}', note => 'Assert no grapheme cluster boundary' );
m_call(	perl_version_introduced => '5.021009', note => 'perl5219delta' );
m_call(	perl_version_removed	=> undef );
token(	'\B{g}', note => 'Assert no grapheme cluster boundary' );
m_call(	perl_version_introduced => '5.021009', note => 'perl5219delta' );
m_call(	perl_version_removed	=> undef );
token(	'\B{lb}', note => 'Assert no line boundary' );
m_call(	perl_version_introduced => '5.023007', note => 'perl5237delta' );
m_call(	perl_version_removed	=> undef );
token(	'\B{wb}', note => 'Assert no word boundary' );
m_call(	perl_version_introduced => '5.021009', note => 'perl5219delta' );
m_call(	perl_version_removed	=> undef );
token(	'\B{sb}', note => 'Assert no sentence boundary' );
m_call(	perl_version_introduced => '5.021009', note => 'perl5219delta' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::Backreference', note => 'Back reference' );
token(	'\1', note => 'Back reference to first capture group' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\g1', note => 'Back reference to first capture group' );
m_call(	perl_version_introduced => '5.009005', note => 'perl595delta' );
m_call(	perl_version_removed	=> undef );
token(	'\g{1}', note => 'Back reference to first capture group' );
m_call(	perl_version_introduced => '5.009005', note => 'perl595delta' );
m_call(	perl_version_removed	=> undef );
token(	'\g-1', note => 'Back reference to previous capture group' );
m_call(	perl_version_introduced => '5.009005' );
m_call(	perl_version_removed	=> undef );
token(	'\g{-1}', note => 'Back reference to previous capture group' );
m_call(	perl_version_introduced => '5.009005', note => 'perl595delta' );
m_call(	perl_version_removed	=> undef );
token(	'\k<foo>', note => 'Back reference to named capture group' );
m_call(	perl_version_introduced => '5.009005', note => 'perl595delta' );
m_call(	perl_version_removed	=> undef );
token(	q{\k'foo'}, note => 'Back reference to named capture group' );
m_call(	perl_version_introduced => '5.009005' );
m_call(	perl_version_removed	=> undef );
token(	'(?P=foo)', note => 'Back reference to named capture group' );
m_call(	perl_version_introduced => '5.009005' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::Backtrack', note => 'Back tracking control' );
token(	'(*THEN)', note => 'Forces next alternation on failure' );
m_call(	perl_version_introduced => '5.009005', note => 'perl595delta' );
m_call(	perl_version_removed	=> undef );
token(	'(*PRUNE)', note => 'Prevent backtracking past here on failure' );
m_call(	perl_version_introduced => '5.009005', note => 'perl595delta' );
m_call(	perl_version_removed	=> undef );
token(	'(*MARK)',
    note => 'Name branches of alternation, target for (*SKIP)' );
m_call(	perl_version_introduced => '5.009005', note => 'perl595delta' );
m_call(	perl_version_removed	=> undef );
token(	'(*SKIP)',
    note => 'Like (*PRUNE) but also discards match to this point' );
m_call(	perl_version_introduced => '5.009005', note => 'perl595delta' );
m_call(	perl_version_removed	=> undef );
token(	'(*COMMIT)',
    note => 'Causes match failure when backtracked into on failure' );
m_call(	perl_version_introduced => '5.009005', note => 'perl595delta' );
m_call(	perl_version_removed	=> undef );
token(	'(*FAIL)', note => 'Always fails, forcing backtrack' );
m_call(	perl_version_introduced => '5.009005', note => 'perl595delta' );
m_call(	perl_version_removed	=> undef );
token(	'(*ACCEPT)',
    note => 'Causes match to succeed at the point of the (*ACCEPT)' );
m_call(	perl_version_introduced => '5.009005', note => 'perl595delta' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::CharClass::POSIX',
    note => 'POSIX character class' );
token(	'[:alpha:]', note => 'Match alphabetic' );
m_call(	perl_version_introduced	=> '5.006', note => 'perl56delta' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::CharClass::Simple',
    note => 'Character class' );
token(	'.', note => 'Match any character' );
m_call(	perl_version_introduced	=> MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\w', note => 'Match word character' );
m_call(	perl_version_introduced	=> MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\W', note => 'Match non-word character' );
m_call(	perl_version_introduced	=> MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\s', note => 'Match white-space character' );
m_call(	perl_version_introduced	=> MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\S', note => 'Match non-white-space character' );
m_call(	perl_version_introduced	=> MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\d', note => 'Match decimal digit' );
m_call(	perl_version_introduced	=> MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\D', note => 'Match any character but a decimal digit' );
m_call(	perl_version_introduced	=> MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(   '\C', note => 'Match a single octet (removed in 5.23.0)' );
m_call(  perl_version_introduced => '5.006' );
m_call(  perl_version_removed    => '5.023' );
token(   '\X', note => 'Match a Unicode extended grapheme cluster' );
m_call(  perl_version_introduced => '5.006', note => '5.6.0 perlre' );
m_call(  perl_version_removed    => undef );
token(	'\p{Latin}',
    note => 'Match a character with the given Unicode property' );
m_call(	perl_version_introduced	=> '5.006001', note => 'perl561delta' );
m_call(	perl_version_removed	=> undef );
token(	'\h', note => 'Match a horizontal-white-space character' );
m_call(	perl_version_introduced => '5.009005', note => 'perl595delta' );
m_call(	perl_version_removed	=> undef );
token(	'\H', note => 'Match a non-horizontal-white-space character' );
m_call(	perl_version_introduced => '5.009005', note => 'perl595delta' );
m_call(	perl_version_removed	=> undef );
token(	'\v', note => 'Match a vertical-white-space character' );
m_call(	perl_version_introduced => '5.009005', note => 'perl595delta' );
m_call(	perl_version_removed	=> undef );
token(	'\V', note => 'Match a non-vertical-white-space character' );
m_call(	perl_version_introduced => '5.009005', note => 'perl595delta' );
m_call(	perl_version_removed	=> undef );
token(	'\R', note => 'Match a generic new-line character' );
m_call(	perl_version_introduced => '5.009005', note => 'perl595delta' );
m_call(	perl_version_removed	=> undef );
token(	'\N', note => 'Match any character but a new-line character' );
m_call(	perl_version_introduced => '5.011', note => 'perl5110delta' );
m_call(	perl_version_removed	=> undef );
token(	'\\p{Script=/Latin|Greek/}',
    note => 'Match a character with the given wildcard property value' );
m_call(	perl_version_introduced => '5.029009', note => 'perl5299delta' );
m_call(	perl_version_removed	=> undef );
token(	'\\p{name=/(SMILING|GRINNING) FACE/}' );

klass(	'PPIx::Regexp::Token::Code', note => 'Code', report => 0 );
token(	'{foo}', note => 'Code' );
m_call(	perl_version_introduced	=> '5.005' );	# see ::GroupType::Code
m_call(	perl_version_removed	=> undef );
token(   '$x->&*', note => 'Code with postderef' );
m_call(	perl_version_introduced	=> '5.019005', note => 'perl5195delta' );
m_call(	perl_version_removed	=> undef );
token(   '$x->%{foo,bar}', note => 'Code with postderef slice' );
m_call(	perl_version_introduced	=> '5.019005', note => 'perl5195delta' );
m_call(	perl_version_removed	=> undef );
# The( interesting version functionality is on
# PPIx::Regexp::Token::GroupType::Code.

klass(	'PPIx::Regexp::Token::Comment', note => 'Comment' );
token(	'(?#foo)', note => 'Embedded comment' );
m_call(	perl_version_introduced	=> MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'# foo', note => 'Extended comment, with /x' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::Condition', note => 'Condition' );
token(	'(1)', note => 'True if the first capture group matched' );
m_call(	perl_version_introduced => '5.005', note => 'perl5005delta' );
m_call(	perl_version_removed	=> undef );
token(	'(R1)',
    note => 'True if recursing directly inside first capture group' );
m_call(	perl_version_introduced => '5.009005' );
m_call(	perl_version_removed	=> undef );
token(	'(R)', note => 'True if recursing' );
m_call(	perl_version_introduced => '5.009005' );
m_call(	perl_version_removed	=> undef );
token(	'(<foo>)', note => 'True if capture group <foo> matched' );
m_call(	perl_version_introduced => '5.009005' );
m_call(	perl_version_removed	=> undef );
token(	q{('foo')}, note => 'True if capture group <foo> matched' );
m_call(	perl_version_introduced => '5.009005' );
m_call(	perl_version_removed	=> undef );
token(	'(R&foo)',
    note => 'True if recursing directly inside capture group <foo>' );
m_call(	perl_version_introduced => '5.009005' );
m_call(	perl_version_removed	=> undef );
token(	'(DEFINE)', note => 'Define a group to be recursed into' );
m_call(	perl_version_introduced => '5.009005' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::Control', note => 'Interpolation control' );
token(	'\l', note => 'Lowercase next character' );
m_call(	perl_version_introduced	=> MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\u', note => 'Uppercase next character' );
m_call(	perl_version_introduced	=> MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\L', note => 'Lowercase until \E' );
m_call(	perl_version_introduced	=> MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\U', note => 'Uppercase until \E' );
m_call(	perl_version_introduced	=> MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\F', note => 'Fold case until \E' );
m_call(  perl_version_introduced => '5.015008' );
m_call(	perl_version_removed	=> undef );
token(	'\E', note => 'End of interpolation control' );
m_call(	perl_version_introduced	=> MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\Q', note => 'Quote interpolated metacharacters until \E' );
m_call(	perl_version_introduced	=> MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::Delimiter', note => 'Delimiter', report => 0 );
token(	'/' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
SKIP: {
    SUFFICIENT_UTF8_SUPPORT_FOR_WEIRD_DELIMITERS
	or skip 'Weird delimiters test requires Perl 5.8.3 or above', 3;

    token(	"\N{COMBINING CIRCUMFLEX ACCENT}" );
    m_call(	perl_version_introduced => '5.008003',
	note => 'experimentation' );
    m_call(	perl_version_removed	=> '5.029' );
}

klass(	'PPIx::Regexp::Token::Greediness', note => 'Greediness' );
token(	'?', note => 'Match shortest string first' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'+', note => 'Match longest string and give nothing back' );
m_call(	perl_version_introduced => '5.009005', note => 'perl595delta' );
m_call(	perl_version_removed	=> undef );

# PPIx::Regexp::Token::GroupType: see( the individual subclasses, below.

klass(	'PPIx::Regexp::Token::GroupType::Assertion', note => 'Assertion',
    text => '(%sregexp)' );
token(	'?=', note => 'Positive lookahead' );
m_call(	perl_version_introduced	=> MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'*pla:', note => 'Positive lookahead' );
m_call(	perl_version_introduced	=> '5.027009', note => '5.27.9 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'*positive_lookahead:', note => 'Positive lookahead' );
m_call(	perl_version_introduced	=> '5.027009', note => '5.27.9 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'?!', note => 'Negative lookahead' );
m_call(	perl_version_introduced	=> MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'*nla:', note => 'Negative lookahead' );
m_call(	perl_version_introduced	=> '5.027009', note => '5.27.9 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'*negative_lookahead:', note => 'Negative lookahead' );
m_call(	perl_version_introduced	=> '5.027009', note => '5.27.9 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'?<=', note => 'Positive lookbehind' );
m_call(	perl_version_introduced	=> '5.005', note => 'perl5005delta' );
m_call(	perl_version_removed	=> undef );
token(	'*plb:', note => 'Positive lookbehind' );
m_call(	perl_version_introduced	=> '5.027009', note => '5.27.9 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'*positive_lookbehind:', note => 'Positive lookbehind' );
m_call(	perl_version_introduced	=> '5.027009', note => '5.27.9 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'?<!', note => 'Negative lookbehind' );
m_call(	perl_version_introduced	=> '5.005', note => 'perl5005delta' );
m_call(	perl_version_removed	=> undef );
token(	'*nlb:', note => 'Negative lookbehind' );
m_call(	perl_version_introduced	=> '5.027009', note => '5.27.9 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'*negative_lookbehind:', note => 'Negative lookbehind' );
m_call(	perl_version_introduced	=> '5.027009', note => '5.27.9 perlre' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::GroupType::BranchReset',
    note => 'Branch reset' );
token(	'?|',
    note => 'Re-use capture group numbers in branches of alternation',
    text => '(?|regexp|regexp...)' );
m_call(	perl_version_introduced	=> '5.009005', note => '5.9.5 perlre' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::GroupType::Code', note => 'Code',
    text => '(%s{code})' );
token(	'?p', note => 'Function unknown' );
m_call(	perl_version_introduced	=> '5.005',
    note => 'Undocumented that I can find' );
m_call(	perl_version_removed	=> '5.009005', note => 'perl595delta' );
token(	'?', note => 'Evaluate code. Always matches.' );
m_call(	perl_version_introduced	=> '5.005', note => 'perl5005delta' );
m_call(	perl_version_removed	=> undef );
token(	'??', note => 'Evaluate code, use as regexp at this point' );
m_call(	perl_version_introduced	=> '5.006',
    note => 'perl56delta (not in 5.5.4 perlre)' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::GroupType::Modifier', note => 'Clustering',
    text => '(%sregexp)' );
token(	'?:', note => 'Basic clustering' );
m_call(	perl_version_introduced	=> MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'?i:', note => 'Cluster with case-independance' );
m_call(	perl_version_introduced	=> '5.005', note => 'perl5005delta' );
m_call(	perl_version_removed	=> undef );
token(	'?i-x:',
    note => 'Cluster with case-independance but no extended syntax' );
m_call(	perl_version_introduced	=> '5.005', note => 'perl5005delta' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::GroupType::Modifier', note => 'Modifiers',
    text => '(%s)', report => 0 );
token(	'?^i', note => 'Reassert defaults, case-independance' );
m_call(	perl_version_introduced	=> '5.013006', note => 'perl5136delta' );
m_call(	perl_version_removed	=> undef );
token(	'?d', note => 'Compile without locale or unicode_strings' );
m_call(	perl_version_introduced	=> '5.013006', note => 'perl5136delta' );
m_call(	perl_version_removed	=> undef );
token(	'?l', note => 'Compile with locale' );
m_call(	perl_version_introduced	=> '5.013006', note => 'perl5136delta' );
m_call(	perl_version_removed	=> undef );
token(	'?u', note => 'Compile with unicode_strings' );
m_call(	perl_version_introduced	=> '5.013006', note => 'perl5136delta' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::GroupType::NamedCapture',
    note => 'Named capture', text => '(%sregexp)' );
token(	'?<foo>', note => 'Basic named capture' );
m_call(	perl_version_introduced	=> '5.009005', note => 'perl595delta' );
m_call(	perl_version_removed	=> undef );
token(	q{?'foo'}, note => 'Named capture, quoted syntax' );
m_call(	perl_version_introduced	=> '5.009005', note => '5.9.5 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'?P<foo>', note => 'Named capture, PCRE/Python syntax' );
m_call(	perl_version_introduced	=> '5.009005', note => '5.9.5 perlre' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::GroupType::Subexpression',
    note => 'Subexpression', text => '(%sregexp)' );
token(	'?>', note => 'Match subexpression without backtracking' );
m_call(	perl_version_introduced	=> '5.005', note => 'perl5005delta' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::GroupType::Switch', note => 'Switch',
    report => 0 );	# See PPIx::Regexp::Token::Condition
token(	'?' );
m_call(	perl_version_introduced => '5.005' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::Interpolation', note => 'Interpolation' );
token(	'$foo', note => 'Interpolate the contents of $foo' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'$foo', cookie => COOKIE_REGEX_SET,
    note => 'Interpolation in regex set' );
m_call(	perl_version_introduced	=> '5.017009', note => 'perl5179delta' );
m_call(	perl_version_removed	=> undef );
token(	'$x->@*', note => 'Postfix deref' );
m_call(	perl_version_introduced => '5.019005', note => 'perl5195delta' );
m_call(	perl_version_removed	=> undef );
token(	'$x->@[1,2]', note => 'Postfix deref slice' );
m_call(	perl_version_introduced => '5.019005', note => 'perl5195delta' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::Literal', note => 'Literal' );
token(	'a', note => q{Letter 'a'} );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
token(	'\b', note => 'Back space, in character class only' );
m_call(	perl_version_introduced => MINIMUM_PERL );
m_call(	perl_version_removed	=> undef );
token(	'\t', note => 'Horizontal tab' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\n', note => 'New line' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\r', note => 'Return' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\a', note => 'Alarm (bell)' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\e', note => 'Escape' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\033', note => 'Octal 33 = escape, classic' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\o{61}', note => q{Octal 61 = '1', new style} );
m_call(	perl_version_introduced	=> '5.013003', note => 'perl5133delta' );
m_call(	perl_version_removed	=> undef );
token(	'\x1B', note => 'Hex 1b = escape, classic' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\x{1b}', note => 'Hex 1b = escape, new style' );
m_call(	perl_version_introduced	=> '5.006',
    note => '5.6.0 perlre (not in perldelta)' );
m_call(	perl_version_removed	=> undef );
token(	'\c[', note => 'Control-[ = escape' );	# ]
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'\N{LATIN SMALL LETTER P}', note => q{Letter 'p', by name} );
m_call(	perl_version_introduced => '5.006001', note => 'perl561delta' );
m_call(	perl_version_removed	=> undef );
token(   '\N{U+32}', note => q{Digit '2', by Unicode code point} );
m_call(  perl_version_introduced => '5.008', note => '5.8.0 charnames' );
m_call(	perl_version_removed	=> undef );
token(	'{', note => 'Initial unescaped literal left curly' );
m_call(	perl_version_introduced => MINIMUM_PERL );
m_call(	perl_version_removed	=> undef );
token(	'{', note => 'Unescaped literal left curly', previous => 1 );
m_call(	perl_version_introduced => MINIMUM_PERL );
# m_call(	perl_version_removed	=> '5.025001' );
note(    '/x{/ removed in 5.025001, re-added in 5.027001' );
m_call(	perl_version_removed	=> undef );
token(	'\\N{LATIN CAPITAL LETTER A}', main => q<'> );
m_call(	perl_version_introduced => '5.029010', note => '5.29.10 perldelta' );
m_call(	perl_version_removed	=> undef );

token(	'\s', class => 'PPIx::Regexp::Token::CharClass::Simple' );
token(	'{', previous => 1 );
m_call(	perl_version_introduced => MINIMUM_PERL );
m_call(	perl_version_removed	=> '5.025001' );

token(	'.', class => 'PPIx::Regexp::Token::CharClass::Simple' );
token(	'{', previous => 1 );
m_call(	perl_version_introduced => MINIMUM_PERL );
m_call(	perl_version_removed	=> undef );	# Not removed yet

token(	'\p{Latin}', class => 'PPIx::Regexp::Token::CharClass::Simple' );
token(	'{', previous => 1 );
m_call(	perl_version_introduced => MINIMUM_PERL );
m_call(	perl_version_removed	=> undef );	# Not removed yet

token(	'\P{Latin}', class => 'PPIx::Regexp::Token::CharClass::Simple' );
token(	'{', previous => 1 );
m_call(	perl_version_introduced => MINIMUM_PERL );
m_call(	perl_version_removed	=> undef );	# Not removed yet

token(	'^', class => 'PPIx::Regexp::Token::Assertion' );
token(	'{', previous => 1 );
m_call(	perl_version_introduced => MINIMUM_PERL );
m_call(	perl_version_removed	=> undef );

require	PPIx::Regexp::Structure::Assertion;
token(	undef, class => 'PPIx::Regexp::Structure::Assertion' );
token(	'{', previous => 1 );
m_call(	perl_version_introduced => MINIMUM_PERL );
m_call(	perl_version_removed	=> undef );

require	PPIx::Regexp::Structure::CharClass;
token(	undef, class => 'PPIx::Regexp::Structure::CharClass' );
token(	'{', previous => 1 );
m_call(	perl_version_introduced => MINIMUM_PERL );
m_call(	perl_version_removed	=> undef );	# Not removed yet

require	PPIx::Regexp::Structure::RegexSet;
token(	undef, class => 'PPIx::Regexp::Structure::RegexSet' );
token(	'{', previous => 1 );
m_call(	perl_version_introduced => MINIMUM_PERL );
m_call(	perl_version_removed	=> undef );	# Not removed yet


klass(	'PPIx::Regexp::Token::Modifier', note => 'Operator modifiers',
    text => '/%s' );
token(	'i', note => 'Case independent' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	's', note => 'Single-line' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'm', note => 'Multiple lines' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'x', note => 'Extended syntax' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'xx', note => 'Extended syntax eveb inside bracketed classes' );
m_call(	perl_version_introduced	=> '5.025009', note => '5.25.9 perldelta' );
m_call(	perl_version_removed	=> undef );
token(	'g', note => 'Global matching' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'o', note => 'Compile once' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'e', note => 'Replacement is expression' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'ee', note => 'Replacement is eval-ed expression' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'c', note => 'Do not reset pos() on failure (with /g)' );
m_call(	perl_version_introduced => '5.004', note => '5.4.5 perlop' );
m_call(	perl_version_removed	=> undef );
token(	'p', note => 'Populate ${^PREMATCH}, ${^MATCH}, and ${^POSTMATCH}' );
m_call(	perl_version_introduced => '5.009005', note => '5.9.5 perlop' );
m_call(	perl_version_removed	=> undef );
token(	'r',
    note => 'Return modified string from s///, leaving original unmodified' );
m_call(	perl_version_introduced => '5.013002', note => 'perl5132delta' );
m_call(	perl_version_removed	=> undef );
token(	'pi', report => 0 );
m_call(	perl_version_introduced => '5.009005' );
m_call(	perl_version_removed	=> undef );
token(	'pir', report => 0 );
m_call(	perl_version_introduced => '5.013002' );
m_call(	perl_version_removed	=> undef );
token(	'a',
    note => 'Match like /u, but restrict non-Unicode classes to ASCII' );
m_call(	perl_version_introduced	=> '5.013010', note => 'perl51310delta' );
m_call(	perl_version_removed	=> undef );
token(	'aa',
    note => 'Match like /a, and do not match ASCII and non-ASCII literals' );
m_call(	perl_version_introduced	=> '5.013010', note => 'perl51310delta' );
m_call(	perl_version_removed	=> undef );
token(	'd', note => 'Match using default (pre-5.13.10) semantics' );
m_call(	perl_version_introduced	=> '5.013010', note => 'perl51310delta' );
m_call(	perl_version_removed	=> undef );
token(	'l', note => 'Match using current locale semantics' );
m_call(	perl_version_introduced	=> '5.013010', note => 'perl51310delta' );
m_call(	perl_version_removed	=> undef );
token(	'u', note => 'Match using Unicode semantics' );
m_call(	perl_version_introduced	=> '5.013010', note => 'perl51310delta' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::Modifier', note => 'Embedded modifiers' );
token(	'(?i)', note => 'Basic modifier (case-independence)' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'(?i-x)', note => 'Negated modifier (extended syntax)' );
m_call(	perl_version_introduced => '5.005', note => 'perl5005delta' );
m_call(	perl_version_removed	=> undef );
token(	'(?^i)', note => 'Re-apply defaults, plus case-independence' );
m_call(	perl_version_introduced	=> '5.013006', note => 'perl5136delta' );
m_call(	perl_version_removed	=> undef );
token(	'(?a)', note => 'Embedded /a' );
m_call(	perl_version_introduced	=> '5.013009', note => 'perl5139delta' );
m_call(	perl_version_removed	=> undef );
token(	'(?d)', note => 'Embedded /d' );
m_call(	perl_version_introduced	=> '5.013006', note => 'perl5136delta' );
m_call(	perl_version_removed	=> undef );
token(	'(?l)', note => 'Embedded /l' );
m_call(	perl_version_introduced	=> '5.013006', note => 'perl5136delta' );
m_call(	perl_version_removed	=> undef );
token(	'(?u)', note => 'Embedded /u' );
m_call(	perl_version_introduced	=> '5.013006', note => 'perl5136delta' );
m_call(	perl_version_removed	=> undef );
token(	'(?aa)', note => 'Embedded /aa' );
m_call(	perl_version_introduced	=> '5.013010', note => 'perl51310delta' );
m_call(	perl_version_removed	=> undef );

klass(   'PPIx::Regexp::Token::NoOp', note => 'Does nothing' );
token(   '\\N{}', note => 'Unicode character with empty name' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => 'perl5238delta (!)' );
m_call(	perl_version_removed	=> '5.027001', note => 'perl5271delta' );

klass(	'PPIx::Regexp::Token::Operator', note => 'Operator' );
token(	'|', note => 'Alternation (outside character class)' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'^', cookie => COOKIE_CLASS, note => 'Character class inversion' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'-', cookie => COOKIE_REGEX_SET, note => 'Character range (inside character class)' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::Quantifier', note => 'Quantifier' );
token(	'*', note => 'Zero or more' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'+', note => 'One or more' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'?', note => 'Zero or one' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );

# TODO( the quantifier {m,n} gets covered, if at all, under
# PPIx::Regexp::Token::Structure.

klass(	'PPIx::Regexp::Token::Recursion', note => 'Recursion' );
token(	'(?1)', note => 'Recurse to first capture' );
m_call(	perl_version_introduced => '5.009005' );	# perl595delta
m_call(	perl_version_removed	=> undef );
token(	'(?+1)', note => 'Recurse to next capture' );
m_call(	perl_version_introduced => '5.009005' );
m_call(	perl_version_removed	=> undef );
token(	'(?-1)', note => 'Recurse to previous capture' );
m_call(	perl_version_introduced => '5.009005' );
m_call(	perl_version_removed	=> undef );
token(	'(?R)', note => 'Recurse to beginning of pattern' );
m_call(	perl_version_introduced => '5.009005' );
m_call(	perl_version_removed	=> undef );
token(	'(?&foo)', note => 'Recurse to named capture <foo>' );
m_call(	perl_version_introduced => '5.009005' );
m_call(	perl_version_removed	=> undef );
token(	'(?P>foo)',
    note => 'Recurse to named capture <foo>, PCRE/Python syntax' );
m_call(	perl_version_introduced => '5.009005' );
m_call(	perl_version_removed	=> undef );

# PPIx::Regexp::Token::Reference( is the parent of
# PPIx::Regexp::Token::Backreference, PPIx::Regexp::Token::Condition,
# and( PPIX::Regexp::Token::Recursion. It has no separate tests.

klass(	'PPIx::Regexp::Token::Structure', report => 0 );
token(	'(' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	')' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'[' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	']' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'{' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::Structure', note => 'Quantifier' );
token(	'}',	is_quantifier => 1, note => 'Explicit quantifier',
    text => '{n} or {n,m}' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::Structure', note => 'Perl operator' );
token(	'm', note => 'Match', text => 'm//' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	's', note => 'Substitute', text => 's///' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );
token(	'qr', note => 'Regexp constructor', text => 'qr{}' );
m_call(	perl_version_introduced => '5.005', note => 'perl5005delta' );
m_call(	perl_version_removed	=> undef );
# TODO( if the quantifier {m,n} gets forms that are only legal for
# certain( Perls, things may get sticky, but at the token level '}' is
# the( one marked as a quantifier, so here's the starting point.

klass(	'PPIx::Regexp::Token::Whitespace', note => 'White space' );
token(	' ', note => 'Not significant under /x' );
m_call(	perl_version_introduced => MINIMUM_PERL, note => '5.3.7 perlre' );
m_call(	perl_version_removed	=> undef );

# RT( #91798. The following was implemented prematurely. What happened in
# 5.17.9( was not the recognition of non-ASCII spaces, but the
# requirement( that they be escaped, so they could be recognized
# eventually.
# The( non-ASCII white space was finally introduced in 5.21.1.

SKIP: {
    SUFFICIENT_UTF8_SUPPORT_FOR_WEIRD_DELIMITERS
	or skip 'Weird delimiters test requires Perl 5.8.3 or above', 3;

    # The( following eval is to hide the construct from Perl 5.6, which
    # does( not understand \N{...}.
    token(	eval q<" \\N{U+0085}">,	## no critic (ProhibitStringyEval)
		note	=> 'Non-ASCII space' );
    m_call(	perl_version_introduced	=> '5.021001', note => 'perl5179delta' );
    m_call(	perl_version_removed	=> undef );
}

klass(   'PPIx::Regexp::Token::Structure', note => 'Regex set' );
token(   '(?[' );
m_call(  perl_version_introduced => '5.017008', note => 'perl5178delta' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::Modifier', note => 'Non-capturing parens' );
token(	'n' );
m_call(	perl_version_introduced => '5.021008', note => 'perl5218delta' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::GroupType::Script_Run',
    note	=> 'All characters must be in same script' );
token(	'+script_run:' );
m_call(	perl_version_introduced	=> '5.027008', note => 'perl5278delta' );
m_call(	perl_version_removed	=> '5.027009' );
token(	'*script_run:' );
m_call(	perl_version_introduced	=> '5.027009', note => 'perl5279delta' );
m_call(	perl_version_removed	=> undef );
token(	'*sr:' );
m_call(	perl_version_introduced	=> '5.027009', note => 'perl5279delta' );
m_call(	perl_version_removed	=> undef );

klass(	'PPIx::Regexp::Token::GroupType::Atomic_Script_Run',
    note	=> 'All characters must be in same script, atomic version' );
token(	'*atomic_script_run:' );
m_call(	perl_version_introduced	=> '5.027009', note => 'perl5279delta' );
m_call(	perl_version_removed	=> undef );
token(	'*asr:' );
m_call(	perl_version_introduced	=> '5.027009', note => 'perl5279delta' );
m_call(	perl_version_removed	=> undef );

{
    note <<'EOD';

Test thing that can not be done using the version-testing framework
because they are too dependent on context.

EOD
    foreach my $test (
	[ '(?=f?)',	'5.000', undef, 'Variable-length look-ahead' ],
	[ '(?=f{1,2})',	'5.000', undef, 'Variable-length look-ahead' ],
	[ '(?<=f?)',	'5.029009', undef, 'Variable-length look-behind' ],
	[ '(?<=f{1,2})',	'5.029009', undef,
	    'Variable-length look-behind' ],
	[ '(?<=a|bc)',	'5.029009', undef, 'Variable-length look-behind' ],
	[ '(?<=$foo|$bar)',	'5.000', undef,
	    'Indeterminite-length look-behind' ],
	[ '(?(?=(?=x)x)\K)', '5.009005', undef, '\K not really in look-ahead' ],
	[ '(?(?=(?=x)x\K))', '5.009005', '5.031003', '\K nested one deep' ],
	[ '(?(?=(?=x\K)x))', '5.009005', '5.031003', '\K nested two deep' ],
	[ 'x{0,3}',	'5.000', undef, 'Quantifier {0,3}' ],
	[ 'x{,3}',	'5.033006', undef, 'Quantifier {,3}' ],
	[ 'x{ 0 , 3 }',	'5.033006', undef, 'Quantifier { 0 , 3 }' ],
    ) {
	my $re = "/$test->[0]/";
	my $pre = PPIx::Regexp->new( $re );
	is $pre->perl_version_introduced(), $test->[1],
	    "$test->[3] $re introduced in $test->[1]";
	is $pre->perl_version_removed(), $test->[2],
	    "$test->[3] $re @{[
		defined $test->[2] ?
		qq|removed in $test->[2]| : 'never removed' ]}";
    }
}

finis();

my $context;
my @report_info;

BEGIN {
    $context = {};
}

sub klass {
    my ( $class, %args ) = @_;
    $args{class} = $class;
    $context = undef;
    my $title = "require $class";
    if ( eval "require $class; 1" ) {
	$context->{class} = \%args;
	$REPORT
	    and return;
	@_ = ( $title );
	goto &pass;
    } else {
	$REPORT
	    and die $title;
	@_ = ( "$title: $@" );
	goto &fail;
    }
}

sub _dor {	# Because we do not require 5.010.
    my ( @args ) = @_;
    foreach my $arg ( @args ) {
	defined $arg
	    and return $arg;
    }
    return undef;	# Yes, I want this in array context.
}

{
    my $csv;

    sub _report {
	my ( @args ) = @_;

	if ( ! $csv ) {
	    require Text::CSV;
	    $csv = Text::CSV->new();

	    $csv->combine(
		'Kind', 'Token', 'Descr', 'Introduced', 'Ref',
		'Removed', 'Ref' )
		or die 'Invalid CSV input: ', $csv->error_input();
	    print $csv->string(), "\n";
	}

	$csv->combine( @args )
	    or die 'Invalid CSV input: ', $csv->error_input();
	print $csv->string(), "\n";

	return;
    }
}

sub finis {
    $REPORT
	or goto &done_testing;

    foreach my $item ( @report_info ) {
	my @data = (
	    _dor( $item->{class}{note}, $item->{class}{class} ),
	    _dor( $item->{token}{text}, $item->{token}{content} ),
	    _dor( $item->{token}{note}, '' ),
	);
	foreach my $method ( qw{ perl_version_introduced
	    perl_version_removed } ) {
	    if ( $item->{$method} ) {
		push @data,
		_dor( $item->{$method}{got}, '' ),
		_dor( $item->{$method}{note}, '' );
	    } else {
		push @data, '', '';
	    }
	}
	while ( @data && '' eq $data[-1] ) {
	    pop @data;
	}

	_report( @data );
    }
    return;
}

{

    my %annotate;

    BEGIN {

	%annotate = map { $_ => 1 } qw{
	    perl_version_introduced
	    perl_version_removed
	};

    }

    sub m_call {
	my ( $method, @args ) = @_;

	my ( %info, $kind, $want );

	if ( $annotate{$method} ) {
	    $kind = $1;
	    $want = shift @args;
	    %info = @args;
	    @args = ();
	} else {
	    $want = pop @args;
	}

	SKIP: {
	    defined $context->{object}
		or skip 'No object defined', 1;

	    my $argtxt = @args ? ' ' . join( ', ', map { "'$_'" } @args
		) . ' ' : '';
	    my $title;
	    if ( defined $want ) {
		$title = "$method($argtxt) is '$want'";
	    } else {
		$title = "$method($argtxt) is undef";
	    }
	    my $got;
	    eval {
		$got = $context->{object}->$method( @args );
		1;
	    } or do {
		$title .= ": $@";
		chomp $title;
		$REPORT
		    and die $title;
		@_ = ( $title );
		goto &fail;
	    };

	    $info{got} = $got;
	    $context->{$method} = \%info;

	    $REPORT
		and return;

	    @_ = ( $got, $want, $title );
	    goto &is;

	}
    }

}

sub token {
    my ( $content, %args ) = @_;

    SKIP: {
	defined $context->{class}
	    or skip 'No class defined', 1;

	my $previous = $context->{object}
	    or delete $args{previous};

	$context = {
	    class	=> $context->{class},
	    token	=> {
		content	=> $content,
		note	=> delete $args{note},
	    },
	};

	my $text = exists $args{text} ? delete $args{text} :
	    exists $context->{class}{text} ?
		sprintf $context->{class}{text}, $content :
		undef;

	defined $text
	    and $context->{token}{text} = $text;

	my $report = exists $args{report} ? delete $args{report} :
	    exists $context->{class}{report} ? $context->{class}{report} :
	    1;

	$REPORT
	    and $report
	    and push @report_info, $context;

	my $class = defined $args{class} ? $args{class} :
	    $context->{class}{class};
	my $title = sprintf 'Instantiate %s with %s', $class,
	    defined $content ? "'$content'" : '()';
	$args{previous}
	    and $title .= sprintf q< preceded by '%s'>,
		$previous->content();

	if ( eval {
		my $tokenizer = PPIx::Regexp::Tokenizer->new(
		    $content || '',
		);
		if ( my $code = $class->can( '__make_group_type_matcher' ) ) {
		    foreach my $matcher ( @{ $code->( $class )->{''} } ) {
			$tokenizer->find_regexp( $matcher )
			    and last;
		    }
		}

		if ( my $cookie = delete $args{cookie} ) {
		    $tokenizer->cookie( $cookie => sub { 1 } );
		}
		my $obj = $class->__new(
		    defined $content ? $content : (),
		    $class->isa( 'PPIx::Regexp::Token' ) ?
			( tokenizer => $tokenizer ) :
			(),
		);
		if ( delete $args{previous} ) {
		    require PPIx::Regexp::Node;
		    $context->{parent} = PPIx::Regexp::Node->__new(
			$previous, $obj );
		}
		if ( my $main = delete $args{main} ) {
		    if ( HASH_REF eq ref $main ) {
			$main = { %{ $main } };	# Shallow clone
		    } else {
			$main = {
			    start	=> $main,
			    finish	=> $main,
			};
		    }
		    foreach my $key ( qw{ start finish } ) {
			blessed( $main->{$key} )
			    and next;
			require PPIx::Regexp::Token::Literal;
			$main->{$key} =
			PPIx::Regexp::Token::Literal->__new(
			    $main->{$key} );
		    }
		    my $class = delete $main->{class} ||
			'PPIx::Regexp::Structure::Regexp';
		    eval "require $class; 1"
			or die "Failed to require $class: $@";
		    $context->{main} = $class->__new( $main, $obj );
		}
		$context->{object} = $obj;
	    } ) {
	    while ( my ( $name, $val ) = each %args ) {
		$context->{object}{$name} = $val;
	    }
	    $REPORT
		and return;
	    @_ = ( $title );
	    goto &pass;
	} else {
	    $title .= ": $@";
	    chomp $title;
	    $REPORT
		and die $title;
	    @_ = ( $title );
	    goto &fail;
	}
    }
}

1;

__END__

# ex: set textwidth=72 :