ext/PerlIO/t/scalar.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     unless (find PerlIO::Layer 'perlio') {
   7         print "1..0 # Skip: not perlio\n";
   8         exit 0;
   9     }
  10 }
  11
  12 $| = 1;
  13 print "1..20\n";
  14
  15 my $fh;
  16 my $var = "ok 2\n";
  17 open($fh,"+<",\$var) or print "not ";
  18 print "ok 1\n";
  19 print <$fh>;
  20 print "not " unless eof($fh);
  21 print "ok 3\n";
  22 seek($fh,0,0) or print "not ";
  23 print "not " if eof($fh);
  24 print "ok 4\n";
  25 print "ok 5\n";
  26 print $fh "ok 7\n" or print "not ";
  27 print "ok 6\n";
  28 print $var;
  29 $var = "foo\nbar\n";
  30 seek($fh,0,0) or print "not ";
  31 print "not " if eof($fh);
  32 print "ok 8\n";
  33 print "not " unless <$fh> eq "foo\n";
  34 print "ok 9\n";
  35 my $rv = close $fh;
  36 if (!$rv) {
  37     print "# Close on scalar failed: $!\n";
  38     print "not ";
  39 }
  40 print "ok 10\n";
  41
  42 # Test that semantics are similar to normal file-based I/O
  43 # Check that ">" clobbers the scalar
  44 $var = "Something";
  45 open $fh, ">", \$var;
  46 print "# Got [$var], expect []\n";
  47 print "not " unless $var eq "";
  48 print "ok 11\n";
  49 #  Check that file offset set to beginning of scalar
  50 my $off = tell($fh);
  51 print "# Got $off, expect 0\n";
  52 print "not " unless $off == 0;
  53 print "ok 12\n";
  54 # Check that writes go where they should and update the offset
  55 $var = "Something";
  56 print $fh "Brea";
  57 $off = tell($fh);
  58 print "# Got $off, expect 4\n";
  59 print "not " unless $off == 4;
  60 print "ok 13\n";
  61 print "# Got [$var], expect [Breathing]\n";
  62 print "not " unless $var eq "Breathing";
  63 print "ok 14\n";
  64 close $fh;
  65
  66 # Check that ">>" appends to the scalar
  67 $var = "Something ";
  68 open $fh, ">>", \$var;
  69 $off = tell($fh);
  70 print "# Got $off, expect 10\n";
  71 print "not " unless $off == 10;
  72 print "ok 15\n";
  73 print "# Got [$var], expect [Something ]\n";
  74 print "not " unless $var eq "Something ";
  75 print "ok 16\n";
  76 #  Check that further writes go to the very end of the scalar
  77 $var .= "else ";
  78 print "# Got [$var], expect [Something else ]\n";
  79 print "not " unless $var eq "Something else ";
  80 print "ok 17\n";
  81 $off = tell($fh);
  82 print "# Got $off, expect 10\n";
  83 print "not " unless $off == 10;
  84 print "ok 18\n";
  85 print $fh "is here";
  86 print "# Got [$var], expect [Something else is here]\n";
  87 print "not " unless $var eq "Something else is here";
  88 print "ok 19\n";
  89 close $fh;
  90
  91 # Check that updates to the scalar from elsewhere do not
  92 # cause problems
  93 $var = "line one\nline two\line three\n";
  94 open $fh, "<", \$var;
  95 while (<$fh>) {
  96     $var = "foo";
  97 }
  98 close $fh;
  99 print "# Got [$var], expect [foo]\n";
 100 print "not " unless $var eq "foo";
 101 print "ok 20\n";