The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!./perl

BEGIN {
    require './test.pl';
}

plan tests => 15;

dies_like(sub { my $x = \2; $$x = ~< *FH; },
          qr/^Modification of a read-only value attempted$/, '[perl #19566]');

do {
  open my $a_fh,"+>", "a"; $a = 3;
  is(($a .= (~< $a_fh)), 3, '#21628 - $a .= ~< $a_fh , A eof');
  close $a_fh; $a = 4;
  is(($a .= (~< $a_fh)), 4, '#21628 - $a .= ~< $a_fh , A closed');
  unlink "a";
};

# 82 is chosen to exceed the length for sv_grow in do_readline (80)
foreach my $k (@(1, 82)) {
  my $result
    = runperl (stdin => '', stderr => 1,
              prog => "our (\$x, \%a); \$x = q(k) x $k; \%a\{+\$x\} = q(v); \$_ = ~< *ARGV foreach keys \%a; print \$^STDOUT, q(end)",
	      );
  $result =~ s/\n\z// if $^OS_NAME eq 'VMS';
  is ($result, "end", '[perl #21614] for length ' . length('k' x $k));
}


foreach my $k (@(1, 21)) {
  my $result
    = runperl (stdin => ' rules', stderr => 1,
              prog => "our (\$x, \%a); \$x = q(perl) x $k; \%a\{+\$x\} = q(v); foreach (keys \%a) \{\$_ .= ~< *ARGV; print \$^STDOUT, \$_; \}",
	      );
  $result =~ s/\n\z// if $^OS_NAME eq 'VMS';
  is ($result, ('perl' x $k) . " rules", 'rcatline to shared sv for length ' . length('perl' x $k));
}

foreach my $l (@(1, 82)) {
  my $k = $l;
  $k = 'k' x $k;
  my $copy = $k;
  $k = ~< *DATA;
  is ($k, "moo\n", 'catline to COW sv for length ' . length $copy);
}


foreach my $l (@(1, 21)) {
  my $k = $l;
  $k = 'perl' x $k;
  my $perl = $k;
  $k .= ~< *DATA;
  is ($k, "$perl rules\n", 'rcatline to COW sv for length ' . length $perl);
}

use File::Spec;

my $f;
open $f, '<', 'File::Spec'->curdir and sysread $f, $_, 1;
my $err = $^OS_ERROR + 0;
close $f;

SKIP: do {
  skip "you can read directories as plain files", 2 unless( $err );

  $^OS_ERROR=0;
  open $f, "<", 'File::Spec'->curdir and $_= ~< $f;
  ok( $^OS_ERROR==$err && !defined($_) => 'readline( DIRECTORY )' );
  close $f;

  $^OS_ERROR=0;
  do { local $^INPUT_RECORD_SEPARATOR = undef;
    open $f, "<", 'File::Spec'->curdir and $_= ~< $f;
    ok( $^OS_ERROR==$err && !defined($_) => 'readline( DIRECTORY ) slurp mode' );
    close $f;
  };
};

fresh_perl_is('BEGIN{~< *ARGV}', '',
              \%( switches => \@('-w'), stdin => '', stderr => 1 ),
              'No ARGVOUT used only once warning');

my $obj = bless \@();
dies_like( sub { $obj .= ~< *DATA; }, qr/reference as string/, 'rcatline and refs');

__DATA__
moo
moo
 rules
 rules
world