diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 3265b85ded..2e647ddea4 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -6,6 +6,11 @@ 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. +- 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. - Support `sprintf` field widths up to 1,000,000 characters, including widths @@ -76,6 +81,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/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/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/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/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/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/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/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/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; 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; 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..6efbc17ea5 --- /dev/null +++ b/src/test/resources/unit/io_socketpair_send_connected.t @@ -0,0 +1,24 @@ +use strict; +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'); +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 = ''; +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;