[gsoc_spectest] Test reorganization.

git-svn-id: http://svn.pugscode.org/pugs@20547 c213334d-75ef-0310-aa23-eaa082d1ae64

S02-magicals/block.t

@@ -0,0 +1,20 @@
+use v6;
+
+use Test;
+
+=pod
+
+This tests the &?BLOCK magical from Synoposis 6
+
+L<S06/The C<&?BLOCK> object>
+
+=cut
+
+plan 1;
+
+# L<S02/Names/Which block am I in?>
+# L<S06/The C<&?BLOCK> object/tail-recursion on an anonymous block:>
+my $anonfactorial = -> Int $n { $n < 2 ?? 1 !! $n * &?BLOCK($n-1) };
+
+my $result = $anonfactorial(3);
+is($result, 6, 'the $?BLOCK magical worked');

S02-magicals/dollar_bang.t

@@ -0,0 +1,46 @@
+use v6;
+
+use Test;
+
+plan 8;
+
+=head1 DESCRIPTION
+
+This test tests the C<$!> builtin.
+
+=cut
+
+# L<S04/"Exceptions"/"A bare die/fail takes $! as the default argument.">
+
+try { &nonexisting_subroutine() };
+ok $!, 'Calling a nonexisting subroutine sets $!';
+
+undefine $!;
+try { nonexisting_subroutine; };
+ok $!, 'Calling a nonexisting subroutine sets $!';
+
+undefine $!;
+my $called;
+sub foo(Str $s) { return $called++ };
+my @a;
+try { foo(@a,@a) };
+ok $!, 'Calling a subroutine with a nonmatching signature sets $!';
+ok !$called, 'The subroutine also was not called';
+
+undefine $!;
+try { 1 / 0 };
+ok $!, 'Dividing one by zero sets $!';
+
+sub incr ( $a is rw ) { $a++ };
+undefine $!;
+try { incr(19) };
+ok $!, 'Modifying a constant sets $!';
+
+try {
+    try {
+        die 'qwerty';
+    }
+    ok ~($!) ~~ /qwerty/, 'die sets $! properly';
+    die; # use the default argument
+}
+ok ~($!) ~~ /qwerty/, 'die without argument uses $! properly';

S02-magicals/env.t

