Lines Matching +full:local +full:- +full:dir
3 #-
10 # is granted to deal in this work without restriction, including un-
22 #-
24 # name: a-test
27 # arguments: !-x!-f!
29 # echo -n *
31 # expected-stdout: !
33 # expected-stderr:
34 # + echo -n *
36 # expected-exit: 1
37 # ---
38 # This runs the test-program (eg, mksh) with the arguments -x and -f,
45 # - blank lines and lines starting with # are ignored
46 # - a test file contains a series of tests
47 # - a test is a series of tag:value pairs ended with a "---" line
49 # - test tags are:
51 # ----- ---- -----------
60 # used as standard-input for the program;
62 # perl-setup m Value is a perl script which is executed
65 # perl-cleanup m Value is a perl script which is executed
68 # env-setup M Value is a list of NAME=VALUE elements
81 # __progname is set to the -p argument.
83 # @utflocale@ is substituted from -U.
84 # file-setup mps Used to create files, directories
86 # file, dir or symlink; second word is
89 # file; the end-quote should be followed
94 # file-result mps Used to verify a file, symlink or
97 # file, dir or symlink; second word is
99 # is user-id; fourth is group-id;
106 # The end-quote should be followed
113 # time-limit Time limit - the program is sent a
116 # expected-fail 'yes' if the test is expected to fail.
117 # expected-exit expected exit code. Can be a number,
121 # expected-stdout m What the test should generate on stdout;
123 # expected-stdout-pattern m A perl pattern which matches the
125 # expected-stderr m What the test should generate on stderr;
127 # expected-stderr-pattern m A perl pattern which matches the
142 # need-ctty 'yes' if the test needs a ctty, run
143 # with -C regress:no-ctty to disable.
148 # - empty: the initial blank line is stripped.
149 # - a lone !: the last newline in the value is stripped;
152 # The value must start and end with the f-s-c.
187 Usage: $prog [-Pv] [-C cat] [-e e=v] [-p prog] [-s fn] [-T dir] \
188 [-t tmo] [-U lcl] name ...
189 -C c Specify the comma separated list of categories the program
191 -e e=v Set the environment variable e to v for all tests
193 Only one -e option can be given at the moment, sadly.
194 -P program (-p) string has multiple words, and the program is in
196 -p p Use p as the program to test
197 -s s Read tests from file s; if s is a directory, it is recursively
199 -T dir Use dir instead of /tmp to hold temporary files
200 -t t Use t as default time limit for tests (default is unlimited)
201 -U lcl Use lcl as UTF-8 locale (e.g. C.UTF-8) instead of the default
202 -v Verbose mode: print reason test failed.
214 'perl-setup', 'm',
215 'perl-cleanup', 'm',
216 'env-setup', 'M',
217 'file-setup', 'mps',
218 'file-result', 'mps',
219 'time-limit', '',
220 'expected-fail', '',
221 'expected-exit', '',
222 'expected-stdout', 'm',
223 'expected-stdout-pattern', 'm',
224 'expected-stderr', 'm',
225 'expected-stderr-pattern', 'm',
227 'need-ctty', '',
228 'need-pass', '',
232 ':full-name', 1, # file:name
233 ':long-name', 1, # dir/file:lineno:name
255 die "$prog: no program specified (use -p)\n" if !defined $opt_p;
256 die "$prog: no test set specified (use -s)\n" if !defined $opt_s;
262 $utflocale = $opt_U || (($os eq "hpux") ? "en_US.utf8" : "en_US.UTF-8");
264 die "$prog: bad -t argument (should be number > 0): $opt_t\n"
271 $categories{'shell:ebcdic-yes'} = 1;
272 $categories{'shell:ascii-no'} = 1;
274 $categories{'shell:ebcdic-no'} = 1;
275 $categories{'shell:ascii-yes'} = 1;
306 $new_env{'__perlname'} = $^X if ($new_env{'__perlname'} eq '') and -f $^X and -x $^X;
311 next unless -f $x and -x $x;
319 # XXX need a way to allow many -e arguments...
320 if ($opt_e =~ /^([a-zA-Z_]\w*)(|=(.*))$/) {
323 die "$0: bad -e argument: $opt_e\n";
330 die "$prog: couldn't cd to $pwd - $!\n" if !chdir($pwd);
332 die "$prog: couldn't cd to $temp_base - $!\n" if !chdir($temp_base);
333 die "$prog: couldn't get temporary directory base\n" unless -d '.';
334 $temps = sprintf("chk%d-%d.", $$, time());
339 die "$prog: couldn't cd to $tempdir - $!\n" if !chdir($tempdir);
342 die "$prog: couldn't cd to $pwd - $!\n" if !chdir($pwd);
347 die "$prog: $test_prog is not executable - bye\n"
348 if (! -x $test_prog && $os ne 'os2');
364 mkdir($tempdir, 0700) or die "$prog: couldn't mkdir $tempdir - $!\n";
366 if (-d $test_set) {
393 local($sig, $exitcode) = ('', 1);
429 local($dir) = @_;
430 local($ret, $file);
431 local(@todo) = ();
433 if (!opendir(DIR, $dir)) {
434 print STDERR "$prog: can't open directory $dir - $!\n";
437 while (defined ($file = readdir(DIR))) {
440 closedir(DIR);
443 $file = "$dir/$file";
444 if (-d $file) {
446 } elsif (-f _) {
458 local($file) = @_;
459 local($ret);
462 print STDERR "$prog: can't open $file - $!\n";
482 local(*test) = @_;
483 local($name) = $test{':full-name'};
499 print STDERR "$prog: couldn't cd to $tempdir - $!\n";
503 if (defined $test{'file-setup'}) {
504 local($i);
505 local($type, $perm, $rest, $c, $len, $name);
507 for ($i = 0; $i < $test{'file-setup'}; $i++) {
508 $val = $test{"file-setup:$i"};
514 $len = index($rest, $c, 1) - 1;
522 "$prog:$test{':long-name'}: can't chmod $perm $name - $!\n";
525 } elsif ($type eq 'dir') {
528 "$prog:$test{':long-name'}: can't mkdir $perm $name - $!\n";
532 local($oumask) = umask($perm);
533 local($ret) = symlink($rest, $name);
537 "$prog:$test{':long-name'}: couldn't create symlink $name - $!\n";
544 if (defined $test{'perl-setup'}) {
545 eval $test{'perl-setup'};
547 print STDERR "$prog:$test{':long-name'}: error running perl-setup - $@\n";
554 print STDERR "$prog: can't fork - $!\n";
560 if (defined $test{'env-setup'}) {
561 local($var, $val, $i);
563 foreach $var (split(substr($test{'env-setup'}, 0, 1),
564 $test{'env-setup'}))
576 print STDERR "$prog: couldn't open $ifile in child - $!\n";
581 print STDERR "$prog: couldn't open $tempo in child - $!\n";
586 print STDOUT "$prog: couldn't open $tempe in child - $!\n";
602 #XXX realpathise, use command -v/whence -p/which, or sth. like that
606 # The following doesn't work with perl5... Need to do it explicitly - yuck.
614 print STDERR "$prog: couldn't execute $test_prog - $!\n";
621 alarm($test{'time-limit'}) if defined $test{'time-limit'};
629 print STDERR "$prog: error waiting for child - $!\n";
635 alarm(0) if defined $test{'time-limit'};
642 $why .= "\ttest timed out (limit of $test{'time-limit'} seconds)\n";
645 $ret = &eval_exit($test{'long-name'}, $status, $test{'expected-exit'});
648 local($expl);
656 $expl = "exit-code " . (($status >> 8) & 0xff);
659 "\tunexpected exit status $status ($expl), expected $test{'expected-exit'}\n";
662 $tmp = &check_output($test{'long-name'}, $tempo, 'stdout',
663 $test{'expected-stdout'}, $test{'expected-stdout-pattern'});
670 $tmp = &check_output($test{'long-name'}, $tempe, 'stderr',
671 $test{'expected-stderr'}, $test{'expected-stderr-pattern'});
685 if (defined $test{'perl-cleanup'}) {
686 eval $test{'perl-cleanup'};
688 print STDERR "$prog:$test{':long-name'}: error running perl-cleanup - $@\n";
694 print STDERR "$prog: couldn't cd to $pwd - $!\n";
699 if (!$test{'expected-fail'}) {
700 if ($test{'need-pass'}) {
714 } elsif ($test{'expected-fail'}) {
728 local(*test) = @_;
729 local($c);
731 return 0 if ($test{'need-ctty'} && defined $categories{'regress:no-ctty'});
733 local($ok) = 0;
750 local($dir) = @_;
751 local(@todo) = ();
752 local($file);
754 if (!opendir(DIR, $dir)) {
755 print STDERR "$prog: couldn't open directory $dir - $!\n";
758 while (defined ($file = readdir(DIR))) {
761 closedir(DIR);
763 $file = "$dir/$file";
764 if (-d $file) {
767 print STDERR "$prog: couldn't rmdir $file - $!\n";
772 print STDERR "$prog: couldn't unlink $file - $!\n";
783 local($file, $str) = @_;
786 print STDERR "$prog: can't open $file - $!\n";
792 print STDERR "$prog: error writing $file - $!\n";
801 local($name, $file, $what, $expect, $expect_pat) = @_;
802 local($got) = '';
803 local($why) = '';
804 local($ret);
807 print STDERR "$prog:$name($what): couldn't open $file after running program - $!\n";
821 local($name, $what, $expect, $expect_pat, $got) = @_;
822 local($why) = '';
828 print STDERR "$prog:$name($what): error evaluating $what pattern: $expect_pat - $@\n";
832 $why = "\tunexpected $what - wanted pattern";
840 $why .= "\tunexpected $what - " . &first_diff($expect, $got) . "\n";
853 local($str, $empty) = @_;
854 local($nonl) = substr($str, -1, 1) ne "\n";
871 local($exp, $got) = @_;
872 local($lineno, $char) = (1, 1);
873 local($i, $exp_len, $got_len);
874 local($ce, $cg);
904 local($ch, $s, $q);
932 $ch -= 128;
933 $s .= "M-";
946 local($name, $status, $expect) = @_;
947 local($expr);
948 local($w, $e, $s) = ($status, ($status >> 8) & 0xff, $status & 0x7f);
950 $e = -1000 if $status & 0xff;
951 $s = -1000 if $s == 0x7f;
954 } elsif ($expect =~ /^(|-)\d+$/) {
959 $expr =~ s/\b(SIG[A-Z][A-Z0-9]*)\b/&$1/g;
963 print STDERR "$prog:$test{':long-name'}: bad expected-exit expression: $expect ($@)\n";
972 local($file, $in, *test) = @_;
973 local($field, $val, $flags, $do_chop, $need_redo, $start_lineno);
974 local(%cnt, $sfield);
982 last if /^\s*---\s*$/;
984 if (!/^([-\w]+):\s*(|\S|\S.*\S)\s*$/) {
996 local($cnt) = $cnt{$field}++;
1037 if ($field eq 'file-setup') {
1038 local($type, $perm, $rest, $c, $len, $name);
1043 "$prog:$file:$.: bad parameter line for file-setup field\n";
1047 if ($type !~ /^(file|dir|symlink)$/) {
1049 "$prog:$file:$.: bad file type for file-setup: $type\n";
1054 "$prog:$file:$.: bad permissions for file-setup: $type\n";
1058 if (($len = index($rest, $c, 1) - 1) <= 0) {
1060 "$prog:$file:$.: missing end quote for file name in file-setup: $rest\n";
1065 # Note: this is not a security thing - just a sanity
1066 # check - a test can still use symlinks to get at files
1069 "$prog:$file:$.: file name in file-setup is absolute or contains ..: $name\n";
1073 if ($field eq 'file-result') {
1074 local($type, $perm, $uid, $gid, $matchType,
1080 "$prog:$file:$.: bad parameter line for file-result field\n";
1085 if ($type !~ /^(file|dir|symlink)$/) {
1087 "$prog:$file:$.: bad file type for file-result: $type\n";
1092 "$prog:$file:$.: bad permissions for file-result: $perm\n";
1097 "$prog:$file:$.: bad user-id for file-result: $uid\n";
1102 "$prog:$file:$.: bad group-id for file-result: $gid\n";
1107 "$prog:$file:$.: bad match type for file-result: $matchType\n";
1111 if (($len = index($rest, $c, 1) - 1) <= 0) {
1113 "$prog:$file:$.: missing end quote for file name in file-result: $rest\n";
1118 # Note: this is not a security thing - just a sanity
1119 # check - a test can still use symlinks to get at files
1122 "$prog:$file:$.: file name in file-result is absolute or contains ..: $name\n";
1139 "$prog:$file:$start_lineno: end-of-file while reading test\n";
1153 $test{':full-name'} = substr($file, $file_prefix_skip) . ":$test{'name'}";
1154 $test{':long-name'} = "$file:$start_lineno:$test{'name'}";
1157 if (defined $test{'expected-fail'}) {
1158 if ($test{'expected-fail'} !~ /^(yes|no)$/) {
1160 "$prog:$test{':long-name'}: bad value for expected-fail field\n";
1163 $test{'expected-fail'} = $1 eq 'yes';
1165 $test{'expected-fail'} = 0;
1167 if (defined $test{'need-ctty'}) {
1168 if ($test{'need-ctty'} !~ /^(yes|no)$/) {
1170 "$prog:$test{':long-name'}: bad value for need-ctty field\n";
1173 $test{'need-ctty'} = $1 eq 'yes';
1175 $test{'need-ctty'} = 0;
1177 if (defined $test{'need-pass'}) {
1178 if ($test{'need-pass'} !~ /^(yes|no)$/) {
1180 "$prog:$test{':long-name'}: bad value for need-pass field\n";
1183 $test{'need-pass'} = $1 eq 'yes';
1185 $test{'need-pass'} = 1;
1188 local($firstc) = substr($test{'arguments'}, 0, 1);
1190 if (substr($test{'arguments'}, -1, 1) ne $firstc) {
1191 …print STDERR "$prog:$test{':long-name'}: arguments field doesn't start and end with the same chara…
1195 if (defined $test{'env-setup'}) {
1196 local($firstc) = substr($test{'env-setup'}, 0, 1);
1198 if (substr($test{'env-setup'}, -1, 1) ne $firstc) {
1199 …print STDERR "$prog:$test{':long-name'}: env-setup field doesn't start and end with the same chara…
1203 $test{'env-setup'} =~ s/\@utflocale\@/$utflocale/g;
1205 if (defined $test{'expected-exit'}) {
1206 local($val) = $test{'expected-exit'};
1208 if ($val =~ /^(|-)\d+$/) {
1210 print STDERR "$prog:$test{':long-name'}: expected-exit value $val not in 0..255\n";
1213 } elsif ($val !~ /^([\s\d<>+=*%\/&|!()-]|\b[wse]\b|\bSIG[A-Z][A-Z0-9]*\b)+$/) {
1214 print STDERR "$prog:$test{':long-name'}: bad expected-exit expression: $val\n";
1218 $test{'expected-exit'} = 0;
1220 if (defined $test{'expected-stdout'}
1221 && defined $test{'expected-stdout-pattern'})
1223 …print STDERR "$prog:$test{':long-name'}: can't use both expected-stdout and expected-stdout-patter…
1226 if (defined $test{'expected-stderr'}
1227 && defined $test{'expected-stderr-pattern'})
1229 …print STDERR "$prog:$test{':long-name'}: can't use both expected-stderr and expected-stderr-patter…
1232 if (defined $test{'time-limit'}) {
1233 if ($test{'time-limit'} !~ /^\d+$/ || $test{'time-limit'} == 0) {
1235 "$prog:$test{':long-name'}: bad value for time-limit field\n";
1239 $test{'time-limit'} = $default_time_limit;
1243 print STDERR "$prog:$test{':long-name'}: warning: duplicate test name ${test{'name'}}\n";
1253 local($msg) = @_;
1275 local(*test) = @_;
1277 return '' if (!defined $test{'file-result'});
1279 local($why) = '';
1280 local($i);
1281 local($type, $perm, $uid, $gid, $rest, $c, $len, $name);
1282 local(@stbuf);
1284 for ($i = 0; $i < $test{'file-result'}; $i++) {
1285 $val = $test{"file-result:$i"};
1291 $len = index($rest, $c, 1) - 1;
1307 $why .= "\t$type \"$name\" has unexpected user-id\n";
1312 $why .= "\t$type \"$name\" has unexpected group-id\n";
1318 if (-l _ || ! -f _) {
1321 local $tmp = &check_output($test{'long-name'}, $name,
1328 } elsif ($type eq 'dir') {
1330 …print STDERR "$prog:$test{':long-name'}: file-result test for directory $name should not have cont…
1333 if (-l _ || ! -d _) {
1337 if (!-l _) {
1340 local $content = readlink($name);
1342 …print STDERR "$prog:$test{':long-name'}: file-result test for $type $name failed - could not readl…
1345 local $tmp = &compare_output($test{'long-name'},