diff options
Diffstat (limited to 'contrib/perl5/t/base')
-rwxr-xr-x | contrib/perl5/t/base/cond.t | 19 | ||||
-rwxr-xr-x | contrib/perl5/t/base/if.t | 11 | ||||
-rwxr-xr-x | contrib/perl5/t/base/lex.t | 247 | ||||
-rwxr-xr-x | contrib/perl5/t/base/pat.t | 11 | ||||
-rwxr-xr-x | contrib/perl5/t/base/rs.t | 132 | ||||
-rwxr-xr-x | contrib/perl5/t/base/term.t | 55 |
6 files changed, 0 insertions, 475 deletions
diff --git a/contrib/perl5/t/base/cond.t b/contrib/perl5/t/base/cond.t deleted file mode 100755 index 9a57348..0000000 --- a/contrib/perl5/t/base/cond.t +++ /dev/null @@ -1,19 +0,0 @@ -#!./perl - -# $RCSfile: cond.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:02 $ - -# make sure conditional operators work - -print "1..4\n"; - -$x = '0'; - -$x eq $x && (print "ok 1\n"); -$x ne $x && (print "not ok 1\n"); -$x eq $x || (print "not ok 2\n"); -$x ne $x || (print "ok 2\n"); - -$x == $x && (print "ok 3\n"); -$x != $x && (print "not ok 3\n"); -$x == $x || (print "not ok 4\n"); -$x != $x || (print "ok 4\n"); diff --git a/contrib/perl5/t/base/if.t b/contrib/perl5/t/base/if.t deleted file mode 100755 index 12db765..0000000 --- a/contrib/perl5/t/base/if.t +++ /dev/null @@ -1,11 +0,0 @@ -#!./perl - -# $RCSfile: if.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:03 $ - -print "1..2\n"; - -# first test to see if we can run the tests. - -$x = 'test'; -if ($x eq $x) { print "ok 1\n"; } else { print "not ok 1\n";} -if ($x ne $x) { print "not ok 2\n"; } else { print "ok 2\n";} diff --git a/contrib/perl5/t/base/lex.t b/contrib/perl5/t/base/lex.t deleted file mode 100755 index c7fb0e4..0000000 --- a/contrib/perl5/t/base/lex.t +++ /dev/null @@ -1,247 +0,0 @@ -#!./perl - -print "1..51\n"; - -$x = 'x'; - -print "#1 :$x: eq :x:\n"; -if ($x eq 'x') {print "ok 1\n";} else {print "not ok 1\n";} - -$x = $#; # this is the register $# - -if ($x eq '') {print "ok 2\n";} else {print "not ok 2\n";} - -$x = $#x; - -if ($x eq '-1') {print "ok 3\n";} else {print "not ok 3\n";} - -$x = '\\'; # '; - -if (length($x) == 1) {print "ok 4\n";} else {print "not ok 4\n";} - -eval 'while (0) { - print "foo\n"; -} -/^/ && (print "ok 5\n"); -'; - -eval '$foo{1} / 1;'; -if (!$@) {print "ok 6\n";} else {print "not ok 6 $@\n";} - -eval '$foo = 123+123.4+123e4+123.4E5+123.4e+5+.12;'; - -$foo = int($foo * 100 + .5); -if ($foo eq 2591024652) {print "ok 7\n";} else {print "not ok 7 :$foo:\n";} - -print <<'EOF'; -ok 8 -EOF - -$foo = 'ok 9'; -print <<EOF; -$foo -EOF - -eval <<\EOE, print $@; -print <<'EOF'; -ok 10 -EOF - -$foo = 'ok 11'; -print <<EOF; -$foo -EOF -EOE - -print <<`EOS` . <<\EOF; -echo ok 12 -EOS -ok 13 -EOF - -print qq/ok 14\n/; -print qq(ok 15\n); - -print qq -[ok 16\n] -; - -print q<ok 17 ->; - -print <<; # Yow! -ok 18 - -# previous line intentionally left blank. - -print <<E1 eq "foo\n\n" ? "ok 19\n" : "not ok 19\n"; -@{[ <<E2 ]} -foo -E2 -E1 - -print <<E1 eq "foo\n\n" ? "ok 20\n" : "not ok 20\n"; -@{[ - <<E2 -foo -E2 -]} -E1 - -$foo = FOO; -$bar = BAR; -$foo{$bar} = BAZ; -$ary[0] = ABC; - -print "$foo{$bar}" eq "BAZ" ? "ok 21\n" : "not ok 21\n"; - -print "${foo}{$bar}" eq "FOO{BAR}" ? "ok 22\n" : "not ok 22\n"; -print "${foo{$bar}}" eq "BAZ" ? "ok 23\n" : "not ok 23\n"; - -print "FOO:" =~ /$foo[:]/ ? "ok 24\n" : "not ok 24\n"; -print "ABC" =~ /^$ary[$A]$/ ? "ok 25\n" : "not ok 25\n"; -print "FOOZ" =~ /^$foo[$A-Z]$/ ? "ok 26\n" : "not ok 26\n"; - -# MJD 19980425 -($X, @X) = qw(a b c d); -print "d" =~ /^$X[-1]$/ ? "ok 27\n" : "not ok 27\n"; -print "a1" !~ /^$X[-1]$/ ? "ok 28\n" : "not ok 28\n"; - -print (((q{{\{\(}} . q{{\)\}}}) eq '{{\(}{\)}}') ? "ok 29\n" : "not ok 29\n"); - - -$foo = "not ok 30\n"; -$foo =~ s/^not /substr(<<EOF, 0, 0)/e; - Ignored -EOF -print $foo; - -# Tests for new extended control-character variables -# MJD 19990227 - -{ my $CX = "\cX"; - my $CXY ="\cXY"; - $ {$CX} = 17; - $ {$CXY} = 23; - if ($ {^XY} != 23) { print "not " } - print "ok 31\n"; - -# Does the syntax where we use the literal control character still work? - if (eval "\$ {\cX}" != 17 or $@) { print "not " } - print "ok 32\n"; - - eval "\$\cN = 24"; # Literal control character - if ($@ or ${"\cN"} != 24) { print "not " } - print "ok 33\n"; - if ($^N != 24) { print "not " } # Control character escape sequence - print "ok 34\n"; - -# Does the old UNBRACED syntax still do what it used to? - if ("$^XY" ne "17Y") { print "not " } - print "ok 35\n"; - - sub XX () { 6 } - $ {"\cN\cXX"} = 119; - $^N = 5; # This should be an unused ^Var. - $N = 5; - # The second caret here should be interpreted as an xor - if (($^N^XX) != 3) { print "not " } - print "ok 36\n"; -# if (($N ^ XX()) != 3) { print "not " } -# print "ok 32\n"; - - # These next two tests are trying to make sure that - # $^FOO is always global; it doesn't make sense to `my' it. - # - - eval 'my $^X;'; - print "not " unless index ($@, 'Can\'t use global $^X in "my"') > -1; - print "ok 37\n"; -# print "($@)\n" if $@; - - eval 'my $ {^XYZ};'; - print "not " unless index ($@, 'Can\'t use global $^XYZ in "my"') > -1; - print "ok 38\n"; -# print "($@)\n" if $@; - -# Now let's make sure that caret variables are all forced into the main package. - package Someother; - $^N = 'Someother'; - $ {^Nostril} = 'Someother 2'; - $ {^M} = 'Someother 3'; - package main; - print "not " unless $^N eq 'Someother'; - print "ok 39\n"; - print "not " unless $ {^Nostril} eq 'Someother 2'; - print "ok 40\n"; - print "not " unless $ {^M} eq 'Someother 3'; - print "ok 41\n"; - - -} - -# see if eval '', s///e, and heredocs mix - -sub T { - my ($where, $num) = @_; - my ($p,$f,$l) = caller; - print "# $p:$f:$l vs /$where/\nnot " unless "$p:$f:$l" =~ /$where/; - print "ok $num\n"; -} - -my $test = 42; - -{ -# line 42 "plink" - local $_ = "not ok "; - eval q{ - s/^not /<<EOT/e and T '^main:\(eval \d+\):2$', $test++; -# fuggedaboudit -EOT - print $_, $test++, "\n"; - T('^main:\(eval \d+\):6$', $test++); -# line 1 "plunk" - T('^main:plunk:1$', $test++); - }; - print "# $@\nnot ok $test\n" if $@; - T '^main:plink:53$', $test++; -} - -# tests 47--51 start here -# tests for new array interpolation semantics: -# arrays now *always* interpolate into "..." strings. -# 20000522 MJD (mjd@plover.com) -{ - my $test = 47; - eval(q(">@nosuch<" eq "><")) || print "# $@", "not "; - print "ok $test\n"; - ++$test; - - # Look at this! This is going to be a common error in the future: - eval(q("fred@example.com" eq "fred.com")) || print "# $@", "not "; - print "ok $test\n"; - ++$test; - - # Let's make sure that normal array interpolation still works right - # For some reason, this appears not to be tested anywhere else. - my @a = (1,2,3); - print +((">@a<" eq ">1 2 3<") ? '' : 'not '), "ok $test\n"; - ++$test; - - # Ditto. - eval(q{@nosuch = ('a', 'b', 'c'); ">@nosuch<" eq ">a b c<"}) - || print "# $@", "not "; - print "ok $test\n"; - ++$test; - - # This isn't actually a lex test, but it's testing the same feature - sub makearray { - my @array = ('fish', 'dog', 'carrot'); - *R::crackers = \@array; - } - - eval(q{makearray(); ">@R::crackers<" eq ">fish dog carrot<"}) - || print "# $@", "not "; - print "ok $test\n"; - ++$test; -} diff --git a/contrib/perl5/t/base/pat.t b/contrib/perl5/t/base/pat.t deleted file mode 100755 index c689f45..0000000 --- a/contrib/perl5/t/base/pat.t +++ /dev/null @@ -1,11 +0,0 @@ -#!./perl - -# $RCSfile: pat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:05 $ - -print "1..2\n"; - -# first test to see if we can run the tests. - -$_ = 'test'; -if (/^test/) { print "ok 1\n"; } else { print "not ok 1\n";} -if (/^foo/) { print "not ok 2\n"; } else { print "ok 2\n";} diff --git a/contrib/perl5/t/base/rs.t b/contrib/perl5/t/base/rs.t deleted file mode 100755 index e470f3a..0000000 --- a/contrib/perl5/t/base/rs.t +++ /dev/null @@ -1,132 +0,0 @@ -#!./perl -# Test $! - -print "1..14\n"; - -$teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n"; - -# Create our test datafile -1 while unlink 'foo'; # in case junk left around -rmdir 'foo'; -open TESTFILE, ">./foo" or die "error $! $^E opening"; -binmode TESTFILE; -print TESTFILE $teststring; -close TESTFILE; - -open TESTFILE, "<./foo"; -binmode TESTFILE; - -# Check the default $/ -$bar = <TESTFILE>; -if ($bar eq "1\n") {print "ok 1\n";} else {print "not ok 1\n";} - -# explicitly set to \n -$/ = "\n"; -$bar = <TESTFILE>; -if ($bar eq "12\n") {print "ok 2\n";} else {print "not ok 2\n";} - -# Try a non line terminator -$/ = 3; -$bar = <TESTFILE>; -if ($bar eq "123") {print "ok 3\n";} else {print "not ok 3\n";} - -# Eat the line terminator -$/ = "\n"; -$bar = <TESTFILE>; - -# How about a larger terminator -$/ = "34"; -$bar = <TESTFILE>; -if ($bar eq "1234") {print "ok 4\n";} else {print "not ok 4\n";} - -# Eat the line terminator -$/ = "\n"; -$bar = <TESTFILE>; - -# Does paragraph mode work? -$/ = ''; -$bar = <TESTFILE>; -if ($bar eq "1234\n12345\n\n") {print "ok 5\n";} else {print "not ok 5\n";} - -# Try slurping the rest of the file -$/ = undef; -$bar = <TESTFILE>; -if ($bar eq "123456\n1234567\n") {print "ok 6\n";} else {print "not ok 6\n";} - -# try the record reading tests. New file so we don't have to worry about -# the size of \n. -close TESTFILE; -unlink "./foo"; -open TESTFILE, ">./foo"; -print TESTFILE "1234567890123456789012345678901234567890"; -binmode TESTFILE; -close TESTFILE; -open TESTFILE, "<./foo"; -binmode TESTFILE; - -# Test straight number -$/ = \2; -$bar = <TESTFILE>; -if ($bar eq "12") {print "ok 7\n";} else {print "not ok 7\n";} - -# Test stringified number -$/ = \"2"; -$bar = <TESTFILE>; -if ($bar eq "34") {print "ok 8\n";} else {print "not ok 8\n";} - -# Integer variable -$foo = 2; -$/ = \$foo; -$bar = <TESTFILE>; -if ($bar eq "56") {print "ok 9\n";} else {print "not ok 9\n";} - -# String variable -$foo = "2"; -$/ = \$foo; -$bar = <TESTFILE>; -if ($bar eq "78") {print "ok 10\n";} else {print "not ok 10\n";} - -# Get rid of the temp file -close TESTFILE; -unlink "./foo"; - -# Now for the tricky bit--full record reading -if ($^O eq 'VMS') { - # Create a temp file. We jump through these hoops 'cause CREATE really - # doesn't like our methods for some reason. - open FDLFILE, "> ./foo.fdl"; - print FDLFILE "RECORD\n FORMAT VARIABLE\n"; - close FDLFILE; - open CREATEFILE, "> ./foo.com"; - print CREATEFILE '$ DEFINE/USER SYS$INPUT NL:', "\n"; - print CREATEFILE '$ DEFINE/USER SYS$OUTPUT NL:', "\n"; - print CREATEFILE '$ OPEN YOW []FOO.BAR/WRITE', "\n"; - print CREATEFILE '$ CLOSE YOW', "\n"; - print CREATEFILE "\$EXIT\n"; - close CREATEFILE; - $throwaway = `\@\[\]foo`, "\n"; - open(TEMPFILE, ">./foo.bar") or print "# open failed $! $^E\n"; - print TEMPFILE "foo\nfoobar\nbaz\n"; - close TEMPFILE; - - open TESTFILE, "<./foo.bar"; - $/ = \10; - $bar = <TESTFILE>; - if ($bar eq "foo\n") {print "ok 11\n";} else {print "not ok 11\n";} - $bar = <TESTFILE>; - if ($bar eq "foobar\n") {print "ok 12\n";} else {print "not ok 12\n";} - # can we do a short read? - $/ = \2; - $bar = <TESTFILE>; - if ($bar eq "ba") {print "ok 13\n";} else {print "not ok 13\n";} - # do we get the rest of the record? - $bar = <TESTFILE>; - if ($bar eq "z\n") {print "ok 14\n";} else {print "not ok 14\n";} - - close TESTFILE; - 1 while unlink qw(foo.bar foo.com foo.fdl); -} else { - # Nobody else does this at the moment (well, maybe OS/390, but they can - # put their own tests in) so we just punt - foreach $test (11..14) {print "ok $test # skipped on non-VMS system\n"}; -} diff --git a/contrib/perl5/t/base/term.t b/contrib/perl5/t/base/term.t deleted file mode 100755 index 818eb71..0000000 --- a/contrib/perl5/t/base/term.t +++ /dev/null @@ -1,55 +0,0 @@ -#!./perl - -# $RCSfile: term.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:07 $ - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - -use Config; - -print "1..7\n"; - -# check "" interpretation - -$x = "\n"; -# 10 is ASCII/Iso Latin, 21 is EBCDIC. -if ($x eq chr(10) || - ($Config{ebcdic} eq 'define' && $x eq chr(21))) {print "ok 1\n";} -else {print "not ok 1\n";} - -# check `` processing - -$x = `echo hi there`; -if ($x eq "hi there\n") {print "ok 2\n";} else {print "not ok 2\n";} - -# check $#array - -$x[0] = 'foo'; -$x[1] = 'foo'; -$tmp = $#x; -print "#3\t:$tmp: == :1:\n"; -if ($#x == '1') {print "ok 3\n";} else {print "not ok 3\n";} - -# check numeric literal - -$x = 1; -if ($x == '1') {print "ok 4\n";} else {print "not ok 4\n";} - -$x = '1E2'; -if (($x | 1) == 101) {print "ok 5\n";} else {print "not ok 5\n";} - -# check <> pseudoliteral - -open(try, "/dev/null") || open(try,"nla0:") || (die "Can't open /dev/null."); -if (<try> eq '') { - print "ok 6\n"; -} -else { - print "not ok 6\n"; - die "/dev/null IS NOT A CHARACTER SPECIAL FILE!!!!\n" unless -c '/dev/null'; -} - -open(try, "harness") || (die "Can't open harness."); -if (<try> ne '') {print "ok 7\n";} else {print "not ok 7\n";} |