t/tools/ops2pm/08-sort_ops.t

   1 #! perl
   2 # Copyright (C) 2007-2008, Parrot Foundation.
   3 # $Id$
   4 # 08-sort_ops.t
   5
   6 use strict;
   7 use warnings;
   8
   9 BEGIN {
  10     use FindBin qw($Bin);
  11     use Cwd qw(cwd realpath);
  12     realpath($Bin) =~ m{^(.*\/parrot)\/[^/]*\/[^/]*\/[^/]*$};
  13     our $topdir = $1;
  14     if ( defined $topdir ) {
  15         print "\nOK:  Parrot top directory located\n";
  16     }
  17     else {
  18         $topdir = realpath($Bin) . "/../../..";
  19     }
  20     unshift @INC, qq{$topdir/lib};
  21 }
  22 use Test::More;
  23 use Carp;
  24 use Cwd;
  25 use File::Copy;
  26 use File::Temp (qw| tempdir |);
  27
  28 my $cwd = cwd();
  29 plan -e "$cwd/DEVELOPING" ? ( tests => 86 ) :
  30                             ( skip_all => 'Requires DEVELOPING file' );
  31
  32 use_ok('Parrot::Ops2pm');
  33 use IO::CaptureOutput qw| capture |;
  34
  35 use constant NUM_FILE  => "src/ops/ops.num";
  36 use constant SKIP_FILE => "src/ops/ops.skip";
  37
  38 ok( chdir $main::topdir, "Positioned at top-level Parrot directory" );
  39
  40 # regular case
  41 {
  42     local @ARGV = qw(
  43         src/ops/core.ops
  44         src/ops/bit.ops
  45     );
  46     my $cwd = cwd();
  47     {
  48         my $tdir = tempdir( CLEANUP => 1 );
  49         ok( chdir $tdir, 'changed to temp directory for testing' );
  50         ok( ( mkdir qq{$tdir/src} ),     "able to make tempdir/src" );
  51         ok( ( mkdir qq{$tdir/src/ops} ), "able to make tempdir/src" );
  52         foreach my $f (@ARGV) {
  53             ok( copy( qq{$cwd/$f}, qq{$tdir/$f} ), "copied .ops file" );
  54         }
  55         my $num  = NUM_FILE;
  56         my $skip = SKIP_FILE;
  57         ok( copy( qq{$cwd/$num},  qq{$tdir/$num} ),  "copied ops.num file" );
  58         ok( copy( qq{$cwd/$skip}, qq{$tdir/$skip} ), "copied ops.skip file" );
  59         my @opsfiles = glob("./src/ops/*.ops");
  60
  61         my $self = Parrot::Ops2pm->new(
  62             {
  63                 argv    => [@opsfiles],
  64                 script  => "tools/build/ops2pm.pl",
  65                 nolines => undef,
  66                 renum   => undef,
  67             }
  68         );
  69         isa_ok( $self, q{Parrot::Ops2pm} );
  70
  71         ok( $self->prepare_ops, "prepare_ops() returned successfully" );
  72         ok( defined( $self->{ops} ), "'ops' key has been defined" );
  73
  74         ok( $self->load_op_map_files(), "load_op_map_files() completed successfully" );
  75         ok( -f $num,                    "ops.num located after renumbering" );
  76         ok( -f $skip,                   "ops.skip located after renumbering" );
  77
  78         ok( $self->sort_ops(), "sort_ops returned successfully" );
  79
  80         # To do:  Test that the sorting was correct.
  81
  82         ok( chdir $cwd, 'changed back to starting directory after testing' );
  83     }
  84 }
  85
  86 # include experimental.ops in @ARGV
  87 {
  88     local @ARGV = qw(
  89         src/ops/core.ops
  90         src/ops/bit.ops
  91         src/ops/experimental.ops
  92     );
  93     my $cwd = cwd();
  94     {
  95         my $tdir = tempdir( CLEANUP => 1 );
  96         ok( chdir $tdir, 'changed to temp directory for testing' );
  97         ok( ( mkdir qq{$tdir/src} ),     "able to make tempdir/src" );
  98         ok( ( mkdir qq{$tdir/src/ops} ), "able to make tempdir/src" );
  99         foreach my $f (@ARGV) {
 100             ok( copy( qq{$cwd/$f}, qq{$tdir/$f} ), "copied .ops file" );
 101         }
 102         my $num  = NUM_FILE;
 103         my $skip = SKIP_FILE;
 104         ok( copy( qq{$cwd/$num},  qq{$tdir/$num} ),  "copied ops.num file" );
 105         ok( copy( qq{$cwd/$skip}, qq{$tdir/$skip} ), "copied ops.skip file" );
 106         my @opsfiles = glob("./src/ops/*.ops");
 107
 108         my $self = Parrot::Ops2pm->new(
 109             {
 110                 argv    => [@opsfiles],
 111                 script  => "tools/build/ops2pm.pl",
 112                 nolines => undef,
 113                 renum   => undef,
 114             }
 115         );
 116         isa_ok( $self, q{Parrot::Ops2pm} );
 117
 118         ok( $self->prepare_ops, "prepare_ops() returned successfully" );
 119         ok( defined( $self->{ops} ), "'ops' key has been defined" );
 120
 121         ok( $self->load_op_map_files(), "load_op_map_files() completed successfully" );
 122         ok( -f $num,                    "ops.num located after renumbering" );
 123         ok( -f $skip,                   "ops.skip located after renumbering" );
 124
 125         ok( $self->sort_ops(), "sort_ops returned successfully" );
 126
 127         # To do:  Test that the sorting was correct.
 128
 129         ok( chdir $cwd, 'changed back to starting directory after testing' );
 130     }
 131 }
 132
 133 # include experimental.ops in @ARGV; use 'DEVELOPING' to trigger warning
 134 {
 135     local @ARGV = qw(
 136         src/ops/core.ops
 137         src/ops/bit.ops
 138         src/ops/experimental.ops
 139     );
 140     my $cwd = cwd();
 141     {
 142         my $tdir = tempdir( CLEANUP => 1 );
 143         ok( chdir $tdir, 'changed to temp directory for testing' );
 144         ok( ( mkdir qq{$tdir/src} ),     "able to make tempdir/src" );
 145         ok( ( mkdir qq{$tdir/src/ops} ), "able to make tempdir/src" );
 146         foreach my $f (@ARGV) {
 147             ok( copy( qq{$cwd/$f}, qq{$tdir/$f} ), "copied .ops file" );
 148         }
 149         my $num  = NUM_FILE;
 150         my $skip = SKIP_FILE;
 151         ok( copy( qq{$cwd/$num},       qq{$tdir/$num} ),       "copied ops.num file" );
 152         ok( copy( qq{$cwd/$skip},      qq{$tdir/$skip} ),      "copied ops.skip file" );
 153         ok( copy( qq{$cwd/DEVELOPING}, qq{$tdir/DEVELOPING} ), "copied DEVELOPING file" );
 154         my @opsfiles = glob("./src/ops/*.ops");
 155
 156         my $self = Parrot::Ops2pm->new(
 157             {
 158                 argv    => [@opsfiles],
 159                 script  => "tools/build/ops2pm.pl",
 160                 nolines => undef,
 161                 renum   => undef,
 162             }
 163         );
 164         isa_ok( $self, q{Parrot::Ops2pm} );
 165
 166         ok( $self->prepare_ops, "prepare_ops() returned successfully" );
 167         ok( defined( $self->{ops} ), "'ops' key has been defined" );
 168
 169         ok( $self->load_op_map_files(), "load_op_map_files() completed successfully" );
 170         ok( -f $num,                    "ops.num located after renumbering" );
 171         ok( -f $skip,                   "ops.skip located after renumbering" );
 172
 173         my ($stdout, $stderr);
 174         my $ret = capture(
 175             sub { $self->sort_ops() },
 176             \$stdout,
 177             \$stderr
 178         );
 179         ok($ret, "sort_ops returned successfully" );
 180 #  TODO: {
 181 #             local $TODO = 'broken warning about experimental ops';
 182
 183             like(
 184                 $stderr,
 185                 qr|experimental, not in ops\.num|,
 186                 "Got expected warning about experimental ops"
 187             );
 188 #        }
 189
 190         # To do:  Test that the sorting was correct.
 191
 192         ok( chdir $cwd, 'changed back to starting directory after testing' );
 193     }
 194 }
 195
 196 # include object.ops in @ARGV; use 'DEVELOPING' to trigger warning
 197 {
 198     local @ARGV = qw(
 199         src/ops/core.ops
 200         src/ops/bit.ops
 201         src/ops/object.ops
 202     );
 203     my $cwd = cwd();
 204     {
 205         my $tdir = tempdir( CLEANUP => 1 );
 206         ok( chdir $tdir, 'changed to temp directory for testing' );
 207         ok( ( mkdir qq{$tdir/src} ),     "able to make tempdir/src" );
 208         ok( ( mkdir qq{$tdir/src/ops} ), "able to make tempdir/src" );
 209         foreach my $f (@ARGV) {
 210             ok( copy( qq{$cwd/$f}, qq{$tdir/$f} ), "copied .ops file" );
 211         }
 212         my $num  = NUM_FILE;
 213         my $skip = SKIP_FILE;
 214         ok( copy( qq{$cwd/$num},       qq{$tdir/$num} ),       "copied ops.num file" );
 215         ok( copy( qq{$cwd/$skip},      qq{$tdir/$skip} ),      "copied ops.skip file" );
 216         ok( copy( qq{$cwd/DEVELOPING}, qq{$tdir/DEVELOPING} ), "copied DEVELOPING file" );
 217         my $dummyops = "./src/ops/dummy.ops";
 218         open my $FH, ">", $dummyops
 219             or croak "Unable to open handle to create dummy ops file: $!";
 220         print $FH <<DUMMYOPS;
 221 /*
 222 ** dummy.ops
 223 */
 224
 225 inline op zzzzzz(inout INT, in INT) :base_core {
 226   goto NEXT();
 227 }
 228 DUMMYOPS
 229         close $FH or croak "Unable to close handle after writing: $!";
 230         my @opsfiles = glob("./src/ops/*.ops");
 231
 232         my $self = Parrot::Ops2pm->new(
 233             {
 234                 argv    => [@opsfiles],
 235                 script  => "tools/build/ops2pm.pl",
 236                 nolines => undef,
 237                 renum   => undef,
 238             }
 239         );
 240         isa_ok( $self, q{Parrot::Ops2pm} );
 241
 242         ok( $self->prepare_ops, "prepare_ops() returned successfully" );
 243         ok( defined( $self->{ops} ), "'ops' key has been defined" );
 244
 245         ok( $self->load_op_map_files(), "load_op_map_files() completed successfully" );
 246         ok( -f $num,                    "ops.num located after renumbering" );
 247         ok( -f $skip,                   "ops.skip located after renumbering" );
 248
 249         my ($stdout, $stderr);
 250         eval { $self->sort_ops() };
 251         like(
 252             $@,
 253             qr|not in ops\.num nor ops\.skip|,
 254             "Got expected failure about ops in neither ops.num or ops.skip"
 255         );
 256
 257         # To do:  Test that the sorting was correct.
 258
 259         ok( chdir $cwd, 'changed back to starting directory after testing' );
 260     }
 261 }
 262
 263 # include object.ops in @ARGV; do not use 'DEVELOPING' to trigger warning
 264 {
 265     local @ARGV = qw(
 266         src/ops/core.ops
 267         src/ops/bit.ops
 268         src/ops/object.ops
 269     );
 270     my $cwd = cwd();
 271     {
 272         my $tdir = tempdir( CLEANUP => 1 );
 273         ok( chdir $tdir, 'changed to temp directory for testing' );
 274         ok( ( mkdir qq{$tdir/src} ),     "able to make tempdir/src" );
 275         ok( ( mkdir qq{$tdir/src/ops} ), "able to make tempdir/src" );
 276         foreach my $f (@ARGV) {
 277             ok( copy( qq{$cwd/$f}, qq{$tdir/$f} ), "copied .ops file" );
 278         }
 279         my $num  = NUM_FILE;
 280         my $skip = SKIP_FILE;
 281         ok( copy( qq{$cwd/$num},  qq{$tdir/$num} ),  "copied ops.num file" );
 282         ok( copy( qq{$cwd/$skip}, qq{$tdir/$skip} ), "copied ops.skip file" );
 283
 284         #        ok(copy(qq{$cwd/DEVELOPING}, qq{$tdir/DEVELOPING}),
 285         #            "copied DEVELOPING file");
 286         my @opsfiles = glob("./src/ops/*.ops");
 287
 288         my $self = Parrot::Ops2pm->new(
 289             {
 290                 argv    => [@opsfiles],
 291                 script  => "tools/build/ops2pm.pl",
 292                 nolines => undef,
 293                 renum   => undef,
 294             }
 295         );
 296         isa_ok( $self, q{Parrot::Ops2pm} );
 297
 298         ok( $self->prepare_ops, "prepare_ops() returned successfully" );
 299         ok( defined( $self->{ops} ), "'ops' key has been defined" );
 300
 301         ok( $self->load_op_map_files(), "load_op_map_files() completed successfully" );
 302         ok( -f $num,                    "ops.num located after renumbering" );
 303         ok( -f $skip,                   "ops.skip located after renumbering" );
 304
 305         my ($stdout, $stderr);
 306         my $ret = capture(
 307             sub { $self->sort_ops() },
 308             \$stdout,
 309             \$stderr
 310         );
 311         ok($ret, "sort_ops returned successfully" );
 312         ok( ! $stderr, "Got no warning, as expected" );
 313
 314         # To do:  Test that the sorting was correct.
 315
 316         ok( chdir $cwd, 'changed back to starting directory after testing' );
 317     }
 318 }
 319
 320 pass("Completed all tests in $0");
 321
 322 ################### DOCUMENTATION ###################
 323
 324 =head1 NAME
 325
 326 08-sort_ops.t - test C<Parrot::Ops2pm::sort_ops()>
 327
 328 =head1 SYNOPSIS
 329
 330     % prove t/tools/ops2pm/08-sort_ops.t
 331
 332 =head1 DESCRIPTION
 333
 334 The files in this directory test the publicly callable subroutines of
 335 F<lib/Parrot/Ops2pm.pm> and F<lib/Parrot/Ops2pm/Auxiliary.pm>.
 336 By doing so, they test the functionality of the F<ops2pm.pl> utility.
 337 That functionality has largely been extracted
 338 into the methods of F<Utils.pm>.
 339
 340 F<08-sort_ops.t> tests whether
 341 C<Parrot::Ops2pm::sort_ops()> works properly.
 342
 343 =head1 AUTHOR
 344
 345 James E Keenan
 346
 347 =head1 SEE ALSO
 348
 349 Parrot::Ops2pm, F<ops2pm.pl>.
 350
 351 =cut
 352
 353 # Local Variables:
 354 #   mode: cperl
 355 #   cperl-indent-level: 4
 356 #   fill-column: 100
 357 # End:
 358 # vim: expandtab shiftwidth=4: