Author: jkeenan
Date: Thu Aug 14 05:07:26 2008
New Revision: 30224
Modified:
branches/opsrenum/lib/Parrot/OpsRenumber.pm
branches/opsrenum/t/tools/ops2pm/05-renum_op_map_file.t
Log:
Begin to handle case of ops renumbering for Parrot 1.0 and later.
Modified: branches/opsrenum/lib/Parrot/OpsRenumber.pm
==============================================================================
--- branches/opsrenum/lib/Parrot/OpsRenumber.pm (original)
+++ branches/opsrenum/lib/Parrot/OpsRenumber.pm Thu Aug 14 05:07:26 2008
@@ -154,6 +154,45 @@
}
close $OP;
}
+ else {
+
+# my ( $name, $number, @lines, %fixed, $fix );
+ my ( $name, $number, @lines, %fixed );
+# $fix = 1;
+ open my $OP, '<', $file
+ or die "Can't open $file, error $!";
+ while (<$OP>) {
+# push @lines, $_ if $fix;
+ push @lines, $_;
+ chomp;
+# $fix = 0 if /^###DYNAMIC###/;
+ s/#.*$//;
+ s/\s*$//;
+ s/^\s*//;
+ next unless $_;
+ ( $name, $number ) = split( /\s+/, $_ );
+# $fixed{$name} = $number if ($fix);
+ $fixed{$name} = $number;
+ }
+ close $OP;
+
+ # Now we re-open the very same file we just read -- this time for
+ # writing. We directly print all the lines n @lines, i.e., those
+ # above the DYNAMIC line. For the purpose of renumbering, we create
+ # an index $n.
+
+ open $OP, '>', $file
+ or die "Can't open $file, error $!";
+ print $OP @lines;
+ my $n = scalar keys %fixed;;
+
+ for my $op ( @{ $self->{ops}->{OPS} } ) {
+ if (! $fixed{$op}) {
+ printf $OP "%-31s%4d\n", $op->full_name, ++$n;
+ }
+ }
+ close $OP;
+ }
return 1;
}
Modified: branches/opsrenum/t/tools/ops2pm/05-renum_op_map_file.t
==============================================================================
--- branches/opsrenum/t/tools/ops2pm/05-renum_op_map_file.t (original)
+++ branches/opsrenum/t/tools/ops2pm/05-renum_op_map_file.t Thu Aug 14
05:07:26 2008
@@ -100,6 +100,77 @@
chdir $cwd or croak "Unable to change back to starting directory: $!";
}
+{
+ ##### Test post-Parrot 1.0 case
+ my $major_version = 0;
+
+ ##### Prepare temporary directory for testing #####
+
+ my $tdir = tempdir( CLEANUP => 1 );
+ chdir $tdir or croak "Unable to change to testing directory: $!";
+ my $opsdir = File::Spec->catdir ( $tdir, 'src', 'ops' );
+ mkpath( $opsdir, 0, 755 ) or croak "Unable to make testing directory";
+
+# ##### Stage 1: Generate ops.num de novo #####
+#
+# my @stage1 = qw(
+# core.ops.orig
+# bit.ops.orig
+# ops.num.orig
+# );
+# copy_into_position($samplesdir, [EMAIL PROTECTED], q{orig}, $opsdir);
+# ($lastcode, $lastnumber) = run_test_stage(
+# [ qw(
+# src/ops/core.ops
+# src/ops/bit.ops
+# ) ],
+# $numoutput,
+# $major_version,
+# );
+# is($lastcode, q{bxors_s_sc_sc},
+# "Stage 1: Got expected last opcode");
+# is($lastnumber, 190,
+# "Stage 1: Got expected last opcode number");
+#
+# ###### Stage 2: Delete some opcodes and regenerate ops.num #####
+#
+# my @stage2 = qw( bit.ops.second );
+# copy_into_position($samplesdir, [EMAIL PROTECTED], q{second}, $opsdir);
+# ($lastcode, $lastnumber) = run_test_stage(
+# [ qw(
+# src/ops/core.ops
+# src/ops/bit.ops
+# ) ],
+# $numoutput,
+# $major_version,
+# );
+# is($lastcode, q{bxor_i_ic_ic},
+# "Stage 2: Got expected last opcode");
+# is($lastnumber, 184,
+# "Stage 2: Got expected last opcode number");
+#
+# ##### Stage 3: Add some opcodes and regenerate ops.num #####
+#
+# my @stage3 = qw( pic.ops.orig );
+# copy_into_position($samplesdir, [EMAIL PROTECTED], q{orig}, $opsdir);
+# ($lastcode, $lastnumber) = run_test_stage(
+# [ qw(
+# src/ops/core.ops
+# src/ops/bit.ops
+# src/ops/pic.ops
+# ) ],
+# $numoutput,
+# $major_version,
+# );
+# ($lastcode, $lastnumber) = get_last_opcode($numoutput);
+# is($lastcode, q{pic_callr___pc},
+# "Stage 3: Got expected last opcode");
+# is($lastnumber, 189,
+# "Stage 3: Got expected last opcode number");
+
+ # Go back where we started to activate cleanup
+ chdir $cwd or croak "Unable to change back to starting directory: $!";
+}
pass("Completed all tests in $0");
#################### SUBROUTINES ####################
