Commit 92ba77557b239b6b69cca82f87bdabe62325baa4 - libparams-validate-perl

+3

-83

Build.PL less more

10	10	"File::Spec" => 0,
11	11	"File::Temp" => 0,
12	12	"Module::Build" => "0.3601",
	13	"Module::Implementation" => "0.04",
13	14	"Test::Fatal" => 0,
14	15	"Test::More" => "0.88",
15	16	"Tie::Array" => 0,

26	27	"Dave Rolsky, <autarch\@urth.org> and Ilya Martynov <ilya\@martynov.org>"
27	28	],
28	29	"dist_name" => "Params-Validate",
29		"dist_version" => "1.03",
	30	"dist_version" => "1.06",
30	31	"license" => "artistic_2",
31	32	"module_name" => "Params::Validate",
32	33	"recommends" => {},

54	55	if ( grep { $_ eq '--pp' } @ARGV ) {
55	56	$skip_xs = 1;
56	57	}
57		elsif ( ! can_xs() ) {
	58	elsif ( ! $build->have_c_compiler() ) {
58	59	$skip_xs = 1;
59	60	}
60	61

62	63	$build->build_elements(
63	64	[ grep { $_ ne 'xs' } @{ $build->build_elements() } ] );
64	65	}
65
66		sub can_xs {
67		# Do we have the configure_requires checker?
68		local $@;
69		eval "require ExtUtils::CBuilder;";
70		if ($@) {
71
72		# They don't obey configure_requires, so it is
73		# someone old and delicate. Try to avoid hurting
74		# them by falling back to an older simpler test.
75		return can_cc();
76		}
77
78		# Do a simple compile that consumes the headers we need
79		my @libs = ();
80		my $object = undef;
81		my $builder = ExtUtils::CBuilder->new( quiet => 1 );
82		unless ( $builder->have_compiler ) {
83
84		# Lack of a compiler at all
85		return 0;
86		}
87		eval {
88		$object = $builder->compile(
89		source => 'sanexs.c',
90		);
91		@libs = $builder->link(
92		objects => $object,
93		module_name => 'sanexs',
94		);
95		};
96		my $broken = !!$@;
97		foreach ( $object, @libs ) {
98		next unless defined $_;
99		1 while unlink $_;
100		}
101
102		if ($broken) {
103		### NOTE: Don't do this in a production release.
104		# Compiler is officially screwed, you don't deserve
105		# to do any of our downstream depedencies as you'll
106		# probably end up choking on them as well.
107		# Trigger an NA for their own protection.
108		print "Unresolvable broken external dependency.\n";
109		print "This package requires a C compiler with full perl headers.\n";
110		print "Trivial test code using them failed to compile.\n";
111		print STDERR "NA: Unable to build distribution on this platform.\n";
112		exit(0);
113		}
114
115		return 1;
116		}
117
118		sub can_cc {
119		my @chunks = split( / /, $Config::Config{cc} ) or return;
120
121		# $Config{cc} may contain args; try to find out the program part
122		while (@chunks) {
123		return can_run("@chunks") \|\| ( pop(@chunks), next );
124		}
125
126		return;
127		}
128
129		sub can_run {
130		my ($cmd) = @_;
131
132		my $_cmd = $cmd;
133		if ( -x $_cmd or $_cmd = MM->maybe_command($_cmd) ) {
134		return $_cmd;
135		}
136
137		foreach my $dir ( ( split /$Config::Config{path_sep}/, $ENV{PATH} ), '.' )
138		{
139		next if $dir eq '';
140		my $abs = File::Spec->catfile( $dir, $cmd );
141		return $abs if ( -x $abs or $abs = MM->maybe_command($abs) );
142		}
143
144		return;
145		}
146	66	$build->create_build_script;

+27

-0

