libsysio/tests/test_getcwd.pl

   1 #!/usr/bin/perl -w
   2
   3 use IPC::Open2;
   4
   5 use strict;
   6 use FindBin;
   7 use lib "$FindBin::Bin";
   8 use helper;
   9 use Fcntl;
  10
  11
  12 sub usage
  13 {
  14   print "Usage: ./test_getcwd.pl [-alpha] <dir> : Test getcwd by verifying that it \n";
  15   print "                                       : setting the directory to dir and \n";
  16   print "                                       : verifying that getcwd reflects \n";
  17   print "                                       : the change\n";
  18   exit(-1);
  19 }
  20
  21 sub check_wkdir
  22 {
  23   my ($wdir, $outfh, $cmdfh) = @_;
  24
  25
  26   # Get cwd from libsysio
  27   my $cmdstr = 'CALL getcwd ( $buf = ALLOC 512 ) 512'."\n";
  28   helper::send_cmd($cmdfh, $outfh, "getcwd", $cmdstr);
  29
  30   # Verify the system call's output
  31   helper::verify_cmd($cmdfh, $outfh, "getcwd");
  32
  33   # Print out the buffer
  34   $cmdstr = 'PRINT $buf 0 1 STR'."\n";
  35   helper::send_cmd($cmdfh, $outfh, "PRINT", $cmdstr);
  36
  37   my $iodir = <$outfh>;
  38   chop($iodir);
  39
  40         # Only compare the last portion of the working directory
  41         my @iodirs = split(/\//, $iodir);
  42         my @wdirs = split(/\//, $wdir);
  43
  44         if ($iodirs[-1]  ne $wdirs[-1]) {
  45                 helper::print_and_exit
  46                                 ($cmdfh,
  47                                  $outfh, 0,
  48                                  "ERROR! topmost wdir ($wdirs[-1]) does not match sysio's ($iodirs[-1])\n");
  49                 }
  50 }
  51
  52 sub process_cmd
  53 {
  54   my ($dir, $is_alpha) = @_;
  55
  56   # Get tests directory
  57   my $testdir = $FindBin::Bin;
  58
  59   eval {
  60       if ($is_alpha == 0) {
  61           open2(\*OUTFILE, \*CMDFILE, "$testdir/test_driver --np");
  62       } else {
  63           open2(\*OUTFILE, \*CMDFILE,
  64                 "yod -batch -quiet -sz 1 $testdir/test_driver --np");
  65       }
  66   };
  67
  68   if ($@) {
  69     if ($@ =~ /^open2/) {
  70       warn "open2 failed: $!\n$@\n";
  71       return;
  72     }
  73     die;
  74
  75   }
  76
  77   my $outfh = \*OUTFILE;
  78   my $cmdfh = \*CMDFILE;
  79
  80   if ($is_alpha == 0) {
  81     helper::send_cmd($cmdfh, $outfh, "init", "CALL init\n");
  82
  83                         # Get current working directory from environment
  84       my $cwd = $ENV{PWD};
  85
  86
  87   }
  88
  89   # Now change to dir
  90   helper::send_cmd($cmdfh, $outfh, "chdir", "CALL chdir $dir\n");
  91
  92  # Verify the system call's output
  93   helper::verify_cmd($cmdfh, $outfh, "PRINT");
  94
  95   check_wkdir($dir, $outfh, $cmdfh);
  96
  97   # Clean up
  98   helper::print_and_exit($cmdfh, $outfh, 0, "getcwd test successful\n");
  99 }
 100
 101
 102 my $currarg = 0;
 103 my $is_alpha = 0;
 104
 105 if (@ARGV < 1) {
 106   usage;
 107 } elsif (@ARGV > 1) {
 108   if ($ARGV[$currarg++] eq "-alpha") {
 109     $is_alpha = 1;
 110   }
 111 }
 112
 113 my $dir = $ARGV[$currarg];
 114
 115 process_cmd($dir, $is_alpha);
 116
 117 exit 0;
 118
 119
 120
 121