manakai/t/util-error.t

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

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");
};

try {
  throw test_error -type => 'error_with_code';
} catch test_error with {
  my $err = shift;
  ok $err->code, 128, "error_with_code->code";
  ok $err->value, 128, "error_with_code->value";
  ok 0+$err->value, 128, "0+error_with_code";
  ok $err->text, "error", "error_with_code->text";
  ok $err->type, "error_with_code", "error_with_code->type";
  ok $err->subtype, undef, "error_with_code->subtype";
  ok $err->type_def->{-description}, "error", "error_with_code->type_def";
};

try {
  throw test_error -type => 'error_with_code', -subtype => 'suberror';
} catch test_error with {
  my $err = shift;
  ok $err->code, 128, "error_with_code->code";
  ok $err->value, 128, "error_with_code->value";
  ok 0+$err->value, 128, "0+error_with_code";
  ok $err->text, "suberror", "error_with_code->text";
  ok $err->type, "error_with_code", "error_with_code->type";
  ok $err->subtype, "suberror", "error_with_code->subtype";
  ok $err->type_def->{-description}, "error", "error_with_code->type_def";
};

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),
  },
  error_with_code => {
    -code => 128,
    -description => q(error),
    -subtype => {
      suberror => {
        -description => q(suberror),
        -code => 100,
      },
    },
  },
}}

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";
};

=head1 LICENSE

Copyright 2003-2007 Wakaba <w@suika.fam.cx>

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

1; # $Date: 2003/12/26 07:09:42 $
1	#!/usr/bin/perl
2	use strict;
3	use Message::Util::Error;
4	use Test;
5	plan tests => 25;
6
7	try {
8	throw Message::Util::Error -type => 'SOMETHING_UNKNOWN';
9	} catch Message::Util::Error with {
10	my $err = shift;
11	warn $err->stringify if $^W;
12	ok $err->text, qq("SOMETHING_UNKNOWN": Unknown error);
13	} except {
14	ok 1, 0;
15	} otherwise {
16	ok 1, 0;
17	} finally {
18	ok 1, 1;
19	};
20	ok 1, 1;
21
22	try {
23	throw test_error -type => 'ERR1', param1 => 'VAL1', param2 => 'VAL2';
24	} catch test_error with {
25	my $err = shift;
26	ok $err->text, qq(Param1 "VAL1"; Param2 "VAL2");
27	};
28
29	try {
30	throw test_error -type => 'error_with_code';
31	} catch test_error with {
32	my $err = shift;
33	ok $err->code, 128, "error_with_code->code";
34	ok $err->value, 128, "error_with_code->value";
35	ok 0+$err->value, 128, "0+error_with_code";
36	ok $err->text, "error", "error_with_code->text";
37	ok $err->type, "error_with_code", "error_with_code->type";
38	ok $err->subtype, undef, "error_with_code->subtype";
39	ok $err->type_def->{-description}, "error", "error_with_code->type_def";
40	};
41
42	try {
43	throw test_error -type => 'error_with_code', -subtype => 'suberror';
44	} catch test_error with {
45	my $err = shift;
46	ok $err->code, 128, "error_with_code->code";
47	ok $err->value, 128, "error_with_code->value";
48	ok 0+$err->value, 128, "0+error_with_code";
49	ok $err->text, "suberror", "error_with_code->text";
50	ok $err->type, "error_with_code", "error_with_code->type";
51	ok $err->subtype, "suberror", "error_with_code->subtype";
52	ok $err->type_def->{-description}, "error", "error_with_code->type_def";
53	};
54
55	package test_error;
56	BEGIN {
57	our @ISA = 'Message::Util::Error';
58	}
59	sub ___error_def () {+{
60	ERR1 => {
61	-description => q(Param1 "%t(name=>param1);"; Param2 "%t(name=>param2);"),
62	},
63	fatal => {
64	-description => q(fatal error),
65	},
66	warn => {
67	-description => q(warn msg),
68	},
69	error_with_code => {
70	-code => 128,
71	-description => q(error),
72	-subtype => {
73	suberror => {
74	-description => q(suberror),
75	-code => 100,
76	},
77	},
78	},
79	}}
80
81	package test_report;
82	BEGIN {
83	our @ISA = 'test_error';
84	}
85
86	package test_pack1;
87	#line 1 "pack1"
88
89	sub t {
90	throw test_error -type => 'ERR1', param1 => 1, param2 => 2;
91	}
92	sub r {
93	report test_error -type => 'ERR1', param1 => 1, param2 => 2;
94	}
95
96	sub rw {
97	report test_error -type => 'warn', -object => bless {};
98	}
99	sub rf {
100	report test_error -type => 'fatal', -object => bless {};
101	}
102
103	sub ___report_error ($$;%) {
104	my ($pack1, $err, %opt) = @_;
105	# if ($err->{-type} eq 'fatal') {
106	$err->throw;
107	# } else {
108	#
109	# }
110	}
111
112	package test_pack2;
113	#line 1 "pack2"
114
115	sub t {
116	local $Error::Depth = $Error::Depth + 1;
117	throw test_error -type => 'ERR1', param1 => 1, param2 => 2;
118	}
119	sub r {
120	local $Error::Depth = $Error::Depth + 1;
121	report test_error -type => 'ERR1', param1 => 1, param2 => 2;
122	}
123
124	package test_pack3;
125	#line 1 "pack3"
126	push our @ISA, 'test_pack1';
127
128	sub t {
129	local $Error::Depth = $Error::Depth + 1;
130	shift->SUPER::t (@_);
131	}
132	sub r {
133	local $Error::Depth = $Error::Depth + 1;
134	shift->SUPER::r (@_);
135	}
136
137	sub rf {
138	local $Error::Depth = $Error::Depth + 1;
139	shift->SUPER::rf (@_);
140	}
141
142	package main;
143	#line 1 "main"
144
145	try {
146	test_pack1->t;
147	} catch test_error with {
148	my $err = shift;
149	ok $err->file, "pack1";
150	};
151
152	try {
153	test_pack1->r;
154	} catch test_error with {
155	my $err = shift;
156	ok $err->file, "main";
157	};
158
159	try {
160	test_pack2->t;
161	} catch test_error with {
162	my $err = shift;
163	ok $err->file, "main";
164	};
165
166	try {
167	test_pack3->t;
168	} catch test_error with {
169	my $err = shift;
170	ok $err->file, "pack3";
171	};
172
173	try {
174	test_pack3->r;
175	} catch test_error with {
176	my $err = shift;
177	ok $err->file, "main";
178	};
179
180
181	try {
182	test_pack1->rf;
183	} catch test_error with {
184	my $err = shift;
185	ok $err->file, "main";
186	};
187
188	try {
189	test_pack3->rf;
190	} catch test_error with {
191	my $err = shift;
192	ok $err->file, "main";
193	};
194
195	=head1 LICENSE
196
197	Copyright 2003-2007 Wakaba <w@suika.fam.cx>
198
199	This program is free software; you can redistribute it and/or
200	modify it under the same terms as Perl itself.
201
202	=cut
203
204	1; # $Date: 2003/12/26 07:09:42 $