manakai/t/util-error.t

#!/usr/bin/perl
use strict;
use Message::Util::Error;
use Test;
plan tests => 11;

try {
  throw Message::Util::Error -type => 'SOMETHING_UNKNOWN';
} catch Message::Util::Error with {
  my $err = shift;
  warn $err->stringify if $^W;
  ok $err->text, qq("SOMETHING_UNKNOWN": Unknown error);
} except {
  ok 1, 0;
} otherwise {
  ok 1, 0;
} finally {
  ok 1, 1;
};
ok 1, 1;

try {
  throw test_error -type => 'ERR1', param1 => 'VAL1', param2 => 'VAL2';
} catch test_error with {
  my $err = shift;
  ok $err->text, qq(Param1 "VAL1"; Param2 "VAL2");
};

package test_error;
BEGIN {
our @ISA = 'Message::Util::Error';
}
sub ___error_def () {+{
  ERR1 => {
    description => q(Param1 "%t(name=>param1);"; Param2 "%t(name=>param2);"),
  },
  fatal => {
    description => q(fatal error),
  },
  warn => {
    description => q(warn msg),
  },
}}

package test_report;
BEGIN {
our @ISA = 'test_error';
}

package test_pack1;
#line 1 "pack1"

sub t {
  throw test_error -type => 'ERR1', param1 => 1, param2 => 2;
}
sub r {
  report test_error -type => 'ERR1', param1 => 1, param2 => 2;
}

sub rw {
  report test_error -type => 'warn', -object => bless {};
}
sub rf {
  report test_error -type => 'fatal', -object => bless {};
}

sub ___report_error ($$;%) {
  my ($pack1, $err, %opt) = @_;
#  if ($err->{-type} eq 'fatal') {
    $err->throw;
#  } else {
#    
#  }
}

package test_pack2;
#line 1 "pack2"

sub t {
  local $Error::Depth = $Error::Depth + 1;
  throw test_error -type => 'ERR1', param1 => 1, param2 => 2;
}
sub r {
  local $Error::Depth = $Error::Depth + 1;
  report test_error -type => 'ERR1', param1 => 1, param2 => 2;
}

package test_pack3;
#line 1 "pack3"
push our @ISA, 'test_pack1';

sub t {
  local $Error::Depth = $Error::Depth + 1;
  shift->SUPER::t (@_);
}
sub r {
  local $Error::Depth = $Error::Depth + 1;
  shift->SUPER::r (@_);
}

sub rf {
  local $Error::Depth = $Error::Depth + 1;
  shift->SUPER::rf (@_);
}

package main;
#line 1 "main"

try {
  test_pack1->t;
} catch test_error with {
  my $err = shift;
  ok $err->file, "pack1";
};

try {
  test_pack1->r;
} catch test_error with {
  my $err = shift;
  ok $err->file, "main";
};

try {
  test_pack2->t;
} catch test_error with {
  my $err = shift;
  ok $err->file, "main";
};

try {
  test_pack3->t;
} catch test_error with {
  my $err = shift;
  ok $err->file, "pack3";
};

try {
  test_pack3->r;
} catch test_error with {
  my $err = shift;
  ok $err->file, "main";
};


try {
  test_pack1->rf;
} catch test_error with {
  my $err = shift;
  ok $err->file, "main";
};

