fix: preserve localized regex capture variables

docs/about/changelog.md

@@ -4,6 +4,8 @@ Release history of PerlOnJava. See [Roadmap](roadmap.md) for future plans.
 
 ## Work in progress
 
+- Fix localization of numbered regex captures.
+- Fix IO-handle type checks and uninitialized-value warning locations.
 - Fix numeric-zero results from failed `s///` substitutions.
 - Bundle the complete CPAN `File::Path` 2.18 implementation, including modern
  `rmtree`/`remove_tree` options such as `keep_root`, `error`, `result`,

src/main/java/org/perlonjava/backend/jvm/EmitBinaryOperator.java

@@ -61,6 +61,7 @@ && switch (node.operator) {
  node.left.accept(scalarVisitor); // target - left parameter
  int intValue = Integer.parseInt(value);
  emitterVisitor.ctx.mv.visitLdcInsn(intValue);
+ ByteCodeSourceMapper.setDebugInfoLineNumber(emitterVisitor.ctx, node.left.getIndex());
  emitterVisitor.ctx.mv.visitMethodInsn(
  operatorHandler.methodType(),
  operatorHandler.className(),
@@ -225,6 +226,7 @@ && switch (node.operator) {
  emitterVisitor.ctx.javaClassInfo.releaseSpillSlot();
  }
  // stack: [left, right]
+ ByteCodeSourceMapper.setDebugInfoLineNumber(emitterVisitor.ctx, node.left.getIndex());
  emitOperator(node, emitterVisitor);
  }
 
@@ -301,6 +303,7 @@ private static void emitIntegerBinaryOperator(EmitterVisitor emitterVisitor,
  }
  default -> throw new IllegalArgumentException("not an integer binary operator: " + node.operator);
  }
+ ByteCodeSourceMapper.setDebugInfoLineNumber(emitterVisitor.ctx, node.left.getIndex());
  mv.visitMethodInsn(Opcodes.INVOKESTATIC, className, methodName,
  "(Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;)Lorg/perlonjava/runtime/runtimetypes/RuntimeScalar;",
  false);

src/main/java/org/perlonjava/runtime/perlmodule/Universal.java

@@ -302,6 +302,12 @@ public static RuntimeList isa(RuntimeArray args, int ctx) {
  case CODE:
  int blessId = ((RuntimeBase) object.value).blessId;
  if (blessId == 0) {
+ // An IO slot may arrive as a reference to its containing
+ // glob. The value itself is still Perl's implicit
+ // IO::Handle object.
+ if (RuntimeIO.getRuntimeIO(object) != null) {
+ return getScalarBoolean(argString.equals("IO::Handle")).getList();
+ }
  // Perl 5 recognises both "Regexp" (ref() spelling) and "REGEXP"
  // (internal SV type name) for isa() checks on unblessed regexes.
  // Modules like Params::Validate::PP use the uppercase form in
@@ -321,6 +327,23 @@ public static RuntimeList isa(RuntimeArray args, int ctx) {
  }
  perlClassName = NameNormalizer.getBlessStr(blessId);
  break;
+ case GLOB:
+ // IO slots such as *STDERR{IO} are represented directly as a
+ // GLOB whose value resolves to a RuntimeIO. Perl treats that
+ // PVIO value as an IO::Handle object, rather than as a typeglob.
+ RuntimeIO io = object.getRuntimeIO();
+ if (io != null) {
+ if (io.blessId == 0) {
+ return getScalarBoolean(argString.equals("IO::Handle")).getList();
+ }
+ perlClassName = NameNormalizer.getBlessStr(io.blessId);
+ break;
+ }
+ perlClassName = object.toString();
+ if (perlClassName.isEmpty()) {
+ return new RuntimeScalar(false).getList();
+ }
+ break;
  case UNDEF:
  if (object.getDefinedBoolean()) {
  perlClassName = object.toString();

src/main/java/org/perlonjava/runtime/runtimetypes/GlobalRuntimeScalar.java

@@ -55,7 +55,12 @@ public static RuntimeScalar makeLocal(String fullName) {
  DynamicVariableManager.pushLocalVariable(original);
  return original;
  }
- if (fullName.endsWith("::1")) {
+ // Numbered capture variables are magic views into the current regex
+ // state. They must stay magic while localized: replacing $2 (or a
+ // higher capture) with a normal GlobalRuntimeScalar prevents a later
+ // match from updating it. $1 was historically handled here, but the
+ // same rule applies to every non-zero numeric capture variable.
+ if (fullName.matches(".*::[1-9]\\d*")) {
  var regexVar = GlobalVariable.getGlobalVariable(fullName);
  DynamicVariableManager.pushLocalVariable(regexVar);
  return regexVar;

src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeScalar.java

@@ -847,7 +847,10 @@ public RuntimeScalar getNumberWarn(String operation) {
  }
  // Check for UNDEF and emit warning if warnings are enabled
  if (type == UNDEF) {
- WarnDie.warnWithCategory(new RuntimeScalar("Use of uninitialized value in " + operation),
+ String lexicalName = RuntimeCode.findActiveLexicalName(this);
+ WarnDie.warnWithCategory(new RuntimeScalar("Use of uninitialized value"
+ + (lexicalName == null ? "" : " " + lexicalName)
+ + " in " + operation),
  scalarEmptyString, "uninitialized");
  return scalarZero;
  }

src/test/resources/unit/examples_warning_and_io.t

@@ -0,0 +1,22 @@
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+use IO::Handle;
+
+my $stderr_io = *STDERR{IO};
+ok($stderr_io->isa('IO::Handle'), 'STDERR IO slot is an IO::Handle object');
+
+my @warnings;
+{
+ local $SIG{__WARN__} = sub { push @warnings, shift };
+ eval q{
+#line 41 "warning-site.t"
+my $x;
+$x + 1;
+};
+}
+
+is(scalar @warnings, 1, 'undefined arithmetic emits one warning');
+is($warnings[0], "Use of uninitialized value \$x in addition (+) at warning-site.t line 42.\n",
+ 'arithmetic warning names the lexical and preserves its source location');

src/test/resources/unit/localized_regex_captures.t

@@ -0,0 +1,35 @@
+use strict;
+use warnings;
+use Test::More tests => 7;
+
+'outer-one:outer-two:outer-three' =~ /(outer-one):(outer-two):(outer-three)/;
+
+{
+ local($1, $2, $3);
+ 'first-one:first-two:first-three' =~ /(first-one):(first-two):(first-three)/;
+ is("$1/$2/$3", 'first-one/first-two/first-three',
+ 'multiple localized captures receive every group');
+
+ {
+ local($1, $2, $3);
+ 'nested-one:nested-two:nested-three' =~ /(nested-one):(nested-two):(nested-three)/;
+ is("$1/$2/$3", 'nested-one/nested-two/nested-three',
+ 'nested localized captures receive every group');
+ }
+
+ is("$1/$2/$3", 'first-one/first-two/first-three',
+ 'nested localization restores the enclosing capture state');
+}
+
+is("$1/$2/$3", 'outer-one/outer-two/outer-three',
+ 'localization restores the caller capture state');
+
+my $text = '=?US-ASCII?Q?Keith_Moore?=';
+{
+ local($1, $2, $3);
+ pos($text) = 0;
+ $text =~ m{\G=\?([^?]*)\?([bq])\?([^?]+)\?=}xgi or die 'no match';
+ is($1, 'US-ASCII', 'MIME charset capture survives localization');
+ is(lc($2), 'q', 'MIME encoding capture survives localization');
+ is($3, 'Keith_Moore', 'MIME payload capture survives localization');
+}