Skip to content
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
23 changes: 23 additions & 0 deletions lib/Regexp/Parser/Objects.pm
Original file line number Diff line number Diff line change
Expand Up @@ -324,6 +324,14 @@
vis => $vis,
}, $class;
}

sub qr {
my $self = shift;
if ($self->{vis} =~ /^\\N\{/) {
return sprintf("\\x{%X}", ord($self->{data}));
}
$self->visual;
}
}


Expand Down Expand Up @@ -615,6 +623,21 @@
join "", @{ $self->{vis} };
}

sub qr {
my $self = shift;
my @parts;
for my $i (0 .. $#{$self->{vis}}) {
if ($self->{vis}[$i] =~ /^\\N\{/) {
# \N{NAME} must be resolved by the lexer — emit hex escape for portability
push @parts, sprintf("\\x{%X}", ord($self->{data}[$i]));
}
else {
push @parts, $self->{vis}[$i];
}
}
join "", @parts;
}

sub type {
my $self = shift;
$self->{flags} & $self->{rx}->FLAG_i ? "exactf" : "exact";
Expand Down
23 changes: 22 additions & 1 deletion t/99misc.t
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@
use strict;
use warnings;

use Test::More tests => 4;
use Test::More tests => 10;

use Regexp::Parser;

Expand All @@ -25,3 +25,24 @@ ok( $r->root->[0]->data, "r" );
$r = Regexp::Parser->new('[[:alpha:]]');
is($r->visual(), '[[:alpha:]]', "[[:alpha:]]");

# qr() portability: \N{NAME} should emit hex escapes, not \N{NAME} form
# (Perl's regex engine requires \N{NAME} to be resolved by the lexer,
# so runtime-compiled qr// patterns must use a portable representation)
$r = Regexp::Parser->new;
$r->regex('\N{LATIN SMALL LETTER A}');
my $qr_str = $r->root->[0]->qr;
like($qr_str, qr/\\x\{61\}/i, 'qr() for \\N{NAME} emits hex escape');
unlike($qr_str, qr/\\N\{/, 'qr() for \\N{NAME} does not emit \\N{NAME}');

# Verify the qr// actually compiles and matches
my $qr = eval { $r->qr };
ok(!$@, 'qr() with \\N{NAME} compiles without error');
ok('a' =~ $qr, 'qr() with \\N{NAME} matches correctly');

# \N{NAME} inside character class
$r = Regexp::Parser->new;
$r->regex('[\N{LATIN SMALL LETTER B}]');
my $cc_qr = eval { $r->qr };
ok(!$@, 'qr() with \\N{NAME} in char class compiles');
ok('b' =~ $cc_qr, 'qr() with \\N{NAME} in char class matches');

Loading