Changes less more

	0	1.06 2012-02-10
	1
	2	- Shut up warnings when XS is loaded on older 5.8.x Perl versions. Reported by
	3	Aaron James Trevena. RT #74742.
	4
	5
	6	1.05 2012-02-08
	7
	8	- The XS code had a code path where it could pass the contents of a Perl
	9	variable as the first argument to the XS croak() subroutine. This subroutine
	10	is like printf(), and should receive a format string as its first
	11	argument. According to RT #74777, this can lead to segfaults on some systems.
	12
	13	This could in theory be a security bug, but it's very unlikely that
	14	untrusted user input could end up being passed to this croak(). It is called
	15	when a spec specifies a "depend" value on another parameter. The value of
	16	the "depend" parameter was passed in the first argument to croak().
	17
	18	Reported by Andreas Voegele.
	19
	20
	21	1.04 2012-02-08
	22
	23	- Use the latest Module::XSOrPP dzil plugin to generate a saner Build.PL. No
	24	need update if you're using an earlier version.
	25
	26
0	27	1.03 2012-02-06
1	28
2	29	- This release uses Module::Implementation to handle loading the XS or pure

+1

-1

MANIFEST less more

18	18	lib/Params/Validate/XS.xs
19	19	lib/Params/ValidatePP.pm
20	20	lib/Params/ValidateXS.pm
21		sanexs.c
22	21	t/01-validate.t
23	22	t/02-noop.t
24	23	t/03-attribute.t

97	96	t/release-pp-32-regex-as-value.t
98	97	t/release-pp-is-loaded.t
99	98	t/release-xs-is-loaded.t
	99	t/release-xs-segfault.t

+2

-1

META.json less more

43	43	"Devel::Peek" : 0,
44	44	"File::Spec" : 0,
45	45	"File::Temp" : 0,
	46	"Module::Implementation" : "0.04",
46	47	"Test::Fatal" : 0,
47	48	"Test::More" : "0.88",
48	49	"Tie::Array" : 0,

64	65	"web" : "http://git.urth.org/Params-Validate.git"
65	66	}
66	67	},
67		"version" : "1.03"
	68	"version" : "1.06"
68	69	}
69	70

+2

-1

META.yml less more

6	6	File::Spec: 0
7	7	File::Temp: 0
8	8	Module::Build: 0.3601
	9	Module::Implementation: 0.04
9	10	Test::Fatal: 0
10	11	Test::More: 0.88
11	12	Tie::Array: 0

36	37	resources:
37	38	bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Params-Validate
38	39	repository: git://git.urth.org/Params-Validate.git
39		version: 1.03
	40	version: 1.06

+1

-1

README less more

0	0
1	1
2	2	This archive contains the distribution Params-Validate,
3		version 1.03:
	3	version 1.06:
4	4
5	5	Validate method/function parameters
6	6

+1

-1

dist.ini less more

2	2	license = Artistic_2_0
3	3	copyright_holder = Dave Rolsky and Ilya Martynov
4	4
5		version = 1.03
	5	version = 1.06
6	6
7	7	[NextRelease]
8	8	format = %-7v %{yyyy-MM-dd}d

+2

-31

lib/Params/Validate/XS.xs less more

0		/* Copyright (c) 2000-2011 Dave Rolsky */
	0	/* Copyright (c) 2000-2012 Dave Rolsky and Ilya Martynov */
1	1
2	2	#include "EXTERN.h"
3	3	#include "perl.h"

73	73	break; \
74	74	} \
75	75	} STMT_END
76
77		/* module initialization */
78		static void
79		bootinit() {
80		HV* stash;
81
82		/* define constants */
83		stash = gv_stashpv("Params::Validate", 1);
84		newCONSTSUB(stash, "SCALAR", newSViv(SCALAR));
85		newCONSTSUB(stash, "ARRAYREF", newSViv(ARRAYREF));
86		newCONSTSUB(stash, "HASHREF", newSViv(HASHREF));
87		newCONSTSUB(stash, "CODEREF", newSViv(CODEREF));
88		newCONSTSUB(stash, "GLOB", newSViv(GLOB));
89		newCONSTSUB(stash, "GLOBREF", newSViv(GLOBREF));
90		newCONSTSUB(stash, "SCALARREF", newSViv(SCALARREF));
91		newCONSTSUB(stash, "UNKNOWN", newSViv(UNKNOWN));
92		newCONSTSUB(stash, "UNDEF", newSViv(UNDEF));
93		newCONSTSUB(stash, "OBJECT", newSViv(OBJECT));
94		newCONSTSUB(stash, "HANDLE", newSViv(HANDLE));
95		newCONSTSUB(stash, "BOOLEAN", newSViv(BOOLEAN));
96		}
97	76
98	77
99	78	INLINE static bool

