Permalink
Browse files

[STD] various bugs

[t/spec] various bugs
Now parses 95% (cheating on postfix:<!>)


git-svn-id: http://svn.pugscode.org/pugs@21484 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information...
1 parent 3604100 commit ea2ee24f110635dfa2414290ab9765a90aeadb6e lwall committed Jul 24, 2008
Showing with 64 additions and 74 deletions.
  1. +3 −3 S02-builtin_data_types/hash.t
  2. +4 −4 S04-statements/for.t
  3. +26 −26 S29-os/system-with-spaces.t
  4. +31 −41 S29-scalar/undef.t
@@ -127,7 +127,7 @@ is($key, 1, '%hash.kv gave us our key');
is($val, 2, '%hash.kv gave us our val');
%hash9{2} = 3;
-like(~%hash9, rx:perl5/1\s+2\s+2\s+3/, "hash can stringify");
+like(~%hash9, rx:Perl5/1\s+2\s+2\s+3/, "hash can stringify");
my %hash10 = <1 2>;
is(%hash10<1>, 2, "assignment of pointy qw to hash");
@@ -139,7 +139,7 @@ sub test1{
is(%sane.WHAT,'Hash','%sane is a Hash');
}
-sub test2 (Hash %hash) returns Void{
+sub test2 (Hash %hash) returns Void {
is(%hash.WHAT,'Hash','%hash is a Hash');
}
@@ -169,5 +169,5 @@ $i = 0;
$i++ for %hash; # segfaults
is $i, 4, "for %hash works";
-try{ @%(a => <b>)<a> };
+eval ' @%(a => <b>)<a> ';
ok( $!, "doesn't really make sense, but shouldn't segfault, either ($!)");
View
@@ -229,7 +229,7 @@ my @elems = <a b c d e>;
my @array_v = (0..2);
my @v = (1..3);
for @array_v.values -> $val is rw { $val++ };
- is(@array_v, @v, 'for @array.values -> $val is rw { $val++ }';
+ is(@array_v, @v, 'for @array.values -> $val is rw { $val++ }');
}
#?pugs eval 'todo'
@@ -317,16 +317,16 @@ my @elems = <a b c d e>;
{
my $a = '';
- for 1..3, 4..6 { $a =~ $_.WHAT };
+ for 1..3, 4..6 { $a ~~ $_.WHAT };
#?rakudo todo 'type is incorrect'
is($a, 'IntIntIntIntIntInt', 'List context');
$a = '';
- for [1..3, 4..6] { $a =~ $_.WHAT };
+ for [1..3, 4..6] { $a ~~ $_.WHAT };
is($a, 'Array', 'List context');
$a = '';
- for [1..3], [4..6] { $a =~ $_.WHAT };
+ for [1..3], [4..6] { $a ~~ $_.WHAT };
#?rakudo todo 'type is incorrect'
is($a, 'ArrayArray', 'List context');
}
@@ -77,32 +77,32 @@ my @command = (
"$cwd/$exex",
"$cwdb\\$exeb",
"$cwdb\\$exebx",
- #"$bat",
- #"$batx",
- #"$batb",
- #"$batbx",
- #"./$bat",
- #"./$batx",
- #".\\$batb",
- #".\\$batbx",
- #"$cwd/$bat",
- #"$cwd/$batx",
- #"$cwdb\\$batb",
- #"$cwdb\\$batbx",
- #"$cmdx",
- #"$cmdbx",
- #"./$cmdx",
- #"\\$cmdbx",
- #"$cwd/$cmdx",
- #"$cwdb\\$cmdbx",
- #[$INTERPRETER, $batx],
- #[$INTERPRETER, $batbx],
- #[$INTERPRETER, "./$batx"],
- #[$INTERPRETER, ".\\$batbx"],
- #[$INTERPRETER, "$cwd/$batx"],
- #[$INTERPRETER, "$cwdb\\$batbx"],
- #[$INTERPRETER, "-w", "$cwdb\\$batbx"],
- #[$pugs,'-e',q!say('['~$*PROGRAM_NAME~']['~@*ARGS.join('][')~']')!],
+ # "$bat",
+ # "$batx",
+ # "$batb",
+ # "$batbx",
+ # "./$bat",
+ # "./$batx",
+ # ".\\$batb",
+ # ".\\$batbx",
+ # "$cwd/$bat",
+ # "$cwd/$batx",
+ # "$cwdb\\$batb",
+ # "$cwdb\\$batbx",
+ # "$cmdx",
+ # "$cmdbx",
+ # "./$cmdx",
+ # "\\$cmdbx",
+ # "$cwd/$cmdx",
+ # "$cwdb\\$cmdbx",
+ # [$INTERPRETER, $batx],
+ # [$INTERPRETER, $batbx],
+ # [$INTERPRETER, "./$batx"],
+ # [$INTERPRETER, ".\\$batbx"],
+ # [$INTERPRETER, "$cwd/$batx"],
+ # [$INTERPRETER, "$cwdb\\$batbx"],
+ # [$INTERPRETER, "-w", "$cwdb\\$batbx"],
+ # [$pugs,'-e',q!say('['~$*PROGRAM_NAME~']['~@*ARGS.join('][')~']')!],
[$pugs,$plx],
[$pugs,$plxb],
);
View
@@ -204,59 +204,49 @@ Perl6-specific tests
# L<S05/Match objects/"they will all be undefined" closure
# "let keyword">
-if !eval('("a" ~~ /a/)') {
- skip 8, "skipped tests - rules support appears to be missing";
-}
-else {
- # - unmatched alternative should bind to undef
- my($num, $alpha);
- my($rx1, $rx2);
- eval '
- $rx1 = rx
- / [ (\d+) { let $<num> := $0 }
- | (<alpha>+) { let $<alpha> := $1 }
- ]
- /;
- $rx2 = rx
- / [ $<num> := (\d+)
- | $<alpha>:= (<alpha>+)
- ]
- /;
- ';
- for (<rx1 rx2>) {
- # I want symbolic lookups because I need the rx names for test results.
-
- eval '"1" ~~ %MY::{$_}';
+# - unmatched alternative should bind to undef
+my($num, $alpha);
+my($rx1, $rx2);
+eval '
+ $rx1 = rx
+ / [ (\d+) { let $<num> := $0 }
+ | (<alpha>+) { let $<alpha> := $1 }
+ ]
+ /;
+ $rx2 = rx
+ / [ $<num> := (\d+)
+ | $<alpha>:= (<alpha>+)
+ ]
+ /;
+';
+for (<rx1 rx2>) {
+ # I want symbolic lookups because I need the rx names for test results.
+
+ eval '"1" ~~ %MY::{$_}';
#?pugs todo 'unimpl'
- ok(defined($num), '{$_}: successful hypothetical');
- ok(!defined($alpha), '{$_}: failed hypothetical');
+ ok(defined($num), '{$_}: successful hypothetical');
+ ok(!defined($alpha), '{$_}: failed hypothetical');
- eval '"A" ~~ %MY::{$_}';
- ok(!defined($num), '{$_}: failed hypothetical (2nd go)');
+ eval '"A" ~~ %MY::{$_}';
+ ok(!defined($num), '{$_}: failed hypothetical (2nd go)');
#?pugs todo 'unimpl'
- ok(defined($alpha), '{$_}: successful hypothetical (2nd go)');
- }
+ ok(defined($alpha), '{$_}: successful hypothetical (2nd go)');
}
-
-if ! eval '"a" ~~ /a/' {
- skip 2, "skipped tests - rules support appears to be missing";
-}
-else {
- # - binding to hash keys only would leave values undef
- eval '"a=b\nc=d\n" ~~ / $<matches> := [ (\w) = \N+ ]* /';
+# - binding to hash keys only would leave values undef
+eval '"a=b\nc=d\n" ~~ / $<matches> := [ (\w) = \N+ ]* /';
#?pugs todo 'unimpl'
- ok(eval('$<matches> ~~ all(<a b>)'), "match keys exist");
+ok(eval('$<matches> ~~ all(<a b>)'), "match keys exist");
- #ok(!defined($<matches><a>) && !defined($<matches><b>), "match values don't");
+#ok(!defined($<matches><a>) && !defined($<matches><b>), "match values don't");
#?pugs todo 'unimpl'
- ok(0 , "match values don't");
+ok(0 , "match values don't");
{
# - $0, $1 etc. should all be undef after a failed match
# (except for special circumstances)
- "abcde" ~~ rx:perl5/(.)(.)(.)/;
- "abcde" ~~ rx:perl5/(\d)/;
+ "abcde" ~~ rx:Perl5/(.)(.)(.)/;
+ "abcde" ~~ rx:Perl5/(\d)/;
ok((!try { grep { defined($_) }, ($0, $1, $2, $3, $4, $5) }),
"all submatches undefined after failed match") or
diag("match state: " ~ eval '$/');

0 comments on commit ea2ee24

Please sign in to comment.