PERL   23

abs2rel bug

Guest on 18th May 2022 01:20:15 AM

  1. #!/usr/bin/perl -lw
  2. use strict;
  3.  
  4. =for comment
  5.  
  6. Given
  7.  
  8.     directory   /dir/base
  9.     file        /dir/dest/subdir/file
  10.     cwd         /dir/dest
  11.  
  12. then
  13.  
  14.     abs2rel 'subdir/file', '../base'
  15.  
  16. should yield
  17.  
  18.     ../dest/subdir/file
  19.  
  20. but it yields
  21.  
  22.     ../../subdir/file
  23.  
  24. instead.
  25.  
  26. =cut
  27.  
  28. use sigtrap qw(die normal-signals);
  29.  
  30. use Cwd;
  31. use File::Basename;
  32. use File::Path;
  33. use File::Spec::Functions '/^/';
  34.  
  35. my $top = catdir tmpdir, "abs2rel-bug-$$";
  36. mkpath $top;
  37.  
  38. my $dest_top = catdir $top, 'dest';
  39. mkpath $dest_top;
  40. chdir $dest_top or die;
  41.  
  42. my $path = catfile 'subdir', 'file';
  43. mkpath dirname $path;
  44. open PATH, ">$path" or die;
  45. close PATH or die;
  46. -f $path or die;
  47.  
  48. my $base = '../base';
  49. mkpath $base;
  50.  
  51. my $result = abs2rel $path, $base;
  52.  
  53. sub show {
  54.     printf "%-15s %s\n", @_;
  55. }
  56.  
  57. show 'perl'             => $];
  58. show 'file::spec'       => $File::Spec::VERSION;
  59. show 'cwd'              => cwd;
  60. show 'base'             => $base;
  61. show 'base exists'      => -d $base ? 'yes' : 'no, my bug';
  62. show 'dest path'        => $path;
  63. show 'abs2rel result'   => $result;
  64. show 'result exists'    => -f $result ? 'yes' : 'no, File::Spec bug';
  65.  
  66. END {
  67.     rmtree $top if defined $top;
  68. }

Raw Paste

Login or Register to edit or fork this paste. It's free.