t/uni/readline.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't';
   5     @INC = '../lib';
   6     require './test.pl';
   7 }
   8
   9 plan tests => 7;
  10
  11 use utf8;
  12 use open qw( :utf8 :std );
  13
  14 # [perl #19566]: sv_gets writes directly to its argument via
  15 # TARG. Test that we respect SvREADONLY.
  16 use constant roref=>\2;
  17 eval { for (roref) { $_ = <Fʜ> } };
  18 like($@, 'Modification of a read-only value attempted', '[perl #19566]');
  19
  20 # [perl #21628]
  21 {
  22   my $file = tempfile();
  23   open Ạ,'+>',$file; $a = 3;
  24   is($a .= <Ạ>, 3, '#21628 - $a .= <A> , A eof');
  25   close Ạ; $a = 4;
  26   is($a .= <Ạ>, 4, '#21628 - $a .= <A> , A closed');
  27 }
  28
  29 use strict;
  30
  31 open ᕝ, '.' and sysread ᕝ, $_, 1;
  32 my $err = $! + 0;
  33 close ᕝ;
  34
  35 SKIP: {
  36   skip "you can read directories as plain files", 2 unless( $err );
  37
  38   $!=0;
  39   open ᕝ, '.' and $_=<ᕝ>;
  40   ok( $!==$err && !defined($_) => 'readline( DIRECTORY )' );
  41   close ᕝ;
  42
  43   $!=0;
  44   { local $/;
  45     open ᕝ, '.' and $_=<ᕝ>;
  46     ok( $!==$err && !defined($_) => 'readline( DIRECTORY ) slurp mode' );
  47     close ᕝ;
  48   }
  49 }
  50
  51 my $obj = bless [], "Ȼლᔆ";
  52 $obj .= <DATA>;
  53 like($obj, qr/Ȼლᔆ=ARRAY.*world/u, 'rcatline and refs');
  54
  55 {
  56     my $file = tempfile();
  57     open my $out_fh, ">", $file;
  58     print { $out_fh } "Data\n";
  59     close $out_fh;
  60
  61     open hòฟ, "<", $file;
  62     is( scalar(<hòฟ>), "Data\n", "readline() works correctly on UTF-8 filehandles" );
  63     close hòฟ;
  64 }
  65
  66 __DATA__
  67 world