diff --git a/docs/about/changelog.md b/docs/about/changelog.md index a7f147f083..1927c94997 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -6,6 +6,10 @@ priorities and future plans. ## Work in progress +- Preserve IO::Async thread callback results in scalar and list context on + both execution backends, and align its notifier-loop refcount expectation + with native Perl. + - Fix parsing of dense Mo::Inline expressions that use `::` as a bareword. - Preserve UTF-8 HTML octets through HTML::Parser and no-op entity decoding, diff --git a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java index c3ce53ec97..b9813e3e19 100644 --- a/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java +++ b/src/main/java/org/perlonjava/backend/bytecode/BytecodeCompiler.java @@ -7722,7 +7722,9 @@ public void visit(ListNode node) { int listReg = allocateRegister(); emit(Opcodes.CREATE_LIST); emitReg(listReg); - emit(Boolean.TRUE.equals(node.getAnnotation("forceListSnapshot")) ? -2 : 1); // count = 1 + boolean flattenRuntimeAggregate = currentCallContext == RuntimeContextType.RUNTIME; + emit((Boolean.TRUE.equals(node.getAnnotation("forceListSnapshot")) || flattenRuntimeAggregate) + ? -2 : 1); // count = 1 emitReg(elemReg); lastResultReg = listReg; return; @@ -7740,7 +7742,10 @@ public void visit(ListNode node) { int listReg = allocateRegister(); emit(Opcodes.CREATE_LIST); emitReg(listReg); - emit(node.elements.size()); // count + boolean forceListSnapshot = Boolean.TRUE.equals(node.getAnnotation("forceListSnapshot")); + boolean flattenRuntimeAggregate = currentCallContext == RuntimeContextType.RUNTIME; + emit((forceListSnapshot || flattenRuntimeAggregate) + ? -node.elements.size() - 1 : node.elements.size()); // Emit register numbers for each element for (int elemReg : elementRegs) { diff --git a/src/main/java/org/perlonjava/backend/jvm/EmitLiteral.java b/src/main/java/org/perlonjava/backend/jvm/EmitLiteral.java index e8fa6723fe..0f65ebf208 100644 --- a/src/main/java/org/perlonjava/backend/jvm/EmitLiteral.java +++ b/src/main/java/org/perlonjava/backend/jvm/EmitLiteral.java @@ -530,6 +530,12 @@ public static void emitList(EmitterVisitor emitterVisitor, ListNode node) { if (forceListSnapshot) { mv.visitMethodInsn(Opcodes.INVOKEVIRTUAL, RuntimeDescriptorConstants.LIST_CLASS, "addSnapshot", "(" + RuntimeDescriptorConstants.BASE_TYPE + ")V", false); + } else if (contextType == RuntimeContextType.RUNTIME) { + // A dynamic-context aggregate is scalarized by its emitter for + // scalar callers and remains an aggregate for list callers. + // Expand the latter here without re-evaluating the expression. + mv.visitMethodInsn(Opcodes.INVOKEVIRTUAL, RuntimeDescriptorConstants.LIST_CLASS, + "addFlattened", "(" + RuntimeDescriptorConstants.BASE_TYPE + ")V", false); } else { addElementToList(mv, element, contextType); } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeList.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeList.java index 6ba8360cc8..c896108ae7 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeList.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeList.java @@ -147,6 +147,24 @@ public void add(RuntimeBase value) { } } + /** + * Adds a value using Perl list-context expansion rules. + * + *

Most callers already receive a {@code RuntimeList} for a list-valued + * expression. A dynamically-contextual array or hash is different: in + * scalar context it has already become its count, while in list context it + * remains an aggregate. Expand that aggregate here so a surrounding list + * literal preserves the caller's context without evaluating the expression + * twice.

+ */ + public void addFlattened(RuntimeBase value) { + if (value instanceof RuntimeArray || value instanceof RuntimeHash) { + add(value.getList()); + } else { + add(value); + } + } + public void add(RuntimeScalar value) { this.elements.add(value); } diff --git a/src/main/perl/lib/PerlOnJava/CpanPatches/IO-Async-0.805/SkipUnsupportedSocketTests.patch b/src/main/perl/lib/PerlOnJava/CpanPatches/IO-Async-0.805/SkipUnsupportedSocketTests.patch index 8f1ad39c1b..74a05c8333 100644 --- a/src/main/perl/lib/PerlOnJava/CpanPatches/IO-Async-0.805/SkipUnsupportedSocketTests.patch +++ b/src/main/perl/lib/PerlOnJava/CpanPatches/IO-Async-0.805/SkipUnsupportedSocketTests.patch @@ -16,12 +16,7 @@ } -is_refcount( $loop, 2, '$loop has refcount 2 finally' ); -+if( defined &Internals::jperl_refstate_str ) { -+ is_refcount( $loop, 3, '$loop has PerlOnJava notifier owner finally' ); -+} -+else { -+ is_refcount( $loop, 2, '$loop has refcount 2 finally' ); -+} ++is_refcount( $loop, 2, '$loop has refcount 2 finally' ); done_testing; --- t/10loop-poll-io.t.orig diff --git a/src/test/resources/unit/threads_captured_callback_context.t b/src/test/resources/unit/threads_captured_callback_context.t new file mode 100644 index 0000000000..dd18287eba --- /dev/null +++ b/src/test/resources/unit/threads_captured_callback_context.t @@ -0,0 +1,44 @@ +use strict; +use warnings; +use threads; + +print "1..3\n"; +my $number = 0; +sub check { + my ($condition, $name) = @_; + ++$number; + print($condition ? "ok " : "not ok ", $number, " - ", $name, "\n"); +} + +# IO::Async::Loop->create_thread() wraps a captured callback in a new +# ithread, calls it in the requested context, and forwards the joined values +# to another callback. Keep this project-owned form dependency-free while +# exercising the same runtime path. +sub invoke_in_thread { + my ($code, $context, $on_joined) = @_; + my ($thread) = threads->create(sub { + my (@result, $died); + eval { + $context eq 'list' ? (@result = $code->()) : ($result[0] = $code->()); + 1; + } or $died = $@; + return died => $died if $died; + return return => @result; + }); + $on_joined->($thread->join); +} + +my @scalar; +invoke_in_thread(sub { return 'A result' }, 'scalar', sub { @scalar = @_ }); +check(join(',', @scalar) eq 'return,A result', + 'captured callback scalar result reaches joined callback'); + +my @list; +invoke_in_thread(sub { return 'A result', 'of many', 'values' }, 'list', sub { @list = @_ }); +check(join(',', @list) eq 'return,A result,of many,values', + 'captured callback list result reaches joined callback'); + +my @died; +invoke_in_thread(sub { die "expected failure\n" }, 'scalar', sub { @died = @_ }); +check($died[0] eq 'died' && $died[1] =~ /expected failure/, + 'captured callback exception reaches joined callback');