Check long path names with perl and MSYS install.exe on windows 11

test_paths.pl

use feature qw(say);
use strict;
use warnings;
use File::Spec::Functions qw(catfile catdir splitdir);
use File::Basename;
use Win32::LongPath;

# Define paths
my $msys_path = 'C:\Strawberry\perl\site\lib\auto\share\dist\Alien-MSYS\msys\1.0\bin';
my $install_exe = catfile($msys_path, 'install.exe');
my $base_path = 'C:\LongPathTest';

# Function to create directories recursively
sub create_directories_recursively {
    my ($path) = @_;
    my @parts = splitdir($path);
    my $current_path = shift @parts;  # Start with the drive letter or base path
    $current_path .= "\\" if $current_path =~ /^[a-zA-Z]:$/;

    foreach my $part (@parts) {
        next if $part eq ''; # Skip empty parts
        $current_path = catdir($current_path, $part);
        my $long_current_path = '\\\\?\\' . $current_path;
        unless (Win32::LongPath::mkdirL($long_current_path)) {
            die "Cannot create directory '$long_current_path': $^E" unless $^E == 183; # 183 means directory already exists
        }
    }
}

# Create a test file
my $test_file = catfile($base_path, 'testfile.txt');
open my $fh, '>', $test_file or die "Cannot open test file: $!";
print $fh "This is a test file.";
close $fh;

# Function to test a specific directory name length
sub test_directory_length {
    my ($length) = @_;
    my $shorter_path = $base_path;

    for my $i (1..10) {  # Adjust the number of iterations as needed
        $shorter_path = catdir($shorter_path, 'a' x $length);
    }

    create_directories_recursively($shorter_path);

    my $dest_path = catfile($shorter_path, 'testfile.txt');
    my $command = "\"$install_exe\" -c \"$test_file\" \"$dest_path\"";
    system($command) == 0 or return 0;  # Return 0 if the command fails

    my $long_dest_path = '\\\\?\\' . $dest_path;
    return Win32::LongPath::testL('e', $long_dest_path) ? 1 : 0;  # Return 1 if the file exists
}

# Test directory name lengths
# NOTE: On my system with Windows 11 and perl version 5.38, the test fails with directory name lengths of 23,24, and 25
for my $length (22..25) {
    say "Testing with directory name length: $length";
    if (test_directory_length($length)) {
        say "Success with directory name length: $length";
    } else {
        say "Failure with directory name length: $length";
    }
}