Skip Menu |

Preferred bug tracker

Please visit the preferred bug tracker to report your issue.

This queue is for tickets about the Exception-Class CPAN distribution.

Report information
The Basics
Id: 40864
Status: resolved
Priority: 0/
Queue: Exception-Class
People
Owner: Nobody in particular
Requestors: svitter [...] list.ru
Cc:
AdminCc:
Bug Information
Severity: Normal
Broken in: 1.26
Fixed in: (no value)

History Show all quoted text
  Wed Nov 12 11:31:00 2008 svitter [...] list.ru - Ticket created
Subject: Diamond-inherited exceptions fail to maintain some extra fields
The attached patch is avaliable for version 1.26. Exception-Class-1.26 perl 5.8.8, built on Gentoo as dev-lang/perl-5.8.8-r5 with USE flags: berkdb gdbm ithreads -build -debug -doc -elibc_FreeBSD -perlsuid 2.6.26-gentoo-r1 Some extra fields appear to get lost during diamond inheritance. If an exception A is the common ancestor of exceptions B and C, which in turn are parents of an exception D, then there's no way to instantiate an exception D with fields either from B or from C (it depends on the order they appear in @ISA). It is Method Resolution Order to blame. There's sub Fields eval'd during creation of each exception package. It invokes SUPER::Fields which is wrong regarding multiple inheritance. Exception::Class::Base is thrown with the message 'unknown field ... passed to constructor for class ...' when the exception class to be instantiated has the right field and corresponding accessor method.
  Wed Nov 12 11:35:15 2008 svitter [...] list.ru - Correspondence added
From: svitter [...] list.ru
I attach my patch and a test to reproduce the issue.
--- Exception-Class-1.26/lib/Exception/Class.pm 2008-10-26 04:46:53.000000000 +0300 +++ Class.pm 2008-11-12 17:56:09.000000000 +0300 @@ -148,9 +148,23 @@ { @fields = UNIVERSAL::isa($fields, 'ARRAY') ? @$fields : $fields; - $code .= - "sub Fields { return (\$_[0]->SUPER::Fields, " . - join(", ", map { "'$_'" } @fields) . ") }\n\n"; + $code .= <<'EOPERL'; +sub Fields +{ + return Exception::Class::_unify( +EOPERL + $code .= join(", ", map { "'$_'" } @fields); + $code .= <<'EOPERL'; + , Exception::Class::_walk_ancestors( + sub { + return $_[0]->Fields if $_[0]->can('Fields'); + return (); + } + , $_[0] + ) + ); +} +EOPERL foreach my $field (@fields) { @@ -186,6 +200,41 @@ sub Classes { sort keys %Exception::Class::CLASSES } +sub _unify { return sort keys %{ +{ map { $_ => 1 } @_ } } } + +sub _walk_ancestors(&$) +{ + my @result; + my ( $callback, $start ) = @_; + $start = ref( $start ) || $start; + if ( !defined( $start ) or !length( $start ) ) { + return; + } + my @stack; + { + no strict 'refs'; + push @stack, @{ "$start\::ISA" }; + } + my %seen = ( $start => 1 ); + while ( my $invocant = shift @stack ) { + $invocant = ref( $invocant ) || $invocant; + if ( !defined( $invocant ) or !length( $invocant ) ) { + next; + } + if ( '::' eq substr( $invocant, 0, 2 ) ) { + substr( $invocant, 0, 2 ) = 'main::'; + } + next if exists $seen{ $invocant }; + { + no strict 'refs'; + unshift @stack, @{ "$invocant\::ISA" }; + } + push @result, $callback->( $invocant ); + $seen{ $invocant }++; + } + return @result; +} + package Exception::Class::Base; use Class::Data::Inheritable;
#! /usr/bin/perl use warnings; use strict; use diagnostics; use Test::More tests => 5; use Test::Exception; BEGIN { use_ok( 'Exception::Class' => ( MyExc => { isa => 'Exception::Class::Base' , fields => [ 'newfield' ] } , OtherExc => { isa => 'Exception::Class::Base' , fields => [ 'otherfield' ] } , FinalExc => { isa => [ qw/ MyExc OtherExc / ] } ) ); } my $ex; lives_ok { $ex = new FinalExc( message => 'new final exception, #1' , newfield => 'new field value, #1' ) } q{FinalExc constructor recognizes 'newfield' (inherited from MyExc)}; can_ok( $ex, 'otherfield' ); can_ok( $ex, 'newfield' ); lives_ok { $ex = new FinalExc( message => 'new final exception, #2' , newfield => 'new field value, #2' , otherfield => 'other field value, #2' ) } q{FinalExc constructor recognizes 'otherfield' (inherited from OtherExc)};
  Sun Feb 24 12:25:53 2013 DROLSKY [...] cpan.org - Correspondence added
I'm closing this since this problem is solved by using Throwable instead of Exception::Class.
  Sun Feb 24 12:25:54 2013 The RT System itself - Status changed from 'new' to 'open'
  Sun Feb 24 12:25:54 2013 DROLSKY [...] cpan.org - Status changed from 'open' to 'resolved'