From 591dd6b6181a6e18ac6f9b3b49bca8c09a3d537b Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Wed, 7 Oct 2026 22:48:34 +0200 Subject: [PATCH 1/5] fix: forward child parameters through generated class constructors Filter named arguments passed from a generated child constructor to its generated parent constructor, while retaining the child's arguments for its own fields. Preserve all arguments for custom parent constructors and track constructor metadata with runtime snapshots. Closes #1638 Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex <158243242+chatgpt-codex@users.noreply.github.com> --- docs/about/changelog.md | 2 + .../frontend/parser/ClassTransformer.java | 39 +++++++++++++++++-- .../frontend/parser/FieldParser.java | 1 + .../frontend/parser/FieldRegistry.java | 17 ++++++++ .../frontend/parser/SpecialBlockParser.java | 1 + .../frontend/parser/SubroutineParser.java | 7 ++++ .../runtimetypes/GlobalRuntimeState.java | 11 ++++++ ...s_inherited_generated_constructor_params.t | 29 ++++++++++++++ 8 files changed, 104 insertions(+), 3 deletions(-) create mode 100644 src/test/resources/unit/class_inherited_generated_constructor_params.t diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 3265b85ded..d6bf700690 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -76,6 +76,8 @@ priorities and future plans. representation for case-folded negated singleton regex classes. - Remove deleted package stashes from their parent namespace in `Symbol::delete_package`. +- Forward only parent-declared named parameters to generated parent class + constructors, preserving child fields and validation across inheritance. - Preserve direct-call semantics for lexical and package `->&` methods across both backends, support `CORE::bless` and `CORE::break` code references, and allow same-finally local `goto` targets. diff --git a/src/main/java/org/perlonjava/frontend/parser/ClassTransformer.java b/src/main/java/org/perlonjava/frontend/parser/ClassTransformer.java index 37062940fc..840ca157eb 100644 --- a/src/main/java/org/perlonjava/frontend/parser/ClassTransformer.java +++ b/src/main/java/org/perlonjava/frontend/parser/ClassTransformer.java @@ -160,9 +160,12 @@ public static BlockNode transformClassBlock(BlockNode block, String className, P // Generate constructor if not present if (existingConstructor == null) { + FieldRegistry.registerGeneratedConstructor(className); SubroutineNode constructor = generateConstructor(fields, className, adjustNodes); block.elements.add(constructor); block.setAnnotation("deferredConstructor", constructor); + } else { + FieldRegistry.unregisterGeneratedConstructor(className); } // Generate reader and writer methods @@ -340,14 +343,44 @@ private static SubroutineNode generateConstructor(List fields, Str Node selfValue; if (parentClass != null) { - // Call SUPER::new() to get the blessed object with parent fields initialized - // my $self = $class->SUPER::new(%args); + // A generated parent constructor validates only parameters declared + // on that parent and its ancestors. Pass it that subset so a child + // field parameter is not rejected before this constructor initializes + // it. Preserve all arguments for a user-defined parent constructor. + String parentArgumentVariable = "args"; + if (FieldRegistry.hasGeneratedConstructor(parentClass)) { + parentArgumentVariable = "parentArgs"; + OperatorNode parentArgs = new OperatorNode("my", + new OperatorNode("%", new IdentifierNode(parentArgumentVariable, 0), 0), 0); + ((OperatorNode) parentArgs.operand).setAnnotation("reuseBytecodeLexicalRegister", Boolean.TRUE); + body.elements.add(parentArgs); + for (String parameterName : FieldRegistry.getParameterNamesInHierarchy(parentClass)) { + OperatorNode argsForExists = new OperatorNode("$", new IdentifierNode("args", 0), 0); + HashLiteralNode existsKey = new HashLiteralNode( + List.of(new StringNode(parameterName, 0)), 0); + OperatorNode exists = new OperatorNode("exists", + new ListNode(List.of(new BinaryOperatorNode("{", argsForExists, existsKey, 0)), 0), 0); + OperatorNode parentArgsForWrite = new OperatorNode("$", + new IdentifierNode(parentArgumentVariable, 0), 0); + HashLiteralNode writeKey = new HashLiteralNode( + List.of(new StringNode(parameterName, 0)), 0); + BinaryOperatorNode write = new BinaryOperatorNode("=", + new BinaryOperatorNode("{", parentArgsForWrite, writeKey, 0), + new BinaryOperatorNode("{", new OperatorNode("$", new IdentifierNode("args", 0), 0), + new HashLiteralNode(List.of(new StringNode(parameterName, 0)), 0), 0), 0); + body.elements.add(new IfNode("if", exists, + new BlockNode(new ArrayList<>(List.of(write)), 0), null, 0)); + } + } + + // Call SUPER::new() to get the blessed object with parent fields initialized. + // The child's own %args remains intact for its field initialization. OperatorNode classVar = new OperatorNode("$", new IdentifierNode("class", 0), 0); // Create SUPER::new as a method call // First create the method name with arguments ListNode methodArgs = new ListNode(0); - methodArgs.elements.add(new OperatorNode("%", new IdentifierNode("args", 0), 0)); + methodArgs.elements.add(new OperatorNode("%", new IdentifierNode(parentArgumentVariable, 0), 0)); // Create SUPER::new(args) as a subroutine call OperatorNode superNewCall = new OperatorNode("&", diff --git a/src/main/java/org/perlonjava/frontend/parser/FieldParser.java b/src/main/java/org/perlonjava/frontend/parser/FieldParser.java index a0384579ca..698f314581 100644 --- a/src/main/java/org/perlonjava/frontend/parser/FieldParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/FieldParser.java @@ -173,6 +173,7 @@ public static Node parseFieldDeclaration(Parser parser) { List fields = parser.unitClassFields.computeIfAbsent( currentClass, ignored -> new java.util.ArrayList<>()); fields.add(fieldPlaceholder); + FieldRegistry.registerGeneratedConstructor(currentClass); SubroutineNode constructor = ClassTransformer.generateUnitClassConstructor(fields, currentClass); SubroutineParser.handleNamedSubWithFilter(parser, constructor.name, constructor.prototype, constructor.attributes, (org.perlonjava.frontend.astnode.BlockNode) constructor.block, diff --git a/src/main/java/org/perlonjava/frontend/parser/FieldRegistry.java b/src/main/java/org/perlonjava/frontend/parser/FieldRegistry.java index 3c7ed7a0db..a250cc6007 100644 --- a/src/main/java/org/perlonjava/frontend/parser/FieldRegistry.java +++ b/src/main/java/org/perlonjava/frontend/parser/FieldRegistry.java @@ -26,6 +26,10 @@ private static Map> classParameters() { return PerlRuntime.current().globalState().classParameters(); } + private static Set generatedConstructors() { + return PerlRuntime.current().globalState().generatedClassConstructors(); + } + /** * Register a field declaration in a class */ @@ -70,6 +74,18 @@ public static void registerParameterName(String className, String parameterName) classParameters().computeIfAbsent(className, ignored -> new HashSet<>()).add(parameterName); } + public static void registerGeneratedConstructor(String className) { + generatedConstructors().add(className); + } + + public static void unregisterGeneratedConstructor(String className) { + generatedConstructors().remove(className); + } + + public static boolean hasGeneratedConstructor(String className) { + return generatedConstructors().contains(className); + } + /** * Check if a field exists in the class hierarchy * This works if parent classes were parsed before child classes @@ -125,5 +141,6 @@ public static void clear() { classParents().clear(); classFields().clear(); classParameters().clear(); + generatedConstructors().clear(); } } diff --git a/src/main/java/org/perlonjava/frontend/parser/SpecialBlockParser.java b/src/main/java/org/perlonjava/frontend/parser/SpecialBlockParser.java index f1934c86d1..5fe87c3843 100644 --- a/src/main/java/org/perlonjava/frontend/parser/SpecialBlockParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/SpecialBlockParser.java @@ -204,6 +204,7 @@ static Node parseSpecialBlock(Parser parser) { adjustBlocks.add(adjustSub); List fields = parser.unitClassFields.computeIfAbsent( className, ignored -> new ArrayList<>()); + FieldRegistry.registerGeneratedConstructor(className); SubroutineNode constructor = ClassTransformer.generateUnitClassConstructor( fields, className, adjustBlocks); SubroutineParser.handleNamedSubWithFilter(parser, constructor.name, diff --git a/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java b/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java index bd08c65161..8f1c2bf4a5 100644 --- a/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java +++ b/src/main/java/org/perlonjava/frontend/parser/SubroutineParser.java @@ -1871,6 +1871,13 @@ public static ListNode handleNamedSubWithFilter(Parser parser, String subName, S // CODE-only assignment can split the two CV slots while the other // typeglob slots remain aliased. fullName = GlobalVariable.resolveCodeDefinitionGlobAlias(fullName); + if ("new".equals(subName) + && (block == null || !block.getBooleanAnnotation("generatedClassConstructor"))) { + int packageSeparator = fullName.lastIndexOf("::new"); + if (packageSeparator >= 0) { + FieldRegistry.unregisterGeneratedConstructor(fullName.substring(0, packageSeparator)); + } + } RuntimeScalar codeRef = GlobalVariable.defineGlobalCodeRef(fullName); InheritanceResolver.invalidateCache(); diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalRuntimeState.java b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalRuntimeState.java index c8d5f607a2..7aa8c4428d 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalRuntimeState.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalRuntimeState.java @@ -61,6 +61,7 @@ public final class GlobalRuntimeState { private final Set classNames = new HashSet<>(); private final Map> classFields = new HashMap<>(); private final Map> classParameters = new HashMap<>(); + private final Set generatedClassConstructors = new HashSet<>(); private final Map classParents = new HashMap<>(); private final Map packageVersions = new HashMap<>(); private CustomClassLoader generatedClassLoader = @@ -223,6 +224,11 @@ public Map classParents() { return classParents; } + /** Classes whose {@code new} method is synthesized from their field declarations. */ + public Set generatedClassConstructors() { + return generatedClassConstructors; + } + /** Package versions visible to later compilation units in this runtime. */ public Map packageVersions() { return packageVersions; @@ -405,7 +411,9 @@ void clearDeclarationsAndPackageServices() { declaredGlobalHashes.clear(); classNames.clear(); classFields.clear(); + classParameters.clear(); classParents.clear(); + generatedClassConstructors.clear(); packageVersions.clear(); generatedClassLoader = new CustomClassLoader(GlobalVariable.class.getClassLoader()); } @@ -456,7 +464,10 @@ synchronized void snapshotInto(GlobalRuntimeState target, RuntimeGraphCloner clo target.declaredGlobalHashes.addAll(declaredGlobalHashes); target.classNames.addAll(classNames); classFields.forEach((name, fields) -> target.classFields.put(name, new HashSet<>(fields))); + classParameters.forEach((name, parameters) -> + target.classParameters.put(name, new HashSet<>(parameters))); target.classParents.putAll(classParents); + target.generatedClassConstructors.addAll(generatedClassConstructors); target.packageVersions.putAll(packageVersions); // Lazy named CVs may compile in the parent after this snapshot while // the child also compiles new code. Give every snapshot runtime its diff --git a/src/test/resources/unit/class_inherited_generated_constructor_params.t b/src/test/resources/unit/class_inherited_generated_constructor_params.t new file mode 100644 index 0000000000..1261088cd3 --- /dev/null +++ b/src/test/resources/unit/class_inherited_generated_constructor_params.t @@ -0,0 +1,29 @@ +use strict; +use warnings; +use feature 'class'; +no warnings 'experimental::class'; +use Test::More; + +class InheritedGeneratedConstructorBase { + field $base :param; + method base_value { $base } +} + +class InheritedGeneratedConstructorChild :isa(InheritedGeneratedConstructorBase) { + field $data :param; + method data_value { $data } +} + +my $child = InheritedGeneratedConstructorChild->new(base => 10, data => 20); +isa_ok($child, 'InheritedGeneratedConstructorChild', + 'child generated constructor accepts its own parameter through the parent constructor'); +is($child->base_value, 10, 'parent generated constructor initializes its parameter'); +is($child->data_value, 20, 'child generated constructor initializes its parameter'); + +my $unknown = eval { InheritedGeneratedConstructorChild->new(base => 10, data => 20, extra => 30); 1 }; +ok(!$unknown, 'the child hierarchy still rejects undeclared constructor parameters'); +like $@, + qr/^Unrecogni[sz]ed parameters for "InheritedGeneratedConstructorChild" constructor: extra at /, + 'unknown-parameter diagnostic names the child constructor'; + +done_testing; From 48069e55b30acbcb8e04a7a4d8d49b15081de696 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Thu, 8 Oct 2026 09:58:30 +0200 Subject: [PATCH 2/5] wip: snapshot IO::Async and socket regression fixes Preserve blessed IO method lookup and report native socketpair readiness and peer connectivity. Include focused regression coverage before rebasing and completing validation. Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex <158243242+chatgpt-codex@users.noreply.github.com> --- docs/about/changelog.md | 3 +++ .../runtime/io/FileDescriptorTable.java | 4 ++++ .../runtime/io/NativeSocketIOHandle.java | 8 ++++++++ .../runtime/perlmodule/Universal.java | 11 ++++++++++- .../runtime/runtimetypes/RuntimeIO.java | 7 +++++++ .../unit/io_poll_socketpair_readiness.t | 16 ++++++++++++++++ .../unit/io_socketpair_send_connected.t | 15 +++++++++++++++ .../unit/universal_blessed_socket_can.t | 18 ++++++++++++++++++ 8 files changed, 81 insertions(+), 1 deletion(-) create mode 100644 src/test/resources/unit/io_poll_socketpair_readiness.t create mode 100644 src/test/resources/unit/io_socketpair_send_connected.t create mode 100644 src/test/resources/unit/universal_blessed_socket_can.t diff --git a/docs/about/changelog.md b/docs/about/changelog.md index d6bf700690..ecfbebfbf9 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -6,6 +6,9 @@ priorities and future plans. ## Work in progress +- Preserve blessed IO classes during `can()` checks so socket-specific methods remain discoverable. +- Report native socketpair readiness from the descriptor instead of treating every event as ready. + - Autovivify undefined hash references when an element is read, including in `defined` checks. - Support `sprintf` field widths up to 1,000,000 characters, including widths diff --git a/src/main/java/org/perlonjava/runtime/io/FileDescriptorTable.java b/src/main/java/org/perlonjava/runtime/io/FileDescriptorTable.java index f839cfbbfa..03f568a2fa 100644 --- a/src/main/java/org/perlonjava/runtime/io/FileDescriptorTable.java +++ b/src/main/java/org/perlonjava/runtime/io/FileDescriptorTable.java @@ -1,5 +1,6 @@ package org.perlonjava.runtime.io; +import org.perlonjava.runtime.nativ.ffm.FFMPosix; import java.util.concurrent.ConcurrentHashMap; import java.util.concurrent.atomic.AtomicInteger; @@ -168,6 +169,9 @@ public static boolean isReadReady(IOHandle handle) { if (handle instanceof StandardIO standardIO) { return standardIO.isReadReady(); } + if (handle instanceof NativeFdIOHandle nativeFd) { + return FFMPosix.get().pollReadReady(nativeFd.getNativeFd()); + } // For unknown handle types, report as ready to avoid blocking return true; } diff --git a/src/main/java/org/perlonjava/runtime/io/NativeSocketIOHandle.java b/src/main/java/org/perlonjava/runtime/io/NativeSocketIOHandle.java index ff82ce82d6..5d9b5d14c5 100644 --- a/src/main/java/org/perlonjava/runtime/io/NativeSocketIOHandle.java +++ b/src/main/java/org/perlonjava/runtime/io/NativeSocketIOHandle.java @@ -3,6 +3,7 @@ import org.perlonjava.runtime.nativ.ffm.FFMPosix; import org.perlonjava.runtime.runtimetypes.RuntimeScalar; import org.perlonjava.runtime.runtimetypes.RuntimeScalarCache; +import java.nio.charset.StandardCharsets; /** A real POSIX socket descriptor exposed through the generic I/O layer. */ public final class NativeSocketIOHandle extends NativeFdIOHandle { @@ -15,6 +16,13 @@ public NativeSocketIOHandle(int nativeFd, int socketType) { public int socketType() { return socketType; } + /** Return the packed AF_UNIX address for an unnamed POSIX socketpair peer. */ + public RuntimeScalar getpeername() { + // POSIX socketpair() creates connected, unnamed AF_UNIX sockets. The + // sockaddr family is sufficient here; there is no pathname to append. + return new RuntimeScalar(new String(new byte[] { 0, 1 }, StandardCharsets.ISO_8859_1)); + } + @Override public RuntimeScalar shutdown(int how) { return FFMPosix.get().shutdown(getNativeFd(), how) == 0 diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Universal.java b/src/main/java/org/perlonjava/runtime/perlmodule/Universal.java index b9806aaf1d..7689ac9aee 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Universal.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Universal.java @@ -114,7 +114,16 @@ public static RuntimeList can(RuntimeArray args, int ctx) { // A bare glob and a handle bareword are both valid IO invocants in // Perl. Resolve an actual IO slot before the generic scalar path, // which would otherwise treat *STDOUT or "STDOUT" as package names. - if (RuntimeIO.getRuntimeIO(object) != null) { + RuntimeIO runtimeIO = RuntimeIO.getRuntimeIO(object); + if (runtimeIO != null && object.value instanceof RuntimeBase runtimeBase + && runtimeBase.blessId != 0) { + // Blessed socket/filehandle objects retain their Perl class even + // though their storage is backed by RuntimeIO. Resolve their + // methods from that class first (for example IO::Socket::IP's + // peerhost/peerport). + perlClassName = NameNormalizer.getBlessStr(runtimeBase.blessId); + } else if (runtimeIO != null) { + // Unblessed handles use the IO::Handle interface. perlClassName = "IO::Handle"; } else { switch (object.type) { diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeIO.java b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeIO.java index 193cabee58..2352e39a34 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeIO.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/RuntimeIO.java @@ -2152,6 +2152,13 @@ public RuntimeScalar getpeername() { if (socket != null) { return socket.getpeername(); } + IOHandle handle = ioHandle; + while (handle instanceof LayeredIOHandle layered) { + handle = layered.getDelegate(); + } + if (handle instanceof org.perlonjava.runtime.io.NativeSocketIOHandle nativeSocket) { + return nativeSocket.getpeername(); + } return scalarUndef; } diff --git a/src/test/resources/unit/io_poll_socketpair_readiness.t b/src/test/resources/unit/io_poll_socketpair_readiness.t new file mode 100644 index 0000000000..fb21c95570 --- /dev/null +++ b/src/test/resources/unit/io_poll_socketpair_readiness.t @@ -0,0 +1,16 @@ +use v5.10; +use strict; +use warnings; +use Test::More; +use IO::Poll qw(POLLIN); +use IO::Socket::UNIX; +use Socket qw(PF_UNIX SOCK_STREAM); + +my ($left, $right) = IO::Socket::UNIX->socketpair(PF_UNIX, SOCK_STREAM, 0); +plan skip_all => "UNIX socketpair is unavailable: $!" unless $left && $right; + +my $poll = IO::Poll->new; +$poll->mask($left, POLLIN); +is($poll->poll(0), 0, 'an idle socketpair endpoint is not readable'); + +done_testing; diff --git a/src/test/resources/unit/io_socketpair_send_connected.t b/src/test/resources/unit/io_socketpair_send_connected.t new file mode 100644 index 0000000000..a935e493b2 --- /dev/null +++ b/src/test/resources/unit/io_socketpair_send_connected.t @@ -0,0 +1,15 @@ +use strict; +use warnings; +use Test::More; +use IO::Socket::UNIX; +use Socket qw(PF_UNIX SOCK_STREAM); + +my ($left, $right) = IO::Socket::UNIX->socketpair(PF_UNIX, SOCK_STREAM, 0); +plan skip_all => "UNIX socketpair unavailable: $!" unless $left && $right; + +is($left->send('payload'), 7, 'send recognizes a connected socketpair'); +my $received = ''; +is($right->sysread($received, 7), 7, 'socketpair peer reads the sent bytes'); +is($received, 'payload', 'socketpair peer receives sent bytes'); + +done_testing; diff --git a/src/test/resources/unit/universal_blessed_socket_can.t b/src/test/resources/unit/universal_blessed_socket_can.t new file mode 100644 index 0000000000..ca0d06f71d --- /dev/null +++ b/src/test/resources/unit/universal_blessed_socket_can.t @@ -0,0 +1,18 @@ +use v5.10; +use strict; +use warnings; +use Test::More; +use IO::Socket::IP; + +my $listener = IO::Socket::IP->new( + LocalHost => '127.0.0.1', + LocalPort => 0, + Listen => 1, +); +plan skip_all => "could not create local listener: $!" unless $listener; + +ok($listener->can('peerhost'), 'blessed socket can find peerhost'); +ok($listener->can('peerport'), 'blessed socket can find peerport'); +ok(UNIVERSAL::can($listener, 'peerhost'), 'UNIVERSAL::can finds socket method'); + +done_testing; From 8d1540c438520023b9f5b6531475fe71adf7da3e Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Thu, 8 Oct 2026 10:51:24 +0200 Subject: [PATCH 3/5] fix: apply blocking mode to native socket handles Use F_GETFL and F_SETFL for native descriptors in IO::Handle::blocking so socketpair writes correctly reach EAGAIN. Cover the descriptor flag and connected socket send path. Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex <158243242+chatgpt-codex@users.noreply.github.com> --- docs/about/changelog.md | 1 + .../runtime/perlmodule/IOHandle.java | 22 +++++++++++++++++++ .../unit/io_socketpair_send_connected.t | 5 +++++ 3 files changed, 28 insertions(+) diff --git a/docs/about/changelog.md b/docs/about/changelog.md index ecfbebfbf9..04cc189750 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -8,6 +8,7 @@ priorities and future plans. - Preserve blessed IO classes during `can()` checks so socket-specific methods remain discoverable. - Report native socketpair readiness from the descriptor instead of treating every event as ready. +- Apply IO::Handle blocking mode changes to native descriptors so nonblocking socket writes can return EAGAIN. - Autovivify undefined hash references when an element is read, including in `defined` checks. diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/IOHandle.java b/src/main/java/org/perlonjava/runtime/perlmodule/IOHandle.java index 8f40072b0f..b3453d2e1e 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/IOHandle.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/IOHandle.java @@ -1,6 +1,8 @@ package org.perlonjava.runtime.perlmodule; import org.perlonjava.runtime.runtimetypes.*; +import org.perlonjava.runtime.io.NativeFdIOHandle; +import org.perlonjava.runtime.nativ.ffm.FFMPosix; /** * Java::System - Perl module for accessing IO::Handle internals @@ -178,6 +180,14 @@ public static RuntimeList _blocking(RuntimeArray args, int ctx) { currentBlocking = socketIO.isBlocking(); } else if (ioHandle instanceof org.perlonjava.runtime.io.InternalPipeHandle pipeHandle) { currentBlocking = pipeHandle.isBlocking(); + } else if (ioHandle instanceof NativeFdIOHandle nativeFd) { + int flags = FFMPosix.get().fcntl(nativeFd.getNativeFd(), 3, 0); // F_GETFL + if (flags == -1) { + RuntimeIO.handleIOError(FFMPosix.get().errno()); + return new RuntimeList(); + } + int nonblockFlag = org.perlonjava.runtime.nativ.NativeUtils.IS_MAC ? 4 : 04000; + currentBlocking = (flags & nonblockFlag) == 0; } if (args.size() == 2) { @@ -188,6 +198,18 @@ public static RuntimeList _blocking(RuntimeArray args, int ctx) { } else if (ioHandle instanceof org.perlonjava.runtime.io.InternalPipeHandle pipeHandle) { // For internal pipes, set blocking mode pipeHandle.setBlocking(newBlocking); + } else if (ioHandle instanceof NativeFdIOHandle nativeFd) { + int flags = FFMPosix.get().fcntl(nativeFd.getNativeFd(), 3, 0); // F_GETFL + if (flags == -1) { + RuntimeIO.handleIOError(FFMPosix.get().errno()); + return new RuntimeList(); + } + int nonblockFlag = org.perlonjava.runtime.nativ.NativeUtils.IS_MAC ? 4 : 04000; + int updatedFlags = newBlocking ? flags & ~nonblockFlag : flags | nonblockFlag; + if (FFMPosix.get().fcntl(nativeFd.getNativeFd(), 4, updatedFlags) == -1) { // F_SETFL + RuntimeIO.handleIOError(FFMPosix.get().errno()); + return new RuntimeList(); + } } else if (!newBlocking) { // Non-blocking I/O not supported for other handle types RuntimeIO.handleIOError("Non-blocking I/O not supported"); diff --git a/src/test/resources/unit/io_socketpair_send_connected.t b/src/test/resources/unit/io_socketpair_send_connected.t index a935e493b2..518ace394a 100644 --- a/src/test/resources/unit/io_socketpair_send_connected.t +++ b/src/test/resources/unit/io_socketpair_send_connected.t @@ -3,10 +3,15 @@ use warnings; use Test::More; use IO::Socket::UNIX; use Socket qw(PF_UNIX SOCK_STREAM); +use Fcntl qw(F_GETFL O_NONBLOCK); my ($left, $right) = IO::Socket::UNIX->socketpair(PF_UNIX, SOCK_STREAM, 0); plan skip_all => "UNIX socketpair unavailable: $!" unless $left && $right; +is($left->blocking(0), 1, 'blocking returns the previous socket mode'); +is($left->blocking(), 0, 'socketpair switches to nonblocking mode'); +ok(fcntl($left, F_GETFL, 0) & O_NONBLOCK, 'nonblocking mode reaches the native descriptor'); + is($left->send('payload'), 7, 'send recognizes a connected socketpair'); my $received = ''; is($right->sysread($received, 7), 7, 'socketpair peer reads the sent bytes'); From 23e93dc06d184252d788984f1a8425a512cd8120 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Thu, 8 Oct 2026 12:29:37 +0200 Subject: [PATCH 4/5] fix: retain queued IO::Async futures Keep queued IO::Async call futures alive until worker dispatch completes, register the compatibility patch in CPAN bootstrap, and document the fix. The upstream t/42function.t queue-priority case failed before the patch and passes with it applied. Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex <158243242+chatgpt-codex@users.noreply.github.com> --- docs/about/changelog.md | 1 + src/main/perl/lib/CPAN/Config.pm | 2 ++ src/main/perl/lib/PerlOnJava/CpanDistroprefs/IO-Async.yml | 1 + .../CpanPatches/IO-Async-0.805/RetainQueuedFutures.patch | 5 +++++ 4 files changed, 9 insertions(+) create mode 100644 src/main/perl/lib/PerlOnJava/CpanPatches/IO-Async-0.805/RetainQueuedFutures.patch diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 04cc189750..2e647ddea4 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -9,6 +9,7 @@ priorities and future plans. - Preserve blessed IO classes during `can()` checks so socket-specific methods remain discoverable. - Report native socketpair readiness from the descriptor instead of treating every event as ready. - Apply IO::Handle blocking mode changes to native descriptors so nonblocking socket writes can return EAGAIN. +- Retain queued IO::Async call futures until dispatch completes, preserving queued worker results. - Autovivify undefined hash references when an element is read, including in `defined` checks. diff --git a/src/main/perl/lib/CPAN/Config.pm b/src/main/perl/lib/CPAN/Config.pm index c3fbe56e02..d500d1f058 100644 --- a/src/main/perl/lib/CPAN/Config.pm +++ b/src/main/perl/lib/CPAN/Config.pm @@ -276,6 +276,8 @@ sub _bootstrap_patches { 'PerlOnJava/CpanPatches/Pod-Parser-1.67/Pod-Find-core-probe.patch' ], [ 'IO-Async/NoFork.patch', 'PerlOnJava/CpanPatches/IO-Async-0.805/NoFork.patch' ], + [ 'IO-Async/RetainQueuedFutures.patch', + 'PerlOnJava/CpanPatches/IO-Async-0.805/RetainQueuedFutures.patch' ], [ 'IO-Async/PerlOnJava.patch', 'PerlOnJava/CpanPatches/IO-Async-0.805/PerlOnJava.patch' ], [ 'IO-Async/SkipUnsupportedSocketTests.patch', diff --git a/src/main/perl/lib/PerlOnJava/CpanDistroprefs/IO-Async.yml b/src/main/perl/lib/PerlOnJava/CpanDistroprefs/IO-Async.yml index f8324cfbd1..d15c3a34dd 100644 --- a/src/main/perl/lib/PerlOnJava/CpanDistroprefs/IO-Async.yml +++ b/src/main/perl/lib/PerlOnJava/CpanDistroprefs/IO-Async.yml @@ -11,6 +11,7 @@ match: distribution: "^PEVANS/IO-Async-[0-9]" patches: - "IO-Async/NoFork.patch" + - "IO-Async/RetainQueuedFutures.patch" - "IO-Async/PerlOnJava.patch" - "IO-Async/SkipUnsupportedSocketTests.patch" test: diff --git a/src/main/perl/lib/PerlOnJava/CpanPatches/IO-Async-0.805/RetainQueuedFutures.patch b/src/main/perl/lib/PerlOnJava/CpanPatches/IO-Async-0.805/RetainQueuedFutures.patch new file mode 100644 index 0000000000..1e56aa7e67 --- /dev/null +++ b/src/main/perl/lib/PerlOnJava/CpanPatches/IO-Async-0.805/RetainQueuedFutures.patch @@ -0,0 +1,5 @@ +--- lib/IO/Async/Function.pm.orig ++++ lib/IO/Async/Function.pm +@@ -519,0 +520,2 @@ ++ # The queued call must survive until it is dispatched and completes. ++ $future->retain; From a8ecb16bdbeccb22627207e437e566c62605c9b2 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Thu, 8 Oct 2026 14:38:38 +0200 Subject: [PATCH 5/5] fix: support socket blocking mode on Windows runtime Route PerlOnJava's Windows sockets through its channel-aware blocking implementation and keep the native descriptor assertion platform-specific. Generated with [Codex](https://openai.com/codex) Co-Authored-By: Codex <158243242+chatgpt-codex@users.noreply.github.com> --- src/main/perl/lib/IO/Socket.pm | 3 ++- src/test/resources/unit/io_socketpair_send_connected.t | 6 +++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/main/perl/lib/IO/Socket.pm b/src/main/perl/lib/IO/Socket.pm index f8a0cd552c..e8332eb19c 100644 --- a/src/main/perl/lib/IO/Socket.pm +++ b/src/main/perl/lib/IO/Socket.pm @@ -175,7 +175,8 @@ sub blocking { my $sock = shift; return $sock->SUPER::blocking(@_) - if $^O ne 'MSWin32' && $^O ne 'VMS'; + if ($^O ne 'MSWin32' && $^O ne 'VMS') + || defined &Internals::jperl_refstate_str; # Windows handles blocking differently # diff --git a/src/test/resources/unit/io_socketpair_send_connected.t b/src/test/resources/unit/io_socketpair_send_connected.t index 518ace394a..6efbc17ea5 100644 --- a/src/test/resources/unit/io_socketpair_send_connected.t +++ b/src/test/resources/unit/io_socketpair_send_connected.t @@ -10,7 +10,11 @@ plan skip_all => "UNIX socketpair unavailable: $!" unless $left && $right; is($left->blocking(0), 1, 'blocking returns the previous socket mode'); is($left->blocking(), 0, 'socketpair switches to nonblocking mode'); -ok(fcntl($left, F_GETFL, 0) & O_NONBLOCK, 'nonblocking mode reaches the native descriptor'); +SKIP: { + skip 'Windows socketpair uses a Java loopback channel, not a native descriptor', 1 + if $^O eq 'MSWin32'; + ok(fcntl($left, F_GETFL, 0) & O_NONBLOCK, 'nonblocking mode reaches the native descriptor'); +} is($left->send('payload'), 7, 'send recognizes a connected socketpair'); my $received = '';