Add support for new octal number syntax

since v5.34 Perl also supports octal number in form 0o0
Perl-Critic · Feb 24, 2024 · 69abdea · 69abdea
1 parent e527641
commit 69abdea
Show file tree

Hide file tree

Showing 3 changed files with 23 additions and 1 deletion.
diff --git a/lib/PPI/Token/Number.pm b/lib/PPI/Token/Number.pm
@@ -94,6 +94,9 @@ sub __TOKENIZER__on_char {
 		} elsif ( $char eq 'b' || $char eq 'B' ) {
 			$t->{class} = $t->{token}->set_class( 'Number::Binary' );
 			return 1;
+		} elsif ( $char eq 'o' || $char eq 'O' ) {
+			$t->{class} = $t->{token}->set_class( 'Number::Octal' );
+			return 1;
 		} elsif ( $char =~ /\d/ ) {
 			# You cannot have 8s and 9s on octals
 			if ( $char eq '8' or $char eq '9' ) {

diff --git a/lib/PPI/Token/Number/Octal.pm b/lib/PPI/Token/Number/Octal.pm
@@ -55,6 +55,8 @@ sub literal {
 	my $self = shift;
 	return if $self->{_error};
 	my $str = $self->_literal;
+	# oct supports '0o' notation only since 5.34
+	$str =~ s (^0[oO]) (0);
 	my $neg = $str =~ s/^\-//;
 	my $val = oct $str;
 	return $neg ? -$val : $val;

diff --git a/t/07_token.t b/t/07_token.t
@@ -8,7 +8,7 @@ sub dies_on_incomplete_bx { $] >= 5.031002 }
 use if !(-e 'META.yml'), "Test::InDistDir";
 use lib 't/lib';
 use PPI::Test::pragmas;
-use Test::More tests => 588 + (warns_on_misplaced_underscore() ? 2 : 0 ) + ($ENV{AUTHOR_TESTING} ? 1 : 0);
+use Test::More tests => 594 + (warns_on_misplaced_underscore() ? 2 : 0 ) + ($ENV{AUTHOR_TESTING} ? 1 : 0);
 
 use File::Spec::Functions qw( catdir );
 use PPI ();
@@ -212,3 +212,20 @@ HEX: {
                 is($token->literal, $test->{value}, "literal('$code') is $test->{value}");
 	}
 }
+
+OCTAL: {
+	my @tests = (
+		{ code => '0o10', parsed => '0o10', value => 8 },
+		{ code => '0O10', parsed => '0O10', value => 8 },
+	);
+
+	foreach my $test ( @tests ) {
+		my $code = $test->{code};
+		my $T = PPI::Tokenizer->new( \$code );
+		my $token = $T->get_token;
+
+		isa_ok($token, 'PPI::Token::Number::Octal');
+		is($token->content, $test->{parsed}, "correctly parsed everything expected");
+		is($token->literal, $test->{value}, "literal('$code') is $test->{value}");
+	}
+}