@@ -0,0 +1,130 @@
+use v6;
+
+# Tests for magic variables
+
+use Test;
+# L<S02/Names/environment variables passed to program>
+plan 14;
+
+if $*OS eq "browser" {
+  skip_rest "Programs running in browsers don't have access to regular IO.";
+  exit;
+}
+
+=kwid
+
+= DESCRIPTION
+
+Tests for %*ENV
+
+Tests that C<%*ENV> can be read and written to and that
+child processes see the modified C<%*ENV>.
+
+=cut
+
+# It must not be empty at startup.
+ok +%*ENV.keys, '%*ENV has keys';
+
+# %*ENV should be able to get copied into another variable.
+my %vars = %*ENV;
+is +%vars.keys, +%*ENV.keys, '%*ENV was successfully copied into another variable';
+
+# XXX: Should modifying %vars affect the environment? I don't think so, but, of
+# course, feel free to change the following test if I'm wrong.
+%vars<PATH> = "42";
+ok %*ENV<PATH> ne "42",
+  'modifying a copy of %*ENV didn\'t affect the environment';
+
+# Similarily, I don't think creating a new entry in %vars should affect the
+# environment:
+diag '%*ENV<PUGS_ROCKS>=' ~ %*ENV<PUGS_ROCKS>;
+ok !defined(%*ENV<PUGS_ROCKS>), "there's no env variable 'PUGS_ROCKS'";
+%vars<PUGS_ROCKS> = "42";
+diag '%*ENV<PUGS_ROCKS>=' ~ %*ENV<PUGS_ROCKS>;
+ok !defined(%*ENV<PUGS_ROCKS>), "there's still no env variable 'PUGS_ROCKS'";
+
+my ($redir,$squo) = (">", "'");
+
+my $expected = 'Hello from subprocess';
+%*ENV<PUGS_ROCKS> = $expected;
+# Note that the "?" preceeding the "(" is necessary, because we need a Bool,
+# not a junction of Bools.
+is %*ENV<PUGS_ROCKS>, $expected,'%*ENV is rw';
+
+my $tempfile = "temp-ex-output." ~ $*PID ~ "." ~ rand 1000;
+
+my $command = qq!$*EXECUTABLE_NAME -e "\%*ENV.perl.say" $redir $tempfile!;
+diag $command;
+system $command;
+
+my $child_env = slurp $tempfile;
+my %child_env = eval $child_env;
+unlink $tempfile;
+
+my $err = 0;
+for %*ENV.kv -> $k,$v {
+  # Ignore env vars which bash and maybe other shells set automatically.
+  next if $k eq any <SHLVL _ OLDPWD PS1>;
+  if (%child_env{$k} !~~ $v) {
+    if (! $err) {
+      flunk("Environment gets propagated to child.");
+      $err++;
+    };
+    diag "Expected: $k=$v";
+    diag "Got:      $k=%child_env{$k}";
+  } else {
+    # diag "$k=$v";
+  };
+};
+if (! $err) {
+  ok(1,"Environment gets propagated to child.");
+};
+
+%*ENV.delete('PUGS_ROCKS');
+is(%*ENV<PUGS_ROCKS>,undef,'We can remove keys from %*ENV');
+
+my $command = qq!$*EXECUTABLE_NAME -e "\%*ENV.perl.say" $redir $tempfile!;
+diag $command;
+system $command;
+
+my $child_env = slurp $tempfile;
+my %child_env = eval $child_env;
+unlink $tempfile;
+
+is(%child_env<PUGS_ROCKS>,undef,'The child did not see %*ENV<PUGS_ROCKS>');
+
+my $err = 0;
+for %*ENV.kv -> $k,$v {
+  # Ignore env vars which bash and maybe other shells set automatically.
+  next if $k eq any <SHLVL _ OLDPWD PS1>;
+  if (%child_env{$k} !~~ $v) {
+    if (! $err) {
+      flunk("Environment gets propagated to child.");
+      $err++;
+    };
+    diag "Expected: $k=$v";
+    diag "Got:      $k=%child_env{$k}";
+  } else {
+    # diag "$k=$v";
+  };
+};
+if (! $err) {
+  ok(1,"Environment gets propagated to child.");
+};
+
+ok !%*ENV.exists("does_not_exist"), "exists() returns false on a not defined env var";
+
+# %ENV must not be imported by default
+my $x = eval "%ENV";
+ok $! ~~ m:P5/Undeclared/, '%ENV not visible by default', :todo<bug>;
+
+# following doesn't parse yet
+{
+    # It must be importable
+    use GLOBAL <%ENV>;
+    ok +%ENV.keys, 'imported %ENV has keys';
+}
+# Importation must be lexical
+$x = eval "%ENV";
+ok $! ~~ m:P5/Undeclared/, '%ENV not visible by after lexical import scope', :todo<bug>;
+1;

S02-magicals/file_line.t

@@ -0,0 +1,16 @@
+use v6;
+
+
+use Test;
+
+plan 2;
+
+# L<S02/Names/Which line am I at>
+is($?LINE, 9, '$?LINE works');
+
+# L<S02/Names/Which file am I in>
+ok($?FILE eq ('t/spec/S02-magicals/file_line.t' | 't\\spec\\S02-magicals\\file_line.t'), '$?FILE works');
+
+# NOTE:
+# above is a junction hack for Unix and Win32 file 
+# paths until the FileSpec hack is working - Stevan

S02-magicals/pid.t