439	418	return 1;
440	419	}
441	420
442		#define VALID_KEY_COUNT 9
443		static char* valid_keys[VALID_KEY_COUNT] = {
444		"callbacks", "can", "default", "depends", "isa", "optional", "regex", "type", "untaint"
445		};
446
447	421	/* validates specific parameter using supplied parameter specification */
448	422	static IV
449	423	validate_one_param(SV* value, SV* params, HV* spec, SV* id, HV* options, IV* untaint) {

1001	975	sv_catpv(buffer, "' does not exist in spec: ");
1002	976	sv_catsv(buffer, depend_name);
1003	977
1004		croak(SvPV_nolen(buffer));
	978	croak("%s", SvPV_nolen(buffer));
1005	979	}
1006	980	/* if we got here, the spec was correct. we just
1007	981	* need to issue a regular validation failure

1513	1487
1514	1488	MODULE = Params::Validate::XS PACKAGE = Params::Validate::XS
1515	1489
1516		BOOT:
1517		bootinit();
1518
1519	1490	void
1520	1491	validate(p, specs)
1521	1492	SV* p

+2

-2

lib/Params/Validate.pm less more

0	0	package Params::Validate;
1	1	{
2		$Params::Validate::VERSION = '1.03';
	2	$Params::Validate::VERSION = '1.06';
3	3	}
4	4
5	5	use 5.008001;

79	79
80	80	=head1 VERSION
81	81
82		version 1.03
	82	version 1.06
83	83
84	84	=head1 SYNOPSIS
85	85

+0

-12

~~sanexs.c~~ less more

0		#include "EXTERN.h"
1		#include "perl.h"
2		#include "XSUB.h"
3
4		int main(int argc, char **argv) {
5		return 0;
6		}
7
8		int boot_sanexs() {
9		return 1;
10		}
11

+3

-1

t/release-pp-is-loaded.t less more

15	15	$ENV{PV_WARN_FAILED_IMPLEMENTATION} = 1;
16	16	}
17	17
	18	use Module::Implementation 0.04 ();
18	19	use Params::Validate;
19	20
20	21	is(
21		Params::Validate::_implementation(), 'PP',
	22	Module::Implementation::implementation_for('Params::Validate'),
	23	'PP',
22	24	'PP implementation is loaded when env var is set'
23	25	);
24	26

+3

-1

t/release-xs-is-loaded.t less more

12	12
13	13	BEGIN { $ENV{PV_WARN_FAILED_IMPLEMENTATION} = 1 }
14	14
	15	use Module::Implementation 0.04 ();
15	16	use Params::Validate;
16	17
17	18	is(
18		Params::Validate::_implementation(), 'XS',
	19	Module::Implementation::implementation_for('Params::Validate'),
	20	'XS',
19	21	'XS implementation is loaded by default'
20	22	);
21	23

+34

-0

t/release-xs-segfault.t less more

	0
	1	BEGIN {
	2	unless ($ENV{RELEASE_TESTING}) {
	3	require Test::More;
	4	Test::More::plan(skip_all => 'these tests are for release candidate testing');
	5	}
	6	}
	7
	8	use strict;
	9	use warnings;
	10
	11	use Test::More;
	12
	13	BEGIN {
	14	$ENV{PARAMS_VALIDATE_IMPLEMENTATION} = 'XS';
	15	$ENV{PV_WARN_FAILED_IMPLEMENTATION} = 1;
	16	}
	17
	18	use Params::Validate qw( validate SCALAR );
	19
	20	eval { foo( { a => 1 } ) };
	21
	22	ok(1, 'did not segfault');
	23
	24	done_testing();
	25
	26	sub foo {
	27	validate(
	28	@_,
	29	{
	30	a => { type => SCALAR, depends => ['%s%s%s'] },
	31	}
	32	);
	33	}