1package main;
2
3use 5.006;
4
5use strict;
6use warnings;
7
8use PPIx::QuoteLike;
9use PPIx::QuoteLike::Constant qw{
10    SUFFICIENT_UTF8_SUPPORT_FOR_WEIRD_DELIMITERS
11};
12use PPIx::QuoteLike::Token::Control;
13use PPIx::QuoteLike::Token::Delimiter;
14use PPIx::QuoteLike::Token::Interpolation;
15use PPIx::QuoteLike::Token::String;
16
17use Test::More 0.88;	# Because of done_testing();
18
19# NOTE we use this circumlocution to hide the :encoding() from
20# xt/author/minimum_perl.t and Perl::MinimumVersion. The two-argument
21# binmode itself is OK under Perl 5.6 but the :encoding() is not. But if
22# we're 5.6 then SUFFICIENT_UTF8_SUPPORT_FOR_WEIRD_DELIMITERS is false,
23# so the binmode() never gets executed.
24use constant OUTPUT_ENCODING	=> ':encoding(utf-8)';
25
26if ( SUFFICIENT_UTF8_SUPPORT_FOR_WEIRD_DELIMITERS ) {
27    my $builder = Test::More->builder();
28    foreach my $method ( qw{ output failure_output todo_output } ) {
29	my $handle = $builder->$method();
30	binmode $handle, OUTPUT_ENCODING;
31    }
32}
33
34use charnames qw{ :full };
35
36my $tok;
37
38$tok = PPIx::QuoteLike::Token::String->__new( content => 'foo' );
39is $tok->perl_version_introduced(), '5.000',
40    'String was introduced in 5.0';
41is $tok->perl_version_removed(), undef, 'String is still here';
42
43$tok = PPIx::QuoteLike::Token::Control->__new( content => '\U' );
44is $tok->perl_version_introduced(), '5.000',
45    '\\U was introduced in 5.0';
46is $tok->perl_version_removed(), undef, '\\U is still here';
47
48$tok = PPIx::QuoteLike::Token::Control->__new( content => '\F' );
49is $tok->perl_version_introduced(), '5.015008',
50    '\\F was introduced in 5.15.8';
51is $tok->perl_version_removed(), undef, '\\F is still here';
52
53$tok = PPIx::QuoteLike::Token::Delimiter->__new( content => q<'> );
54is $tok->perl_version_introduced(), '5.000',
55    q{Delimiter q<'> was introduced in 5.0};
56is $tok->perl_version_removed(), undef, q{Delimiter q<'> is still here};
57
58SKIP: {
59    SUFFICIENT_UTF8_SUPPORT_FOR_WEIRD_DELIMITERS
60	or skip 'Weird delimiters test requires Perl 5.8.3 or above', 2;
61
62    $tok = PPIx::QuoteLike::Token::Delimiter->__new( content =>
63	qq<\N{COMBINING CIRCUMFLEX ACCENT}> );
64    is $tok->perl_version_introduced(), '5.008003',
65	q[Delimiter qq<\N{COMBINING CIRCUMFLEX ACCENT}> was introduced in 5.8.3 (kinda)];
66    is $tok->perl_version_removed(), '5.029',
67	q[Delimiter qq<\N{COMBINING CIRCUMFLEX ACCENT}> removed in 5.029];
68}
69
70SKIP: {
71    SUFFICIENT_UTF8_SUPPORT_FOR_WEIRD_DELIMITERS
72	or skip 'Truly weird delimiters test requires Perl 5.8.3 or above', 2;
73
74    $ENV{AUTHOR_TESTING}
75	or skip 'Truly weird delimiters are noisy, therefore author tests', 2;
76
77    no warnings qw{ utf8 };	# Because of truly weird characters
78
79    $tok = PPIx::QuoteLike::Token::Delimiter->__new( content =>
80	qq<\N{U+FFFE}> );	# permanent noncharacter
81    is $tok->perl_version_introduced(), '5.008003',
82	q[Delimiter qq<\N{U+FFFE}> was introduced in 5.8.3 (kinda)];
83    is $tok->perl_version_removed(), undef,
84	q[Delimiter qq<\N{U+FFFE}> is still here];
85
86    $tok = PPIx::QuoteLike::Token::Delimiter->__new( content =>
87	qq<\N{U+11FFFF}> );	# illegal character
88    is $tok->perl_version_introduced(), '5.008003',
89	q[Delimiter qq<\N{U+11FFFF}> was introduced in 5.8.3 (kinda)];
90    is $tok->perl_version_removed(), undef,
91	q[Delimiter qq<\N{U+11FFFF}> is still here];
92}
93
94$tok = PPIx::QuoteLike::Token::Interpolation->__new( content => '$x' );
95is $tok->perl_version_introduced(), '5.000',
96    'Interpolation was introduced in 5.0';
97is $tok->perl_version_removed(), undef, 'Interpolation is still here';
98
99$tok = PPIx::QuoteLike::Token::Interpolation->__new( content => '$x->@*' );
100is $tok->perl_version_introduced(), '5.019005',
101    'Postfix dereference was introduced in 5.19.5';
102is $tok->perl_version_removed(), undef, 'Postfix dereference is still here';
103
104my $obj;
105
106$obj = PPIx::QuoteLike->new( '"foo$bar"' );
107is $obj->perl_version_introduced(), '5.000',
108    'Double-quoted string was introduced in 5.0';
109is $obj->perl_version_removed(), undef, 'Double-quoted string is still here';
110
111$obj = PPIx::QuoteLike->new( '"foo\\F$bar"' );
112is $obj->perl_version_introduced(), '5.015008',
113    'Case-folded string was introduced in 5.15.8';
114is $obj->perl_version_removed(), undef, 'Case-folded string is still here';
115
116$obj = PPIx::QuoteLike->new( <<HERE_DOC );
117<<~'EOD'
118    How doth the little crocodile
119    Improve its shining tail
120    EOD
121HERE_DOC
122is $obj->perl_version_introduced(), '5.025007',
123    'Indented here-doc was introduced in 5.25.7';
124is $obj->perl_version_removed(), undef, 'Indented here-doc is still here';
125
126done_testing;
127
1281;
129
130# ex: set textwidth=72 :
131