view release on metacpan or  search on metacpan

xt/c-compat.t  view on Meta::CPAN

    # Platform-specific headers without guards
    'unistd_without_guard' => {
        pattern => qr/^#\s*include\s+<unistd\.h>/m,
        severity => 'info',
        message => '<unistd.h> is Unix-only - may need HAS_UNISTD guard',
        negative_pattern => qr/#\s*if.*HAS_UNISTD|#\s*ifdef.*WIN32|#\s*ifndef.*_WIN32/,
    },
    
    # Windows-specific headers without guards  
    'windows_header_without_guard' => {
        pattern => qr/^#\s*include\s+<windows\.h>/mi,
        severity => 'info',
        message => '<windows.h> is Windows-only - ensure proper guards',
        negative_pattern => qr/#\s*if.*WIN32|#\s*ifdef.*_WIN32/,
    },
);

# Check each XS directory
for my $dir (@xs_dirs) {
    my $full_dir = $dir;
    next unless -d $full_dir;
    
    my $module = $dir;
    $module =~ s|^xs/||;
    
    # Find .c and .h files
    my @files;
    find(sub {
        push @files, $File::Find::name if /\.[ch]$/ && !/ppport\.h$/;
    }, $full_dir);
    
    for my $file (@files) {
        my $content = eval { read_file($file) };
        next unless defined $content;
        
        my $rel_file = $file;
        my $is_compat = $file =~ /_compat\.h$/;
        my $is_c_file = $file =~ /\.c$/;
        
        # Check if this file includes a compat header
        my $has_compat = $content =~ /#include\s+["<]\w+_compat\.h[">]/;
        
        for my $check_name (sort keys %checks) {
            my $check = $checks{$check_name};
            
            # Skip compat-specific checks for compat headers themselves
            next if $is_compat && $check->{skip_in_compat};
            
            # Skip checks that only apply to .c files
            next if $check->{only_in_c_files} && !$is_c_file;
            
            # Skip checks marked to skip
            next if $check->{skip_functions};
            
            if ($content =~ $check->{pattern}) {
                # For negative patterns, skip if the negative pattern matches
                if ($check->{negative_pattern}) {
                    next if $content =~ $check->{negative_pattern};
                }
                
                # For patterns with required_guards, verify all guards are present
                if ($check->{required_guards}) {
                    my $all_guards_present = 1;
                    for my $guard (@{$check->{required_guards}}) {
                        unless ($content =~ $guard) {
                            $all_guards_present = 0;
                            last;
                        }
                    }
                    next if $all_guards_present;  # Properly guarded, skip
                }
                
                # For files using true/false, verify compat header
                if ($check->{requires_compat} && !$is_compat) {
                    next if $has_compat;
                    # Also check if it's in a compat-included header chain
                    next if $file =~ /\.h$/ && $content =~ /_compat\.h/;
                }
                
                push @issues, {
                    file => $rel_file,
                    check => $check_name,
                    severity => $check->{severity},
                    message => $check->{message},
                };
            }
        }
        
        # Additional check: .c files using bool/true/false should include compat header
        if ($file =~ /\.c$/ && !$is_compat) {
            if ($content =~ /\b(true|false)\b/ && $content !~ /TRUE|FALSE/) {
                unless ($has_compat || $content =~ /stdbool\.h/) {
                    push @issues, {
                        file => $rel_file,
                        check => 'missing_compat_header',
                        severity => 'warning',
                        message => 'Uses true/false but may not include compat header',
                    };
                }
            }
        }
    }
}

# Check that all compat headers have the fixed pattern
my @compat_headers = glob("xs/*/*.h");
@compat_headers = grep { /_compat\.h$/ } @compat_headers;

for my $compat (@compat_headers) {
    my $content = eval { read_file($compat) };
    next unless defined $content;
    
    # Get the corresponding .c file to check if bool is used
    my $c_file = $compat;
    $c_file =~ s/_compat\.h$/.c/;
    my $c_content = eval { read_file($c_file) } // '';
    my $uses_bool = $c_content =~ /\b(bool|true|false)\b/;
    
    # Check for the old broken pattern
    if ($content =~ /defined\(__bool_true_false_are_defined\)\s*\|\|\s*defined\(bool\)/) {
        if ($content !~ /#\s*ifndef\s+true/) {
            push @issues, {
                file => $compat,
                check => 'old_bool_compat_pattern',
                severity => 'error',
                message => 'Old bool compat pattern - perl.h defines bool but not true/false',
            };
        }
    }
    
    # Verify the proper pattern exists if the module uses bool
    unless ($content =~ /__STDC_VERSION__.*202311L/s) {
        if ($uses_bool) {