1#!/usr/bin/perl 2 3use warnings; 4use strict; 5 6 7# File::Slurp does things differently than a simple print $fh and $foo = <$fh> 8# Only with File::Slurp, the issue caused by denode.h,v 1.31 9# msdosfs_vnops.c,v 1.114 is reproducible with file_write_test(). 10# XXX One should do some ktrace analysis and rewrite the test to exactly do 11# XXX what is required to trigger the issue. 12use File::Slurp; 13 14my $test = $ARGV[0] or usage(); 15my $basedir = $ARGV[1] or usage(); 16 17if ($test eq 'many_files_root') { 18 many_files_test($basedir, 500); 19} elsif ($test eq 'many_files_subdir') { 20 my $dir = "$basedir/subdir"; 21 mkdir($dir) or die "could not create $dir"; 22 [ -d $dir ] or die "mkdir($dir) did not work?"; 23 many_files_test("$dir", 2000); 24} elsif ($test eq 'file_write') { 25 file_write_test("$basedir/file"); 26} else { 27 usage(); 28} 29 30exit 0; 31 32### sub routines 33 34# create lots of files in a dir an check that they can be read again 35sub many_files_test { 36 my $dir = shift; 37 my $nfiles = shift; 38 39 40 for my $i (1 .. $nfiles) { 41 write_file("$dir/$i", "x$i\n") 42 or die "Could not writ file $dir/$i: $!"; 43 } 44 45 foreach my $i (1 .. $nfiles) { 46 my $file = "$dir/$i"; 47 my $content = read_file($file); 48 defined $content or die "could not read $file: $!"; 49 if ($content ne "x$i\n") { 50 die "$file has wrong content:'$content' instead of 'x$i\n'"; 51 } 52 unlink($file) or die "could not unlink $file"; 53 } 54 foreach my $i (1 .. $nfiles) { 55 my $file = "$dir/$i"; 56 if (-e $file) { 57 die "$file still exists?"; 58 } 59 } 60} 61 62# create one ~ 500K file and check that reading gives the same contents 63sub file_write_test { 64 my $file = shift; 65 my $content = ''; 66 67 for my $i (1 .. 100000) { 68 $content .= "$i\n"; 69 } 70 write_file($file, $content) or die "Could not write $file: $!"; 71 72 my $got = read_file($file) or die "Could not write $file: $!"; 73 if (length $got != length $content) { 74 die "File $file is " . length $got . " bytes, expected " 75 . length $content; 76 } 77 78 if ($got ne $content) { 79 my $i = 0; 80 do { 81 if (substr($got, $i, 1) ne substr($content, $i, 1)) { 82 die "Got wrong content at pos $i in $file"; 83 } 84 $i++; 85 } while ($i < length($got)); 86 die "BUG"; 87 } 88 89 unlink $file or die "can't delet $file: $!"; 90} 91 92sub usage { 93 print << "EOF"; 94usage: $0 <test> <mount-point> 95 96 test can be one of: 97 file_write 98 many_files_root 99 many_files_subdir 100EOF 101} 102