Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package perl-Struct-Dumb for
openSUSE:Factory checked in at 2022-09-09 18:27:56
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Struct-Dumb (Old)
and /work/SRC/openSUSE:Factory/.perl-Struct-Dumb.new.2083 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Struct-Dumb"
Fri Sep 9 18:27:56 2022 rev:7 rq:1002195 version:0.13
Changes:
--------
--- /work/SRC/openSUSE:Factory/perl-Struct-Dumb/perl-Struct-Dumb.changes
2020-04-22 20:55:42.051710390 +0200
+++
/work/SRC/openSUSE:Factory/.perl-Struct-Dumb.new.2083/perl-Struct-Dumb.changes
2022-09-09 18:29:28.269259055 +0200
@@ -1,0 +2,11 @@
+Sun Aug 28 03:06:37 UTC 2022 - Tina M??ller <[email protected]>
+
+- updated to 0.13
+ see /usr/share/doc/packages/perl-Struct-Dumb/Changes
+
+ 0.13 2022-08-27
+ [CHANGES]
+ * Use `feature 'class'` instead of blessed ARRAYrefs on perls which
+ support that, as an experiment to test how well that works
+
+-------------------------------------------------------------------
Old:
----
Struct-Dumb-0.12.tar.gz
New:
----
Struct-Dumb-0.13.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Struct-Dumb.spec ++++++
--- /var/tmp/diff_new_pack.9juPO2/_old 2022-09-09 18:29:28.665260097 +0200
+++ /var/tmp/diff_new_pack.9juPO2/_new 2022-09-09 18:29:28.665260097 +0200
@@ -1,7 +1,7 @@
#
# spec file for package perl-Struct-Dumb
#
-# Copyright (c) 2020 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2022 SUSE LLC
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -16,18 +16,16 @@
#
+%define cpan_name Struct-Dumb
Name: perl-Struct-Dumb
-Version: 0.12
+Version: 0.13
Release: 0
-%define cpan_name Struct-Dumb
-Summary: Make simple lightweight record-like structures
License: Artistic-1.0 OR GPL-1.0-or-later
-Group: Development/Libraries/Perl
-Url: https://metacpan.org/release/%{cpan_name}
+Summary: Make simple lightweight record-like structures
+URL: https://metacpan.org/release/%{cpan_name}
Source0:
https://cpan.metacpan.org/authors/id/P/PE/PEVANS/%{cpan_name}-%{version}.tar.gz
Source1: cpanspec.yml
BuildArch: noarch
-BuildRoot: %{_tmppath}/%{name}-%{version}-build
BuildRequires: perl
BuildRequires: perl-macros
BuildRequires: perl(Module::Build) >= 0.400400
@@ -72,8 +70,13 @@
on by using code. Attempting to dereference the object as an ARRAY will
throw an exception.
+_Note_: That on development perls that support 'use feature 'class'', this
+is used instead of a blessed ARRAY reference. This implementation choice
+should be transparent to the end-user, as all the same features are
+supported.
+
%prep
-%setup -q -n %{cpan_name}-%{version}
+%autosetup -n %{cpan_name}-%{version}
%build
perl Build.PL installdirs=vendor
@@ -87,7 +90,6 @@
%perl_gen_filelist
%files -f %{name}.files
-%defattr(-,root,root,755)
%doc Changes README
%license LICENSE
++++++ Struct-Dumb-0.12.tar.gz -> Struct-Dumb-0.13.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Struct-Dumb-0.12/Changes new/Struct-Dumb-0.13/Changes
--- old/Struct-Dumb-0.12/Changes 2020-04-21 01:41:51.000000000 +0200
+++ new/Struct-Dumb-0.13/Changes 2022-08-27 14:26:46.000000000 +0200
@@ -1,5 +1,10 @@
Revision history for Struct-Dumb
+0.13 2022-08-27
+ [CHANGES]
+ * Use `feature 'class'` instead of blessed ARRAYrefs on perls which
+ support that, as an experiment to test how well that works
+
0.12 2020-04-21
[BUGFIXES]
* Better ways to detect late-loading of Data::Dump.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Struct-Dumb-0.12/LICENSE new/Struct-Dumb-0.13/LICENSE
--- old/Struct-Dumb-0.12/LICENSE 2020-04-21 01:41:51.000000000 +0200
+++ new/Struct-Dumb-0.13/LICENSE 2022-08-27 14:26:46.000000000 +0200
@@ -1,4 +1,4 @@
-This software is copyright (c) 2020 by Paul Evans <[email protected]>.
+This software is copyright (c) 2022 by Paul Evans <[email protected]>.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
@@ -12,7 +12,7 @@
--- The GNU General Public License, Version 1, February 1989 ---
-This software is Copyright (c) 2020 by Paul Evans <[email protected]>.
+This software is Copyright (c) 2022 by Paul Evans <[email protected]>.
This is free software, licensed under:
@@ -272,7 +272,7 @@
--- The Artistic License 1.0 ---
-This software is Copyright (c) 2020 by Paul Evans <[email protected]>.
+This software is Copyright (c) 2022 by Paul Evans <[email protected]>.
This is free software, licensed under:
@@ -292,21 +292,21 @@
- "Package" refers to the collection of files distributed by the Copyright
Holder, and derivatives of that collection of files created through
- textual modification.
+ textual modification.
- "Standard Version" refers to such a Package if it has not been modified,
or has been modified in accordance with the wishes of the Copyright
- Holder.
+ Holder.
- "Copyright Holder" is whoever is named in the copyright or copyrights for
- the package.
+ the package.
- "You" is you, if you're thinking about copying or distributing this
Package.
- "Reasonable copying fee" is whatever you can justify on the basis of media
cost, duplication charges, time of people involved, and so on. (You will
not be required to justify it to the Copyright Holder, but only to the
- computing community at large as a market that must bear the fee.)
+ computing community at large as a market that must bear the fee.)
- "Freely Available" means that no fee is charged for the item itself, though
there may be fees involved in handling the item. It also means that
recipients of the item may redistribute it under the same conditions they
- received it.
+ received it.
1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that you
@@ -373,7 +373,7 @@
9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
-MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
The End
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Struct-Dumb-0.12/MANIFEST
new/Struct-Dumb-0.13/MANIFEST
--- old/Struct-Dumb-0.12/MANIFEST 2020-04-21 01:41:51.000000000 +0200
+++ new/Struct-Dumb-0.13/MANIFEST 2022-08-27 14:26:46.000000000 +0200
@@ -1,11 +1,7 @@
Build.PL
Changes
lib/Struct/Dumb.pm
-LICENSE
MANIFEST This list of files
-META.json
-META.yml
-README
t/00use.t
t/01point.t
t/02scope.t
@@ -15,3 +11,7 @@
t/10data-dump.t
t/11data-dump-late.t
t/99pod.t
+README
+LICENSE
+META.yml
+META.json
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Struct-Dumb-0.12/META.json
new/Struct-Dumb-0.13/META.json
--- old/Struct-Dumb-0.12/META.json 2020-04-21 01:41:51.000000000 +0200
+++ new/Struct-Dumb-0.13/META.json 2022-08-27 14:26:46.000000000 +0200
@@ -4,7 +4,7 @@
"Paul Evans <[email protected]>"
],
"dynamic_config" : 1,
- "generated_by" : "Module::Build version 0.4224",
+ "generated_by" : "Module::Build version 0.4231",
"license" : [
"perl_5"
],
@@ -29,7 +29,7 @@
"provides" : {
"Struct::Dumb" : {
"file" : "lib/Struct/Dumb.pm",
- "version" : "0.12"
+ "version" : "0.13"
}
},
"release_status" : "stable",
@@ -38,6 +38,6 @@
"http://dev.perl.org/licenses/";
]
},
- "version" : "0.12",
- "x_serialization_backend" : "JSON::PP version 4.04"
+ "version" : "0.13",
+ "x_serialization_backend" : "JSON::PP version 4.06"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Struct-Dumb-0.12/META.yml
new/Struct-Dumb-0.13/META.yml
--- old/Struct-Dumb-0.12/META.yml 2020-04-21 01:41:51.000000000 +0200
+++ new/Struct-Dumb-0.13/META.yml 2022-08-27 14:26:46.000000000 +0200
@@ -8,7 +8,7 @@
configure_requires:
Module::Build: '0.4004'
dynamic_config: 1
-generated_by: 'Module::Build version 0.4224, CPAN::Meta::Converter version
2.150010'
+generated_by: 'Module::Build version 0.4231, CPAN::Meta::Converter version
2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -17,8 +17,8 @@
provides:
Struct::Dumb:
file: lib/Struct/Dumb.pm
- version: '0.12'
+ version: '0.13'
resources:
license: http://dev.perl.org/licenses/
-version: '0.12'
+version: '0.13'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Struct-Dumb-0.12/README new/Struct-Dumb-0.13/README
--- old/Struct-Dumb-0.12/README 2020-04-21 01:41:51.000000000 +0200
+++ new/Struct-Dumb-0.13/README 2022-08-27 14:26:46.000000000 +0200
@@ -4,37 +4,37 @@
SYNOPSIS
- use Struct::Dumb;
+ use Struct::Dumb;
- struct Point => [qw( x y )];
+ struct Point => [qw( x y )];
- my $point = Point(10, 20);
+ my $point = Point(10, 20);
- printf "Point is at (%d, %d)\n", $point->x, $point->y;
+ printf "Point is at (%d, %d)\n", $point->x, $point->y;
- $point->y = 30;
- printf "Point is now at (%d, %d)\n", $point->x, $point->y;
+ $point->y = 30;
+ printf "Point is now at (%d, %d)\n", $point->x, $point->y;
- struct Point3D => [qw( x y z )], named_constructor => 1;
+ struct Point3D => [qw( x y z )], named_constructor => 1;
- my $point3d = Point3D( z => 12, x => 100, y => 50 );
+ my $point3d = Point3D( z => 12, x => 100, y => 50 );
- printf "Point3d's height is %d\n", $point3d->z;
+ printf "Point3d's height is %d\n", $point3d->z;
- struct Point3D => [qw( x y z )], predicate => "is_Point3D";
+ struct Point3D => [qw( x y z )], predicate => "is_Point3D";
- my $point3d = Point3D( 1, 2, 3 );
+ my $point3d = Point3D( 1, 2, 3 );
- printf "This is a Point3D\n" if is_Point3D( $point3d );
+ printf "This is a Point3D\n" if is_Point3D( $point3d );
- use Struct::Dumb qw( -named_constructors )
+ use Struct::Dumb qw( -named_constructors )
- struct Point3D => [qw( x y z )];
+ struct Point3D => [qw( x y z )];
- my $point3d = Point3D( x => 100, z => 12, y => 50 );
+ my $point3d = Point3D( x => 100, z => 12, y => 50 );
DESCRIPTION
@@ -60,20 +60,25 @@
argument, or attempting to invoke a stored CODE reference by passing
argument values directly to the accessor.)
- $ perl -E 'use Struct::Dumb; struct Point => [qw( x y )]; Point(30)'
- usage: main::Point($x, $y) at -e line 1
+ $ perl -E 'use Struct::Dumb; struct Point => [qw( x y )]; Point(30)'
+ usage: main::Point($x, $y) at -e line 1
- $ perl -E 'use Struct::Dumb; struct Point => [qw( x y )]; Point(10,20)->z'
- main::Point does not have a 'z' field at -e line 1
+ $ perl -E 'use Struct::Dumb; struct Point => [qw( x y )];
Point(10,20)->z'
+ main::Point does not have a 'z' field at -e line 1
- $ perl -E 'use Struct::Dumb; struct Point => [qw( x y )];
Point(1,2)->x(3)'
- main::Point->x invoked with arguments at -e line 1.
+ $ perl -E 'use Struct::Dumb; struct Point => [qw( x y )];
Point(1,2)->x(3)'
+ main::Point->x invoked with arguments at -e line 1.
Objects in this class are (currently) backed by an ARRAY reference
store, though this is an internal implementation detail and should not
be relied on by using code. Attempting to dereference the object as an
ARRAY will throw an exception.
+ Note: That on development perls that support use feature 'class', this
+ is used instead of a blessed ARRAY reference. This implementation
+ choice should be transparent to the end-user, as all the same features
+ are supported.
+
CONSTRUCTOR FORMS
The struct and readonly_struct declarations create two different kinds
@@ -170,14 +175,14 @@
references so it can walk the data structure looking for reference
cycles.
- use Devel::Cycle;
+ use Devel::Cycle;
- {
- no warnings 'redefine';
- local *Point::_forbid_arrayification = sub {};
+ {
+ no warnings 'redefine';
+ local *Point::_forbid_arrayification = sub {};
- memory_cycle_ok( $point );
- }
+ memory_cycle_ok( $point );
+ }
TODO
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Struct-Dumb-0.12/lib/Struct/Dumb.pm
new/Struct-Dumb-0.13/lib/Struct/Dumb.pm
--- old/Struct-Dumb-0.12/lib/Struct/Dumb.pm 2020-04-21 01:41:51.000000000
+0200
+++ new/Struct-Dumb-0.13/lib/Struct/Dumb.pm 2022-08-27 14:26:46.000000000
+0200
@@ -1,14 +1,14 @@
# You may distribute under the terms of either the GNU General Public License
# or the Artistic License (the same terms as Perl itself)
#
-# (C) Paul Evans, 2012-2020 -- [email protected]
+# (C) Paul Evans, 2012-2022 -- [email protected]
package Struct::Dumb;
use strict;
use warnings;
-our $VERSION = '0.12';
+our $VERSION = '0.13';
use Carp;
@@ -18,46 +18,48 @@
# Before that we can't easily implement forbidding of @{} overload, so lets not
use constant HAVE_OVERLOADING => eval { require overloading };
+use constant HAVE_FEATURE_CLASS => defined eval { require feature;
$feature::feature{class} };
+
=head1 NAME
C<Struct::Dumb> - make simple lightweight record-like structures
=head1 SYNOPSIS
- use Struct::Dumb;
+ use Struct::Dumb;
- struct Point => [qw( x y )];
+ struct Point => [qw( x y )];
- my $point = Point(10, 20);
+ my $point = Point(10, 20);
- printf "Point is at (%d, %d)\n", $point->x, $point->y;
+ printf "Point is at (%d, %d)\n", $point->x, $point->y;
- $point->y = 30;
- printf "Point is now at (%d, %d)\n", $point->x, $point->y;
+ $point->y = 30;
+ printf "Point is now at (%d, %d)\n", $point->x, $point->y;
Z<>
- struct Point3D => [qw( x y z )], named_constructor => 1;
+ struct Point3D => [qw( x y z )], named_constructor => 1;
- my $point3d = Point3D( z => 12, x => 100, y => 50 );
+ my $point3d = Point3D( z => 12, x => 100, y => 50 );
- printf "Point3d's height is %d\n", $point3d->z;
+ printf "Point3d's height is %d\n", $point3d->z;
Z<>
- struct Point3D => [qw( x y z )], predicate => "is_Point3D";
+ struct Point3D => [qw( x y z )], predicate => "is_Point3D";
- my $point3d = Point3D( 1, 2, 3 );
+ my $point3d = Point3D( 1, 2, 3 );
- printf "This is a Point3D\n" if is_Point3D( $point3d );
+ printf "This is a Point3D\n" if is_Point3D( $point3d );
Z<>
- use Struct::Dumb qw( -named_constructors )
+ use Struct::Dumb qw( -named_constructors )
- struct Point3D => [qw( x y z )];
+ struct Point3D => [qw( x y z )];
- my $point3d = Point3D( x => 100, z => 12, y => 50 );
+ my $point3d = Point3D( x => 100, z => 12, y => 50 );
=head1 DESCRIPTION
@@ -82,20 +84,24 @@
passing in the new value as an argument, or attempting to invoke a stored
C<CODE> reference by passing argument values directly to the accessor.)
- $ perl -E 'use Struct::Dumb; struct Point => [qw( x y )]; Point(30)'
- usage: main::Point($x, $y) at -e line 1
+ $ perl -E 'use Struct::Dumb; struct Point => [qw( x y )]; Point(30)'
+ usage: main::Point($x, $y) at -e line 1
- $ perl -E 'use Struct::Dumb; struct Point => [qw( x y )]; Point(10,20)->z'
- main::Point does not have a 'z' field at -e line 1
+ $ perl -E 'use Struct::Dumb; struct Point => [qw( x y )]; Point(10,20)->z'
+ main::Point does not have a 'z' field at -e line 1
- $ perl -E 'use Struct::Dumb; struct Point => [qw( x y )]; Point(1,2)->x(3)'
- main::Point->x invoked with arguments at -e line 1.
+ $ perl -E 'use Struct::Dumb; struct Point => [qw( x y )]; Point(1,2)->x(3)'
+ main::Point->x invoked with arguments at -e line 1.
Objects in this class are (currently) backed by an ARRAY reference store,
though this is an internal implementation detail and should not be relied on
by using code. Attempting to dereference the object as an ARRAY will throw an
exception.
+I<Note>: That on development perls that support C<use feature 'class'>, this
+is used instead of a blessed ARRAY reference. This implementation choice
+should be transparent to the end-user, as all the same features are supported.
+
=head2 CONSTRUCTOR FORMS
The C<struct> and C<readonly_struct> declarations create two different kinds
@@ -184,13 +190,62 @@
my %optional;
s/^\?// and $optional{$_}++ for @fields;
+ my %subs;
+ $subs{DESTROY} = sub {};
+ $subs{AUTOLOAD} = sub :lvalue {
+ my ( $field ) = our $AUTOLOAD =~ m/::([^:]+)$/;
+ croak "$pkg does not have a '$field' field";
+ my $dummy; ## croak can't be last because it isn't lvalue, so this line
is required
+ };
+
my $constructor;
+
+ if( HAVE_FEATURE_CLASS ) {
+ _build_class_for_feature_class( $pkg, \@fields, \%optional, $named,
$lvalue, \$constructor );
+ }
+ else {
+ _build_class_for_classical( $pkg, \@fields, \%optional, $named, $lvalue,
\$constructor );
+ }
+
+ no strict 'refs';
+ *{"${pkg}::$_"} = $subs{$_} for keys %subs;
+ *{"${caller}::$name"} = $constructor;
+
+ if( my $predicate = $opts{predicate} ) {
+ *{"${caller}::$predicate"} = sub { ( ref($_[0]) || "" ) eq $pkg };
+ }
+
+ *{"${pkg}::_forbid_arrayification"} = sub {
+ return if !HAVE_OVERLOADING and caller eq __PACKAGE__;
+ croak "Cannot use $pkg as an ARRAY reference"
+ };
+
+ require overload;
+ $pkg->overload::OVERLOAD(
+ '@{}' => sub { $_[0]->_forbid_arrayification; return $_[0] },
+ '0+' => sub { refaddr $_[0] },
+ '""' => sub { sprintf "%s=Struct::Dumb(%#x)", $pkg, refaddr $_[0] },
+ 'bool' => sub { 1 },
+ fallback => 1,
+ );
+
+ $_STRUCT_PACKAGES{$pkg} = {
+ named => $named,
+ fields => \@fields,
+ }
+}
+
+sub _build_class_for_classical
+{
+ my ( $pkg, $fields, $optional, $named, $lvalue, $constructorvar ) = @_;
+ my @fields = @$fields;
+
if( $named ) {
- $constructor = sub {
+ $$constructorvar = sub {
my %values = @_;
my @values;
foreach ( @fields ) {
- exists $values{$_} or $optional{$_} or
+ exists $values{$_} or $optional->{$_} or
croak "usage: $pkg requires '$_'";
push @values, delete $values{$_};
}
@@ -203,7 +258,7 @@
else {
my $fieldcount = @fields;
my $argnames = join ", ", map "\$$_", @fields;
- $constructor = sub {
+ $$constructorvar = sub {
@_ == $fieldcount or croak "usage: $pkg($argnames)";
bless [ @_ ], $pkg;
};
@@ -224,39 +279,61 @@
: sub { @_ > 1 and croak "$pkg->$field invoked with
arguments";
shift->[$idx] };
}
- $subs{DESTROY} = sub {};
- $subs{AUTOLOAD} = sub :lvalue {
- my ( $field ) = our $AUTOLOAD =~ m/::([^:]+)$/;
- croak "$pkg does not have a '$field' field";
- my $dummy; ## croak can't be last because it isn't lvalue, so this line
is required
- };
no strict 'refs';
*{"${pkg}::$_"} = $subs{$_} for keys %subs;
- *{"${caller}::$name"} = $constructor;
+}
- if( my $predicate = $opts{predicate} ) {
- *{"${caller}::$predicate"} = sub { ( ref($_[0]) || "" ) eq $pkg };
+sub _build_class_for_feature_class
+{
+ my ( $pkg, $fields, $optional, $named, $lvalue, $constructorvar ) = @_;
+ my @fields = @$fields;
+ my %optional = %$optional;
+
+ if( $named ) {
+ my %fieldnames = map { $_ => 1 } @fields;
+
+ $$constructorvar = sub {
+ my %values = @_;
+ foreach ( @fields ) {
+ exists $values{$_} or $optional{$_} or
+ croak "usage: $pkg requires '$_'";
+ }
+ $fieldnames{$_} or croak "usage: $pkg does not recognise '$_'" for
keys %values;
+ return $pkg->new( %values );
+ };
+ }
+ else {
+ my $fieldcount = @fields;
+ my $argnames = join ", ", map "\$$_", @fields;
+ $$constructorvar = sub {
+ @_ == $fieldcount or croak "usage: $pkg($argnames)";
+ my %values; @values{@fields} = @_;
+ return $pkg->new( %values );
+ };
}
- *{"${pkg}::_forbid_arrayification"} = sub {
- return if !HAVE_OVERLOADING and caller eq __PACKAGE__;
- croak "Cannot use $pkg as an ARRAY reference"
- };
+ $lvalue = $lvalue ? " :lvalue" : "";
- require overload;
- $pkg->overload::OVERLOAD(
- '@{}' => sub { $_[0]->_forbid_arrayification; return $_[0] },
- '0+' => sub { refaddr $_[0] },
- '""' => sub { sprintf "%s=Struct::Dumb(%#x)", $pkg, refaddr $_[0] },
- 'bool' => sub { 1 },
- fallback => 1,
- );
+ my @fieldcode = map {
+ my $name = $_;
+ my $var = "\$$name";
+
+ " field $var;",
+ " ADJUST {",
+ " $var = delete \$_[0]->{$name};",
+ " }",
+ " method $name$lvalue { \@_ and croak \"$pkg->$name invoked with
arguments\"; $var }",
+ } @$fields;
+
+ my $code = join( "\n",
+ "use experimental 'class';",
+ "class $pkg {",
+ " use Carp;",
+ @fieldcode,
+ "}", "" );
- $_STRUCT_PACKAGES{$pkg} = {
- named => $named,
- fields => \@fields,
- }
+ eval "$code; 1" or die $@;
}
=head2 struct
@@ -333,14 +410,14 @@
For example, L<Devel::Cycle> needs to access the instances as plain ARRAY
references so it can walk the data structure looking for reference cycles.
- use Devel::Cycle;
+ use Devel::Cycle;
- {
- no warnings 'redefine';
- local *Point::_forbid_arrayification = sub {};
+ {
+ no warnings 'redefine';
+ local *Point::_forbid_arrayification = sub {};
- memory_cycle_ok( $point );
- }
+ memory_cycle_ok( $point );
+ }
=head1 TODO
@@ -369,16 +446,14 @@
my ( $ctx, $obj ) = @_;
return undef unless my $meta = $_STRUCT_PACKAGES{ $ctx->class };
- BEGIN {
- overloading->unimport if HAVE_OVERLOADING;
- }
-
my $fields = $meta->{fields};
return {
dump => sprintf "%s(%s)", $ctx->class,
join ", ", map {
- ( $meta->{named} ? "$fields->[$_] => " : "" ) .
- Data::Dump::dump($obj->[$_])
+ my $field = $fields->[$_];
+
+ ( $meta->{named} ? "$field => " : "" ) .
+ Data::Dump::dump($obj->$field)
} 0 .. $#$fields
};
});
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Struct-Dumb-0.12/t/01point.t
new/Struct-Dumb-0.13/t/01point.t
--- old/Struct-Dumb-0.12/t/01point.t 2020-04-21 01:41:51.000000000 +0200
+++ new/Struct-Dumb-0.13/t/01point.t 2022-08-27 14:26:46.000000000 +0200
@@ -38,13 +38,17 @@
qr/^Cannot use main::Point as an ARRAY reference at \S+ line \d+\.?\n/,
'Array deref throws exception' );
-ok( !( local $@ = exception {
- no warnings 'redefine';
- local *Point::_forbid_arrayification = sub {};
- @{ Point(2, 2) };
- } ),
- 'Array deref succeeds with locally-overridden forbid function' ) or
- diag( "Exception was $@" );
+SKIP: {
+ skip "Instances are not ARRAYs", 1 unless Scalar::Util::reftype( Point(1,
1) ) eq "ARRAY";
+
+ ok( !( local $@ = exception {
+ no warnings 'redefine';
+ local *Point::_forbid_arrayification = sub {};
+ @{ Point(2, 2) };
+ } ),
+ 'Array deref succeeds with locally-overridden forbid function' ) or
+ diag( "Exception was $@" );
+}
like( exception { $point->x(50) },
qr/^main::Point->x invoked with arguments at \S+ line \d+\.?\n/,
