diff --git a/dev/tools/cpan_random_tester.pl b/dev/tools/cpan_random_tester.pl index 82342d0d1..c4a39719e 100644 --- a/dev/tools/cpan_random_tester.pl +++ b/dev/tools/cpan_random_tester.pl @@ -524,6 +524,13 @@ sub parse_all_module_results { next; } + if (is_perlonjava_distropref_skip_output($text)) { + $r{status} = 'SKIP'; + $r{reason} = 'distroprefs'; + push @results, \%r; + next; + } + if ($text =~ /Result: FAIL/ || $text =~ /(?:make|Build) test -- NOT OK/) { $r{status} = 'FAIL'; if ($total_tests > 0) { @@ -556,7 +563,7 @@ sub parse_all_module_results { # --- Pass 3: catch modules that never reached the test phase --- # (configure failures, build failures, etc.) - my %pending_bundled_skip; + my %pending_skip; for my $line (split /\n/, $output) { if ($line =~ /Running (?:test|install) for module '([^']+)'/) { $last_mod = $1; @@ -590,16 +597,19 @@ sub parse_all_module_results { # output shapes may omit the standard make-test block, so keep this # fallback too. Defer recording until after the scan so a later # configure/build failure still wins. - $pending_bundled_skip{$last_mod} = 1 + $pending_skip{$last_mod} = 'bundled' if $last_mod && !$seen{$last_mod} && is_bundled_skip_output($line); + + $pending_skip{$last_mod} ||= 'distroprefs' + if $last_mod && !$seen{$last_mod} && is_perlonjava_distropref_skip_output($line); } - for my $mod (sort keys %pending_bundled_skip) { + for my $mod (sort keys %pending_skip) { next if $seen{$mod}++; my %r = ( module => $mod, status => 'SKIP', tests => undef, pass_count => undef, - error => '', reason => 'bundled', + error => '', reason => $pending_skip{$mod}, ); push @results, \%r; } @@ -614,6 +624,11 @@ sub is_bundled_skip_output { return 0; } +sub is_perlonjava_distropref_skip_output { + my ($text) = @_; + return $text =~ /PERLONJAVA_SKIP -- (?:configure|make|test|install) phase skipped/ ? 1 : 0; +} + # ══════════════════════════════════════════════════════════════════════ # Helpers diff --git a/docs/guides/cpan-distroprefs.md b/docs/guides/cpan-distroprefs.md index 3c3fa9b00..870b53b8a 100644 --- a/docs/guides/cpan-distroprefs.md +++ b/docs/guides/cpan-distroprefs.md @@ -81,6 +81,18 @@ Skipping the target distribution's test phase is a last resort. If you do it, document the supported subset and keep a separate smoke test or downstream test that proves the behavior PerlOnJava claims to support. +The `jcpan` launchers export `PERLONJAVA_JCPAN_ARGS` with the CPAN arguments +after wrapper-only options such as `--jobs`. Dependency-only skips can use an +`env` `not_PERLONJAVA_JCPAN_ARGS` match to stay out of direct target runs. +For example: + +```yaml +match: + distribution: "^AUTHOR/Example-Module-" + env: + not_PERLONJAVA_JCPAN_ARGS: "(^|[[:space:]])Example::Module($|[[:space:]])" +``` + ## Basic YAML Shape A distropref should include a detailed `comment`, a narrow `match`, and only the diff --git a/jcpan b/jcpan index 65fef56f7..30a0a64e3 100755 --- a/jcpan +++ b/jcpan @@ -84,6 +84,7 @@ case "$JCPAN_BIN" in /*) ;; # already absolute *) JCPAN_BIN="$SCRIPT_DIR/jcpan" ;; esac +export PERLONJAVA_JCPAN_ARGS="${ARGS[*]}" export PATH="$SCRIPT_DIR:$PATH" exec "$SCRIPT_DIR/jperl" "$CPAN_SCRIPT" "${ARGS[@]}" diff --git a/jcpan.bat b/jcpan.bat index 457c103d5..d58531e31 100644 --- a/jcpan.bat +++ b/jcpan.bat @@ -35,5 +35,6 @@ rem etc.) can find jperl/jcpan without tokens that don't expand in rem POSIX sh. See src/main/perl/lib/CPAN/Config.pm (Moose.yml). set "JPERL_BIN=%SCRIPT_DIR%jperl.bat" set "JCPAN_BIN=%SCRIPT_DIR%jcpan.bat" +set "PERLONJAVA_JCPAN_ARGS=%JCPAN_ARGS%" set "PATH=%SCRIPT_DIR%;%PATH%" "%SCRIPT_DIR%jperl.bat" "%SCRIPT_DIR%src\main\perl\bin\cpan" %JCPAN_ARGS% diff --git a/src/main/java/org/perlonjava/app/cli/ArgumentParser.java b/src/main/java/org/perlonjava/app/cli/ArgumentParser.java index 20d1b1d36..4ab13aaa8 100644 --- a/src/main/java/org/perlonjava/app/cli/ArgumentParser.java +++ b/src/main/java/org/perlonjava/app/cli/ArgumentParser.java @@ -843,6 +843,9 @@ private static void printConfigurationInfo(String configVar, CompilerOptions par case "git_commit_date": value = Configuration.gitCommitDate; break; + case "osname": + value = SystemUtils.getPerlOsName(); + break; default: value = System.getProperty(configVar, "UNKNOWN"); } diff --git a/src/main/java/org/perlonjava/runtime/operators/IOOperator.java b/src/main/java/org/perlonjava/runtime/operators/IOOperator.java index 01aa79700..e6e2badd8 100644 --- a/src/main/java/org/perlonjava/runtime/operators/IOOperator.java +++ b/src/main/java/org/perlonjava/runtime/operators/IOOperator.java @@ -2826,8 +2826,8 @@ private static String pack(String template, int value) { /** * Find a RuntimeIO handle by its file descriptor number. - * Checks multiple registries: IOOperator's local fileDescriptorMap, standard fds, - * and the RuntimeIO fileno registry (which includes dup'd handles and sockets). + * Checks multiple registries: IOOperator's local fileDescriptorMap, the RuntimeIO + * fileno registry (which includes dup'd handles and sockets), and standard fds. */ private static RuntimeIO findFileHandleByDescriptor(int fd) { // Check if we have it in our mapping @@ -2836,7 +2836,15 @@ private static RuntimeIO findFileHandleByDescriptor(int fd) { return handle; } - // Handle standard file descriptors + // Prefer live registry entries. When fd 1 or 2 has been closed and a + // later file open reuses that number, Perl's numeric dup targets the + // new file, not the original static STDOUT/STDERR object. + RuntimeIO fromRegistry = RuntimeIO.getByFileno(fd); + if (fromRegistry != null) { + return fromRegistry; + } + + // Handle standard file descriptors if no current registry owner exists. switch (fd) { case 0: // STDIN return RuntimeIO.stdin; @@ -2845,11 +2853,6 @@ private static RuntimeIO findFileHandleByDescriptor(int fd) { case 2: // STDERR return RuntimeIO.stderr; default: - // Check the RuntimeIO fileno registry (used by all file/pipe/socket handles) - RuntimeIO fromRegistry = RuntimeIO.getByFileno(fd); - if (fromRegistry != null) { - return fromRegistry; - } return null; // Unknown file descriptor } } diff --git a/src/main/java/org/perlonjava/runtime/operators/Readline.java b/src/main/java/org/perlonjava/runtime/operators/Readline.java index cc8f2399b..3bf44549c 100644 --- a/src/main/java/org/perlonjava/runtime/operators/Readline.java +++ b/src/main/java/org/perlonjava/runtime/operators/Readline.java @@ -81,10 +81,9 @@ public static RuntimeScalar readline(RuntimeIO runtimeIO) { (rs == null && rsScalar.type == RuntimeScalarType.UNDEF); if (isSlurp) { // Match Perl's semantics: a slurp call on a fresh handle returns - // the file contents (possibly the empty string) and leaves the - // handle at EOF; the *next* call returns undef. If we are already - // at EOF on entry, this is that "next" call -> undef. - if (runtimeIO.eof().getBoolean()) { + // the file contents (possibly the empty string) even if the + // handle is positioned at EOF; the next call returns undef. + if (runtimeIO.eof().getBoolean() && runtimeIO.currentLineNumber > 0) { return scalarUndef; } StringBuilder content = new StringBuilder(); diff --git a/src/main/perl/lib/Config.pm b/src/main/perl/lib/Config.pm index 676fc3c45..38787a080 100644 --- a/src/main/perl/lib/Config.pm +++ b/src/main/perl/lib/Config.pm @@ -68,6 +68,33 @@ my $user_home = getProperty('user.home') || ''; my $user_dir = getProperty('user.dir') || ''; my $java_home = getProperty('java.home') || ''; my $user_name = getProperty('user.name') || 'unknown'; +my $perlonjava_home = $user_home + ? _catdir($file_separator, $user_home, '.perlonjava') + : '.perlonjava'; +my $core_privlib = _catdir($file_separator, $perlonjava_home, 'core', 'lib', 'perl5', '5.42.0'); +my $core_archlib = _catdir($file_separator, $core_privlib, "java-$java_version-$os_arch"); +_ensure_dir(_catdir($file_separator, $core_archlib, 'CORE')); + +sub _perl_os_name { + my ($name) = @_; + my $lc = lc($name || 'unknown'); + return 'MSWin32' if $lc =~ /^win/; + return 'darwin' if $lc =~ /^(?:mac|darwin)/; + return 'linux' if $lc =~ /(?:nix|nux|linux)/; + return 'solaris' if $lc =~ /(?:sunos|solaris)/; + return 'aix' if $lc =~ /aix/; + return 'freebsd' if $lc =~ /freebsd/; + return 'openbsd' if $lc =~ /openbsd/; + $lc =~ s/\s+//g; + return $lc; +} + +sub _perl_launcher_suffix { + my ($is_windows, $perl_path) = @_; + return '' unless $is_windows; + return lc $1 if defined($perl_path) && $perl_path =~ /(\.(?:bat|cmd|exe))\z/i; + return '.bat'; +} # Best-effort hostname; falls back to "localhost" if Java doesn't expose it. my $host_name = eval { @@ -104,9 +131,10 @@ my $system_cc = do { $found || ($is_win ? 'cl' : 'cc'); }; -# Normalize OS name -$os_name = lc($os_name); -$os_name =~ s/\s+/_/g; +# Normalize OS name to Perl's $^O conventions. +$os_name = _perl_os_name($os_name); +my $is_windows = $os_name eq 'MSWin32'; +my $perl_launcher_suffix = _perl_launcher_suffix($is_windows, $^X); # tie returns the object, so the value returned to require will be true. %Config = ( @@ -133,6 +161,8 @@ $os_name =~ s/\s+/_/g; # implement full taint checking. This allows tests that check for taint # support to skip gracefully. ccflags => '-DSILENT_NO_TAINT_SUPPORT', + ldflags => '', + lddlflags => '', optimize => '', # Library/path configuration @@ -154,9 +184,10 @@ $os_name =~ s/\s+/_/g; cf_by => $user_name, myhostname => $host_name, - # Standard Perl paths (relative to jar or filesystem) - archlibexp => 'perlonjava/lib/perl5/5.42.0/' . "java-$java_version-$os_arch", - privlibexp => 'perlonjava/lib/perl5/5.42.0', + # Standard Perl paths. The core exp paths must be real directories because + # CPAN build helpers such as ExtUtils::CBuilder probe $archlibexp/CORE. + archlibexp => $core_archlib, + privlibexp => $core_privlib, sitearchexp => 'perlonjava/lib/perl5/site_perl/5.42.0/' . "java-$java_version-$os_arch", sitelibexp => 'perlonjava/lib/perl5/site_perl/5.42.0', vendorarchexp => 'perlonjava/lib/perl5/vendor_perl/5.42.0/' . "java-$java_version-$os_arch", @@ -258,17 +289,17 @@ $os_name =~ s/\s+/_/g; # Signal handling - signal 0 is ZERO (used for process existence checks) # Note: Signal names vary by OS. This is a common POSIX subset. # The index in the space-separated list corresponds to the signal number. - sig_name => ($os_name =~ /win/ + sig_name => ($is_windows ? 'ZERO INT ILL FPE SEGV TERM ABRT BREAK' : 'ZERO HUP INT QUIT ILL TRAP ABRT BUS FPE KILL USR1 SEGV USR2 PIPE ALRM TERM'), - sig_num => ($os_name =~ /win/ + sig_num => ($is_windows ? '0 2 4 8 11 15 22 21' : '0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15'), # Executable obj_ext => '.o', - exe_ext => $os_name =~ /win/ ? '.exe' : '', - _exe => $os_name =~ /win/ ? '.exe' : '', + exe_ext => $is_windows ? '.exe' : '', + _exe => $perl_launcher_suffix, perlpath => $^X, # Path to the perl interpreter (jperl) startperl => '#!' . $^X, # Shebang line for Perl scripts sharpbang => '#!', # Shebang prefix @@ -351,6 +382,33 @@ $os_name =~ s/\s+/_/g; sub non_bincompat_options() {} sub bincompat_options() {} +sub _catdir { + my ($sep, @parts) = @_; + my $path = shift @parts; + for my $part (@parts) { + next unless defined $part && length $part; + $path =~ s/\Q$sep\E+\z//; + $path .= $sep . $part; + } + return $path; +} + +sub _ensure_dir { + my ($dir) = @_; + return if -d $dir; + + my $sep = $file_separator; + my @parts = grep length, split /\Q$sep\E+/, $dir; + my $current = $dir =~ /^\Q$sep\E/ ? $sep : ''; + + for my $part (@parts) { + $current = length($current) && $current ne $sep + ? _catdir($sep, $current, $part) + : $current . $part; + mkdir $current unless -d $current; + } +} + # Return a string describing the perl configuration (like perl -V) sub myconfig { my $config = "Summary of my perl5 (revision 5 version 42 subversion 0) configuration:\n"; diff --git a/src/main/perl/lib/PerlOnJava/CpanDistroprefs/libwww-perl.yml b/src/main/perl/lib/PerlOnJava/CpanDistroprefs/libwww-perl.yml index 992bdbeef..941c63698 100644 --- a/src/main/perl/lib/PerlOnJava/CpanDistroprefs/libwww-perl.yml +++ b/src/main/perl/lib/PerlOnJava/CpanDistroprefs/libwww-perl.yml @@ -7,7 +7,12 @@ comment: | that are not stable prerequisites for testing LWP::Online here. Skip the dependency test phase so CPAN can stage LWP::Simple; the LWP::Online suite still runs normally. + + Do not apply this dependency-only skip when libwww-perl itself is the + requested jcpan target. The LWP suite is expected to run in that case. match: distribution: "^OALDERS/libwww-perl-" + env: + not_PERLONJAVA_JCPAN_ARGS: "(^|[[:space:]])(?:LWP|LWP::UserAgent)($|[[:space:]])" test: commandline: "PERLONJAVA_SKIP" diff --git a/src/test/resources/unit/config_core_paths.t b/src/test/resources/unit/config_core_paths.t new file mode 100644 index 000000000..37d2a6707 --- /dev/null +++ b/src/test/resources/unit/config_core_paths.t @@ -0,0 +1,16 @@ +use strict; +use warnings; +use Test::More tests => 7; +use Config; +use File::Spec; + +ok(File::Spec->file_name_is_absolute($Config{archlibexp}), 'archlibexp is absolute'); +ok(File::Spec->file_name_is_absolute($Config{privlibexp}), 'privlibexp is absolute'); + +my $core_dir = File::Spec->catdir($Config{archlibexp}, 'CORE'); +ok(-d $Config{privlibexp}, 'privlibexp directory exists'); +ok(-d $Config{archlibexp}, 'archlibexp directory exists'); +ok(-d $core_dir, 'archlib CORE directory exists'); + +is($Config{ldflags}, '', 'ldflags has an empty default'); +is($Config{lddlflags}, '', 'lddlflags has an empty default'); diff --git a/src/test/resources/unit/cpan_distroprefs_jcpan_args.t b/src/test/resources/unit/cpan_distroprefs_jcpan_args.t new file mode 100644 index 000000000..ef454d05e --- /dev/null +++ b/src/test/resources/unit/cpan_distroprefs_jcpan_args.t @@ -0,0 +1,52 @@ +use strict; +use warnings; +use Test::More; +use CPAN::Distroprefs; + +my $pref = CPAN::Distroprefs::Pref->new({ + data => { + match => { + distribution => '^OALDERS/libwww-perl-', + env => { + not_PERLONJAVA_JCPAN_ARGS => + '(^|[[:space:]])(?:LWP|LWP::UserAgent)($|[[:space:]])', + }, + }, + test => { + commandline => 'PERLONJAVA_SKIP', + }, + }, +}); + +my %match_info = ( + distribution => 'OALDERS/libwww-perl-6.83.tar.gz', + module => [], + perl => $^X, + perlconfig => {}, + env => {}, +); + +ok( + $pref->matches(\%match_info), + 'libwww-perl dependency skip matches when no direct jcpan args are exposed', +); + +$match_info{env}{PERLONJAVA_JCPAN_ARGS} = '-t LWP::Online'; +ok( + $pref->matches(\%match_info), + 'libwww-perl dependency skip still matches for a downstream target', +); + +$match_info{env}{PERLONJAVA_JCPAN_ARGS} = '-t LWP'; +ok( + !$pref->matches(\%match_info), + 'libwww-perl dependency skip does not match direct LWP tests', +); + +$match_info{env}{PERLONJAVA_JCPAN_ARGS} = '-t LWP::UserAgent'; +ok( + !$pref->matches(\%match_info), + 'libwww-perl dependency skip does not match direct LWP::UserAgent tests', +); + +done_testing; diff --git a/src/test/resources/unit/io_captureoutput_regressions.t b/src/test/resources/unit/io_captureoutput_regressions.t new file mode 100644 index 000000000..f47dd290a --- /dev/null +++ b/src/test/resources/unit/io_captureoutput_regressions.t @@ -0,0 +1,58 @@ +use strict; +use warnings; +use Test::More tests => 10; +use Config; +use File::Temp qw(tempfile); +use Symbol qw(gensym); + +{ + my ($fh, $path) = tempfile(UNLINK => 1); + seek $fh, 0, 0 or die "seek $path failed: $!"; + local $/; + my $slurped = <$fh>; + ok(defined $slurped, 'slurping a fresh empty handle after seek returns defined'); + is($slurped, '', 'slurping a fresh empty handle after seek returns empty string'); +} + +{ + my $out = `$^X -V:osname`; + like($out, qr/\Aosname='\Q$^O\E';\s*\z/, 'perl -V:osname reports the Perl OS name'); + is($Config{osname}, $^O, 'Config osname matches $^O'); + is($Config{_exe}, $^O eq 'MSWin32' ? Config::_perl_launcher_suffix(1, $^X) : '', + 'Config _exe follows the PerlOnJava launcher suffix'); + is(Config::_perl_launcher_suffix(1, 'C:\\PerlOnJava\\jperl.bat'), '.bat', + 'Windows jperl.bat launcher suffix is preserved'); + is(Config::_perl_launcher_suffix(1, 'C:\\PerlOnJava\\jperl.cmd'), '.cmd', + 'Windows jperl.cmd launcher suffix is preserved'); + is(Config::_perl_launcher_suffix(1, 'C:\\PerlOnJava\\jperl'), '.bat', + 'Windows extensionless jperl falls back to batch launcher suffix'); +} + +{ + my $save_out = gensym(); + my $save_err = gensym(); + open $save_out, '>&STDOUT' or die "dup STDOUT failed: $!"; + open $save_err, '>&STDERR' or die "dup STDERR failed: $!"; + + open STDOUT, '>&' . fileno($save_out) or die "restore-style dup STDOUT failed: $!"; + open STDERR, '>&' . fileno($save_err) or die "restore-style dup STDERR failed: $!"; + close STDOUT or die "close STDOUT failed: $!"; + close STDERR or die "close STDERR failed: $!"; + + my ($capture, $path) = tempfile(UNLINK => 1); + my $capture_fd = fileno($capture); + my $opened = open STDOUT, '>&' . $capture_fd; + my $open_error = "$!"; + print STDOUT "captured through fd $capture_fd\n" if $opened; + + open STDOUT, '>&' . fileno($save_out) or die "restore STDOUT failed: $!"; + open STDERR, '>&' . fileno($save_err) or die "restore STDERR failed: $!"; + + ok($opened, "numeric dup can target a temp file that reused fd $capture_fd") + or diag "open failed: $open_error"; + + seek $capture, 0, 0 or die "seek $path failed: $!"; + local $/; + my $captured = <$capture>; + is($captured, "captured through fd $capture_fd\n", 'numeric dup wrote to the reused fd target'); +}