This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix O_CREAT without O_TRUNC in cpan/autodie/t/utf8_open.t
[perl5.git] / t / porting / args_assert.t
1 #!perl
2
3 use strict;
4 use warnings;
5
6 require './test.pl';
7
8 plan('no_plan');
9
10 # Fail for every PERL_ARGS_ASSERT* macro that was declared but not used.
11
12 my %declared;
13 my %used;
14
15 my $prefix = '';
16
17 unless (-d 't' && -f 'MANIFEST') {
18     # we'll assume that we are in t then.
19     # All files are internal to perl, so Unix-style is sufficiently portable.
20     $prefix = '../';
21 }
22
23 {
24     my $proto = $prefix . 'proto.h';
25
26     open my $fh, '<', $proto or die "Can't open $proto: $!";
27
28     while (<$fh>) {
29         $declared{$1}++ if /^#define\s+(PERL_ARGS_ASSERT[A-Za-z0-9_]+)\s+/;
30     }
31 }
32
33 cmp_ok(scalar keys %declared, '>', 0, 'Some macros were declared');
34
35 if (!@ARGV) {
36     my $manifest = $prefix . 'MANIFEST';
37     open my $fh, '<', $manifest or die "Can't open $manifest: $!";
38     while (<$fh>) {
39         # *.c or */*.c
40         push @ARGV, $prefix . $1 if m!^((?:[^/]+/)?[^/]+\.c)\t!;
41     }
42     push @ARGV, $prefix . 'inline.h'; # Special case this '.h' which acts like
43                                       # a '.c'
44 }
45
46 while (<>) {
47     $used{$1}++ if /^\s+(PERL_ARGS_ASSERT_[A-Za-z0-9_]+);$/;
48 }
49
50 my %unused;
51
52 foreach (keys %declared) {
53     $unused{$_}++ unless $used{$_};
54 }
55
56 if (keys %unused) {
57     fail("$_ is declared but not used") foreach sort keys %unused;
58 } else {
59     pass('Every PERL_ARGS_ASSERT* macro declared is used');
60 }