Project: Pugs

Revision: 22156

Author: moritz

Date: 04 Sep 2008 14:17:37

• /t/spec/S05-mass/pge-tests.t

  ......	@@ -0,0 +1,68 @@
  	1	use Test;
  	2
  	3	# This is specific to rakudo, and SOOO ugly. I will say no more than that,
  	4	# otherwise I could spend days ranting about how stupid this all is --moritz
  	5
  	6	my $contents = slurp('t/spec/S05-mass/pge_tests');
  	7	my @lines = split("\n", $contents);
  	8	@lines = grep { .substr(0, 1) ne '#' }, @lines;
  	9	@lines = grep { .chars > 2 }, @lines;
  	10	plan +@lines;
  	11	my $count = +@lines;
  	12
  	13	my $count = 0;
  	14	my $skip = any(92, 108, 109, 118, 122 .. 128, 156 .. 161,
  	15	213 .. 225, 241, 243, 245, 254 .. 260, 265 .. 280,
  	16	411, 445, 447, 449, 467, 472,
  	17	);
  	18
  	19	my $todo = any( 25, 26, 27, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
  	20	41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57,
  	21	58, 59, 60, 61, 62, 63, 66, 67, 68, 69, 70, 71, 91, 119, 121, 135,
  	22	138, 150, 155, 162, 163, 164, 165, 166, 182, 196, 197, 198, 201, 208,
  	23	212, 227, 229, 231, 281, 284, 285, 288, 289, 296, 298, 299, 306, 308,
  	24	309, 316, 318, 319, 326, 451, 459, 470, 471, 477, 478, 480, 481, 482,
  	25	483, 484, 485, 486, 487, 489, 490, 492, 493, 494, 496, 497, 498, 499,
  	26	500, 501, 502, 503, 504, 505, 507, 508, 510, 511, 512, 514, 515, 516,
  	27	517, 518, 519, 520, 521, 522, 523, 525, 526, 528, 529, 530, 532, 533,
  	28	534, 535, 536, 537, 538, 539, 540, 541, 543, 544, 546, 547, 548, 550,
  	29	551, 552, 553, 554, 555, 556, 557, 558, 559, 561, 562, 564, 565, 566,
  	30	568, 569, 570, 571, 572, 575, 576,
  	31	);
  	32
  	33	my $segfault_limit = 500;
  	34	do_tests($segfault_limit);
  	35	my $remaining = @lines - $segfault_limit;
  	36
  	37	skip($remaining, 'Tests would segfault :(');
  	38
  	39
  	40	sub do_tests ($segfault_limit) {
  	41	for @lines -> $line {
  	42	$count++;
  	43	if $count > $segfault_limit {
  	44	return;
  	45	}
  	46	my @st = split("\t", $line);
  	47	# weed out empty fields, since we can't split on \t+ yet
  	48	my @s;
  	49	for @st {
  	50	@s.push($_) if .chars > 0;
  	51	}
  	52	my $regex = @s[0];
  	53	my $teststr = @s[1];
  	54	$teststr = '' if $teststr eq "''";
  	55	my $match = (@s[2] eq 'y');
  	56	my $descr = @s[3];
  	57	if ( $count == $skip ) {
  	58	skip(1, "parse/match failure");
  	59	} else {
  	60	# diag "matching '$regex' against '$teststr' with expected result '$match'";
  	61	todo("unkown") if $count == $todo;
  	62	my $result = eval "'$teststr' ~~ /$regex/";
  	63	ok !($result xor $match), $descr;
  	64	}
  	65	}
  	66	}
  	67
  	68	# vim: ft=perl6

• /t/spec/S05-mass/pge-tests.pl

  ......	@@ -1,68 +0,0 @@
  1		use Test;
  2
  3		# This is specific to rakudo, and SOOO ugly. I will say no more than that,
  4		# otherwise I could spend days ranting about how stupid this all is --moritz
  5
  6		my $contents = slurp('t/spec/S05-mass/pge_tests');
  7		my @lines = split("\n", $contents);
  8		@lines = grep { .substr(0, 1) ne '#' }, @lines;
  9		@lines = grep { .chars > 2 }, @lines;
  10		plan +@lines;
  11		my $count = +@lines;
  12
  13		my $count = 0;
  14		my $skip = any(92, 108, 109, 118, 122 .. 128, 156 .. 161,
  15		213 .. 225, 241, 243, 245, 254 .. 260, 265 .. 280,
  16		411, 445, 447, 449, 467, 472,
  17		);
  18
  19		my $todo = any( 25, 26, 27, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
  20		41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57,
  21		58, 59, 60, 61, 62, 63, 66, 67, 68, 69, 70, 71, 91, 119, 121, 135,
  22		138, 150, 155, 162, 163, 164, 165, 166, 182, 196, 197, 198, 201, 208,
  23		212, 227, 229, 231, 281, 284, 285, 288, 289, 296, 298, 299, 306, 308,
  24		309, 316, 318, 319, 326, 451, 459, 470, 471, 477, 478, 480, 481, 482,
  25		483, 484, 485, 486, 487, 489, 490, 492, 493, 494, 496, 497, 498, 499,
  26		500, 501, 502, 503, 504, 505, 507, 508, 510, 511, 512, 514, 515, 516,
  27		517, 518, 519, 520, 521, 522, 523, 525, 526, 528, 529, 530, 532, 533,
  28		534, 535, 536, 537, 538, 539, 540, 541, 543, 544, 546, 547, 548, 550,
  29		551, 552, 553, 554, 555, 556, 557, 558, 559, 561, 562, 564, 565, 566,
  30		568, 569, 570, 571, 572, 575, 576,
  31		);
  32
  33		my $segfault_limit = 500;
  34		do_tests($segfault_limit);
  35		my $remaining = @lines - $segfault_limit;
  36
  37		skip($remaining, 'Tests would segfault :(');
  38
  39
  40		sub do_tests ($segfault_limit) {
  41		for @lines -> $line {
  42		$count++;
  43		if $count > $segfault_limit {
  44		return;
  45		}
  46		my @st = split("\t", $line);
  47		# weed out empty fields, since we can't split on \t+ yet
  48		my @s;
  49		for @st {
  50		@s.push($_) if .chars > 0;
  51		}
  52		my $regex = @s[0];
  53		my $teststr = @s[1];
  54		$teststr = '' if $teststr eq "''";
  55		my $match = (@s[2] eq 'y');
  56		my $descr = @s[3];
  57		if ( $count == $skip ) {
  58		skip(1, "parse/match failure");
  59		} else {
  60		# diag "matching '$regex' against '$teststr' with expected result '$match'";
  61		todo("unkown") if $count == $todo;
  62		my $result = eval "'$teststr' ~~ /$regex/";
  63		ok !($result xor $match), $descr;
  64		}
  65		}
  66		}
  67
  68		# vim: ft=perl6