try {
  test_pack3->rf;
} catch test_error with {
  my $err = shift;
  ok $err->file, "main";
};
1	wakaba	1.1	#!/usr/bin/perl
2	wakaba	1.3	use strict;
3	wakaba	1.1	use Message::Util::Error;
4	wakaba	1.4	use Test;
5			plan tests => 11;
6	wakaba	1.1
7			try {
8	wakaba	1.2	throw Message::Util::Error -type => 'SOMETHING_UNKNOWN';
9	wakaba	1.1	} catch Message::Util::Error with {
10			my $err = shift;
11	wakaba	1.3	warn $err->stringify if $^W;
12	wakaba	1.4	ok $err->text, qq("SOMETHING_UNKNOWN": Unknown error);
13	wakaba	1.1	} except {
14	wakaba	1.4	ok 1, 0;
15	wakaba	1.1	} otherwise {
16	wakaba	1.4	ok 1, 0;
17	wakaba	1.1	} finally {
18	wakaba	1.4	ok 1, 1;
19	wakaba	1.1	};
20	wakaba	1.4	ok 1, 1;
21	wakaba	1.1
22			try {
23	wakaba	1.2	throw test_error -type => 'ERR1', param1 => 'VAL1', param2 => 'VAL2';
24	wakaba	1.1	} catch test_error with {
25			my $err = shift;
26	wakaba	1.4	ok $err->text, qq(Param1 "VAL1"; Param2 "VAL2");
27	wakaba	1.1	};
28
29			package test_error;
30			BEGIN {
31			our @ISA = 'Message::Util::Error';
32			}
33	wakaba	1.2	sub ___error_def () {+{
34	wakaba	1.1	ERR1 => {
35			description => q(Param1 "%t(name=>param1);"; Param2 "%t(name=>param2);"),
36			},
37	wakaba	1.4	fatal => {
38			description => q(fatal error),
39			},
40			warn => {
41			description => q(warn msg),
42			},
43	wakaba	1.1	}}
44
45	wakaba	1.4	package test_report;
46			BEGIN {
47			our @ISA = 'test_error';
48			}
49
50			package test_pack1;
51			#line 1 "pack1"
52
53			sub t {
54			throw test_error -type => 'ERR1', param1 => 1, param2 => 2;
55			}
56			sub r {
57			report test_error -type => 'ERR1', param1 => 1, param2 => 2;
58			}
59
60			sub rw {
61			report test_error -type => 'warn', -object => bless {};
62			}
63			sub rf {
64			report test_error -type => 'fatal', -object => bless {};
65			}
66
67			sub ___report_error ($$;%) {
68			my ($pack1, $err, %opt) = @_;
69			# if ($err->{-type} eq 'fatal') {
70			$err->throw;
71			# } else {
72			#
73			# }
74			}
75
76			package test_pack2;
77			#line 1 "pack2"
78
79			sub t {
80			local $Error::Depth = $Error::Depth + 1;
81			throw test_error -type => 'ERR1', param1 => 1, param2 => 2;
82			}
83			sub r {
84			local $Error::Depth = $Error::Depth + 1;
85			report test_error -type => 'ERR1', param1 => 1, param2 => 2;
86			}
87
88			package test_pack3;
89			#line 1 "pack3"
90			push our @ISA, 'test_pack1';
91
92			sub t {
93			local $Error::Depth = $Error::Depth + 1;
94			shift->SUPER::t (@_);
95			}
96			sub r {
97			local $Error::Depth = $Error::Depth + 1;
98			shift->SUPER::r (@_);
99			}
100
101			sub rf {
102			local $Error::Depth = $Error::Depth + 1;
103			shift->SUPER::rf (@_);
104			}
105
106			package main;
107			#line 1 "main"
108
109			try {
110			test_pack1->t;
111			} catch test_error with {
112			my $err = shift;
113			ok $err->file, "pack1";
114			};
115
116			try {
117			test_pack1->r;
118			} catch test_error with {
119			my $err = shift;
120			ok $err->file, "main";
121			};
122
123			try {
124			test_pack2->t;
125			} catch test_error with {
126			my $err = shift;
127			ok $err->file, "main";
128			};
129
130			try {
131			test_pack3->t;
132			} catch test_error with {
133			my $err = shift;
134			ok $err->file, "pack3";
135			};
136
137			try {
138			test_pack3->r;
139			} catch test_error with {
140			my $err = shift;
141			ok $err->file, "main";
142			};
143
144	wakaba	1.1
145	wakaba	1.4	try {
146			test_pack1->rf;
147			} catch test_error with {
148			my $err = shift;
149			ok $err->file, "main";
150			};
151
152			try {
153			test_pack3->rf;
154			} catch test_error with {
155			my $err = shift;
156			ok $err->file, "main";
157			};