Merge pull request #2033 from perlpunk/patch-deparse

Use OpenQA::Test::PatchDeparse to avoid warnings

.tidyallrc

@@ -1,3 +1,4 @@
 [PerlTidy]
 select = **/*.{pl,pm,t} check_qemu_oom imgsearch isotovideo os-autoinst-openvswitch
+ignore = external/**/*
 argv = --profile=$ROOT/.perltidyrc

external/os-autoinst-common/.gitrepo

@@ -6,7 +6,7 @@
 [subrepo]
 	remote = git@github.com:os-autoinst/os-autoinst-common.git
 	branch = master
-	commit = ab99724ade6deabf88ba973501e1707585a5ce63
+	commit = 3de570d96746ec44647c034ba6e107cbc06e4141
 	parent = 9b31e8770b86dfbb479e325f494d0b7cdbf56d66
 	method = merge
 	cmdver = 0.4.3

external/os-autoinst-common/lib/OpenQA/Test/PatchDeparse.pm

@@ -0,0 +1,66 @@
+package OpenQA::Test::PatchDeparse;
+use Test::Most;
+
+# Monkeypatch B::Deparse
+# https://progress.opensuse.org/issues/40895
+# related: https://github.com/pjcj/Devel--Cover/issues/142
+# http://perlpunks.de/corelist/mversion?module=B::Deparse
+
+
+# This might be fixed in newer versions of perl/B::Deparse
+# We only see a warning when running with Devel::Cover
+if (
+    $B::Deparse::VERSION
+    and ($B::Deparse::VERSION >= '1.40' and ($B::Deparse::VERSION <= '1.54'))
+  )
+{
+
+#<<<  do not let perltidy touch this
+# This is not our code, and formatting should stay the same for
+# better comparison with new versions of B::Deparse
+# <---- PATCH
+package B::Deparse;
+no warnings 'redefine';
+no strict 'refs';
+
+*{"B::Deparse::walk_lineseq"} = sub {
+
+    my ($self, $op, $kids, $callback) = @_;
+    my @kids = @$kids;
+    for (my $i = 0; $i < @kids; $i++) {
+	my $expr = "";
+	if (is_state $kids[$i]) {
+        # Patch for:
+        # Use of uninitialized value $expr in concatenation (.) or string at /usr/lib/perl5/5.26.1/B/Deparse.pm line 1794.
+	    $expr = $self->deparse($kids[$i++], 0) // ''; # prevent undef $expr
+	    if ($i > $#kids) {
+		$callback->($expr, $i);
+		last;
+	    }
+	}
+	if (is_for_loop($kids[$i])) {
+	    $callback->($expr . $self->for_loop($kids[$i], 0),
+		$i += $kids[$i]->sibling->name eq "unstack" ? 2 : 1);
+	    next;
+	}
+	my $expr2 = $self->deparse($kids[$i], (@kids != 1)/2) // ''; # prevent undef $expr2
+	$expr2 =~ s/^sub :(?!:)/+sub :/; # statement label otherwise
+	$expr .= $expr2;
+	$callback->($expr, $i);
+    }
+
+};
+# ----> PATCH
+#>>>
+
+}
+elsif ($B::Deparse::VERSION) {
+    # when we update to a new perl version, this will remind us about checking
+    # if the bug is still there
+    diag
+      "Using B::Deparse v$B::Deparse::VERSION. If you see 'uninitialized' warnings, update patch in t/lib/OpenQA/Test/PatchDeparse.pm";
+}
+
+1;
+
+

tools/invoke-tests

@@ -43,10 +43,9 @@ db="$build_directory/cover_db"
 export PERL5LIB="$source_directory:$source_directory/ppmclibs:$source_directory/ppmclibs/blib/arch/auto/tinycv:$PERL5LIB"
 if [[ $WITH_COVER_OPTIONS ]]; then
     path_regex="^|$source_directory/|\\.\\./"
-    select="($path_regex)(OpenQA|backend|consoles|ppmclibs)/|($path_regex)isotovideo|($path_regex)[^/]+\.pm,-ignore,\.t|data/tests/|fake/tests/|/CheckGitStatus.pm|$prove_path"
-    export PERL5OPT="-I$source_directory/t/lib -MOpenQA::Test::CheckGitStatus -MDevel::Cover=-db,$db,-select,$select,-coverage,statement"
+    select="($path_regex)(OpenQA|backend|consoles|ppmclibs)/|($path_regex)isotovideo|($path_regex)[^/]+\.pm,-ignore,external/|\.t|data/tests/|fake/tests/|/CheckGitStatus.pm|$prove_path"
+    export PERL5OPT="-I$source_directory/t/lib -I$source_directory/external/os-autoinst-common/lib -MOpenQA::Test::CheckGitStatus -MDevel::Cover=-db,$db,-select,$select,-coverage,statement -MOpenQA::Test::PatchDeparse"
 fi
-
 # set variables for tests which need to invoke the make tool
 export OS_AUTOINST_BUILD_DIRECTORY=$build_directory
 export OS_AUTOINST_MAKE_TOOL=$make_path