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	#!/usr/bin/perl
2	use strict;
3	use Message::Util::Error;
4	use Test;
5	plan tests => 11;
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	package test_error;
30	BEGIN {
31	our @ISA = 'Message::Util::Error';
32	}
33	sub ___error_def () {+{
34	ERR1 => {
35	description => q(Param1 "%t(name=>param1);"; Param2 "%t(name=>param2);"),
36	},
37	fatal => {
38	description => q(fatal error),
39	},
40	warn => {
41	description => q(warn msg),
42	},
43	}}
44
45	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
145	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	};