From: Lukas Mai <l.mai@web.de>
Date: Sat, 6 Aug 2011 05:23:51 +0000 (+0200)
Subject: test generated line numbers
X-Git-Tag: v0.05_01~9^2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d5ac8da0a2685c743fa908b5264b26477b67c046;p=p5sagit%2FFunction-Parameters.git

test generated line numbers
---

diff --git a/t/lineno-torture.t b/t/lineno-torture.t
new file mode 100644
index 0000000..cdbf4fb
--- /dev/null
+++ b/t/lineno-torture.t
@@ -0,0 +1,249 @@
+use warnings;
+use strict;
+
+use Test::More;
+
+use Function::Parameters;
+
+fun actual_location_of_line_with($marker) {
+	seek DATA, 0, 0 or die "seek DATA: $!";
+	my $loc = 0;
+	while (my $line = readline DATA) {
+		$loc++;
+		index($line, $marker) >= 0
+			and return $loc;
+	}
+	undef
+}
+
+fun test_loc($marker) {
+	my $expected = actual_location_of_line_with $marker;
+	defined $expected or die "$marker: something done fucked up";
+	my $got = (caller)[2];
+	is $got, $expected, "location of '$marker'";
+}
+
+sub {
+	test_loc 'LT torture begin';
+	use integer;
+	my $r = shift;
+
+	my $a = shift;
+	my $b = shift;
+
+	test_loc 'LT torture A';
+	@_ = (
+		sub {
+			my $f = shift;
+			test_loc 'LT torture B';
+			@_ = (
+				sub {
+					my $f = shift;
+					test_loc 'LT torture C';
+					@_ = (
+						sub {
+							my $f = shift;
+							test_loc 'LT torture D';
+							@_ = (
+								sub {
+									my $n = shift;
+									test_loc 'LT torture end';
+									@_ = $n;
+									goto &$r;
+								},
+								$b
+							);
+							goto &$f;
+						},
+						$a
+					);
+					goto &$f;
+				},
+				sub {
+					my $r = shift;
+					my $f = shift;
+					@_ = sub {
+						my $r = shift;
+						my $x = shift;
+						@_ = sub {
+							my $r = shift;
+							my $y = shift;
+							test_loc 'LT torture body';
+							if ($x && $y) {
+								@_ = (
+									sub {
+										my $f = shift;
+										@_ = ($r, ($x & $y) << 1);
+										goto &$f;
+									},
+									$x ^ $y
+								);
+								goto &$f;
+							}
+							@_ = $x ^ $y;
+							goto &$r;
+						};
+						goto &$r;
+					};
+					goto &$r;
+				}
+			);
+			goto &$f;
+		},
+		sub {
+			my $r = shift;
+			my $y = shift;
+			@_ = sub {
+				my $r = shift;
+				my $f = shift;
+				@_ = sub {
+					my $r = shift;
+					my $x = shift;
+					@_ = (
+						sub {
+							my $f = shift;
+							@_ = ($r, $x);
+							goto &$f;
+						},
+						sub {
+							my $r = shift;
+							my $x = shift;
+							@_ = (
+								sub {
+									my $g = shift;
+									@_ = (
+										sub {
+											my $f = shift;
+											@_ = ($r, $x);
+											goto &$f;
+										},
+										$f
+									);
+									goto &$g;
+								},
+								$y
+							);
+							goto &$y;
+						}
+					);
+					goto &$f;
+				};
+				goto &$r;
+			};
+			goto &$r;
+		}
+	);
+
+	goto & {
+		sub {
+			my $r = shift;
+			my $f = shift;
+			test_loc 'LT torture boot';
+			@_ = ($r, $f);
+			goto &$f;
+		}
+	};
+
+}->(sub { my $n = shift; is $n, 2, '1 + 1 = 2' }, 1, 1);
+
+TODO: {
+	local $TODO = 'line numbers all fucked up';
+
+	fun ($r, $a, $b) {
+		test_loc 'LX torture begin';
+		use integer;
+		test_loc 'LX torture A';
+		@_ = ( do { test_loc 'LX torture A-post'; () },
+			do { test_loc 'LX torture B-pre'; () }, fun ($f) { test_loc 'LX torture B-pre';
+				test_loc 'LX torture B';
+				@_ = (
+					fun ($f) {
+						test_loc 'LX torture C';
+						@_ = (
+							fun ($f) {
+								test_loc 'LX torture D';
+								@_ = (
+									fun ($n) {
+										test_loc 'LX torture end';
+										@_ = $n;
+										goto &$r;
+									},
+									$b
+								);
+								goto &$f;
+							},
+							$a
+						);
+						goto &$f;
+					},
+					fun ($r, $f) {
+						@_ = fun ($r, $x) {
+							@_ = fun ($r, $y) {
+								test_loc 'LX torture body';
+								if ($x && $y) {
+									@_ = (
+										fun ($f) {
+											@_ = ($r, ($x & $y) << 1);
+											goto &$f;
+										},
+										$x ^ $y
+									);
+									goto &$f;
+								}
+								@_ = $x ^ $y;
+								goto &$r;
+							};
+							goto &$r;
+						};
+						goto &$r;
+					}
+				);
+				goto &$f;
+			},
+			fun ($r, $y) {
+				@_ = fun ($r, $f) {
+					@_ = fun ($r, $x) {
+						@_ = (
+							fun ($f) {
+								@_ = ($r, $x);
+								goto &$f;
+							},
+							fun ($r, $x) {
+								@_ = (
+									fun ($g) {
+										@_ = (
+											fun ($f) {
+												@_ = ($r, $x);
+												goto &$f;
+											},
+											$f
+										);
+										goto &$g;
+									},
+									$y
+								);
+								goto &$y;
+							}
+						);
+						goto &$f;
+					};
+					goto &$r;
+				};
+				goto &$r;
+			}
+		);
+
+		goto & {
+			fun ($r, $f) {
+				test_loc 'LX torture boot';
+				@_ = ($r, $f);
+				goto &$f;
+			}
+		};
+
+	}->(fun ($n) { is $n, 2, '1 + 1 = 2' }, 1, 1);
+
+}
+
+done_testing;
+__DATA__
diff --git a/t/lineno.t b/t/lineno.t
new file mode 100644
index 0000000..40ac0be
--- /dev/null
+++ b/t/lineno.t
@@ -0,0 +1,63 @@
+use warnings;
+use strict;
+
+use Test::More tests => 8;
+
+use Function::Parameters;
+
+fun actual_location_of_line_with($marker) {
+	seek DATA, 0, 0 or die "seek DATA: $!";
+	my $loc = 0;
+	while (my $line = readline DATA) {
+		$loc++;
+		index($line, $marker) >= 0
+			and return $loc;
+	}
+	undef
+}
+
+fun test_loc($marker) {
+	my $expected = actual_location_of_line_with $marker;
+	defined $expected or die "$marker: something done fucked up";
+	my $got = (caller)[2];
+	is $got, $expected, "location of '$marker'";
+}
+
+fun () {
+	test_loc 'LX simple';
+}->();
+
+test_loc 'LX -- 1';
+
+fun 
+ (
+   )
+     {
+	test_loc 'LX creative formatting'; }
+->
+(
+ );
+
+test_loc 'LX -- 2';
+
+fun () {
+	fun () {
+		test_loc 'LX nested';
+	}->()
+}->();
+
+test_loc 'LX -- 3';
+
+TODO: {
+	local $TODO = 'expressions break line numbers???';
+
+	0
+	, fun {
+			test_loc 'LX assign';
+		}->()
+	;
+
+	test_loc 'LX -- 4';
+}
+
+__DATA__