Test that ss_dup handles all savestack items

It is far too easy to overlook it when adding new savestack types.

diff --git a/MANIFEST b/MANIFEST
index 69683f4..8fc24ac 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -5296,6 +5296,7 @@ t/porting/podcheck.t              Test the POD of shipped modules is well formed
 t/porting/pod_rules.t          Check that various pod lists are consistent
 t/porting/readme.t             Check that all files in Porting/ are mentioned in Porting/README.pod
 t/porting/regen.t              Check that regen.pl doesn't need running
+t/porting/ss_dup.t             Check that sv.c:ss_dup handle everything
 t/porting/test_bootstrap.t     Test that the instructions for test bootstrapping aren't accidentally overlooked.
 t/porting/utils.t              Check that utility scripts still compile
 t/README                       Instructions for regression tests

diff --git a/t/porting/ss_dup.t b/t/porting/ss_dup.t
new file mode 100644 (file)
index 0000000..1604b0b
--- /dev/null
+++ b/t/porting/ss_dup.t
@@ -0,0 +1,36 @@
+#!perl
+
+@TODO = qw [ SAVEt_ADELETE SAVEt_READONLY_OFF SAVEt_SAVESWITCHSTACK
+             SAVEt_STACK_CXPOS ];
+@TODO{@TODO} = ();
+
+BEGIN { chdir 't'; require './test.pl' }
+
+sub read_cases {
+  my ($file, $func) = @_;
+
+  open my $fh, $file or die "$0 cannot open $file: $!";
+
+  while (readline $fh) {
+    last if /^Perl_$func/;
+  }
+  my %found;
+  while (readline $fh) {
+    last if /^}/;
+    $found{$1}++ if /case (SAVEt_\w*):/;
+  }
+  close $fh or die "$0 cannot close $file: $!";
+  \%found;
+}
+
+my $leave_scope = read_cases "../scope.c", "leave_scope";
+my $ss_dup      = read_cases "../sv.c",    "ss_dup";
+
+ok scalar %$leave_scope, 'we got some';
+
+for (sort keys %$leave_scope) {
+  local $::TODO = ' ' if exists $TODO{$_};
+  ok exists $$ss_dup{$_}, "ss_dup handles $_";
+}
+
+done_testing;