@@ -0,0 +1,42 @@
+use v6;
+
+use Test;
+
+=kwid
+
+= DESCRIPTION
+
+Test that C< $*PID > in this process is different from
+C< $*PID > in the child process.
+L<A05/"RFC 332: Regex: Make /\$/ equivalent to /\z/ under the '/s' modifier" /The current process id is now C<\$\*PID>/>
+=cut
+
+plan 1;
+
+if $*OS eq "browser" {
+  skip_rest "Programs running in browsers don't have access to \$*PID.";
+  exit;
+}
+
+my ($pugs,$redir,$squo) = ($*EXECUTABLE_NAME, ">", "'");
+
+# if it's non-perl5 js backend the test would have been skipped already
+$pugs = './runjs.pl --run=jspm --perl5'
+    if $?PUGS_BACKEND eq 'BACKEND_JAVASCRIPT';
+
+if $*OS eq any <MSWin32 mingw msys cygwin> {
+    $pugs = 'pugs.exe';
+};
+
+sub nonce () { return (".$*PID." ~ int rand 1000) }
+my $tempfile = "temp-ex-output" ~ nonce;
+
+my $command = $pugs ~ q! -e 'say $PID'! ~ qq!$redir $tempfile!;
+diag $command;
+system $command;
+
+my $child_pid = slurp $tempfile;
+$child_pid .= chomp;
+unlink $tempfile;
+
+ok $*PID ne $child_pid, "My PID differs from the child pid ($*PID != $child_pid)";

S02-magicals/progname.t

@@ -0,0 +1,16 @@
+use v6;
+
+use Test;
+
+plan 1;
+
+if $*OS eq "browser" {
+  skip_rest "Programs running in browsers don't have access to regular IO.";
+  exit;
+}
+
+ok($*PROGRAM_NAME eq ('t/spec/S02-magicals/progname.t' | 't\\spec\\S02-magicals\\progname.t'), "progname var matches test file path");
+
+# NOTE:
+# above is a junction hack for Unix and Win32 file 
+# paths until the FileSpec hack is working - Stevan

S02-magicals/sub.t

@@ -0,0 +1,29 @@
+use v6;
+
+use Test;
+
+=pod
+
+This tests the &?ROUTINE magical value
+
+=cut
+
+plan 4;
+
+# L<S06/The C<&?ROUTINE> object>
+# L<S02/Names/Which routine am I in>
+sub factorial { @_[0] < 2 ?? 1 !! @_[0] * &?ROUTINE(@_[0] - 1) }
+
+my $result1 = factorial(3);
+is($result1, 6, 'the &?ROUTINE magical works correctly');
+
+my $factorial = sub { @_[0] < 2 ?? 1 !! @_[0] * &?ROUTINE(@_[0] - 1) };
+my $result2 = $factorial(3);
+is($result2, 6, 'the &?ROUTINE magical works correctly in anon-subs');
+
+sub postfix:<!!!> (Int $n) { $n < 2 ?? 1 !! $n * &?ROUTINE($n - 1) }
+my $result3 = 3!!!;
+is($result3, 6, 'the &?ROUTINE magical works correctly in overloaded operators' );
+
+my $baz = try { &?ROUTINE };
+ok(defined($baz), '&?ROUTINE is defined for the MAIN routine');

S02-magicals/subname.t

@@ -0,0 +1,24 @@
+use v6;
+
+use Test;
+
+plan 4;
+
+
+# L<S06/The C<&?ROUTINE> object/current routine name>
+# L<S02/Names/Which routine am I in>
+sub foo { return &?ROUTINE.name }
+is(foo(), '&Main::foo', 'got the right routine name in the default package');
+
+{
+    # This testcase might be really redundant
+    package Bar;
+    sub bar { return &?ROUTINE.name }
+    is(bar(), '&Bar::bar', 'got the right routine name outside the default package');
+};
+
+my $bar = sub { return &?ROUTINE.name };
+is($bar(), '<anon>', 'got the right routine name (anon-block)');
+
+my $baz = try { &?ROUTINE.name };
+ok(not(defined $baz), '&?ROUTINE.name not defined outside of a routine');