Merge pull request #69 from stdweird/minor_fixes

Minor fixes
quattor · Dec 9, 2015 · 38781ad · 38781ad
2 parents d0b1322 + 61abb29
commit 38781ad
Show file tree

Hide file tree

Showing 4 changed files with 21 additions and 7 deletions.
diff --git a/build-scripts/src/main/perl/Test/Quattor.pm b/build-scripts/src/main/perl/Test/Quattor.pm
@@ -533,7 +533,19 @@ sub command_history_ok
     foreach my $cmd (@$commands) {
         # start iterating from lastidx+1
         my ( $index )= grep { $command_history[$_] =~ /$cmd/  } ($lastidx+1)..$#command_history;
-        return 0 if !defined($index) or $index <= $lastidx;
+        my $msg = "command_history_ok command pattern '$cmd'";
+        if (!defined($index)) {
+            diag "$msg no match; return false" if $log_cmd;
+            return 0;
+        } else {
+            $msg .= " index $index (full command $command_history[$index])";
+            if ($index <= $lastidx) {
+                diag "$msg <= lastindex $lastidx; return false" if $log_cmd;
+                return 0;
+            } else {
+                diag "$msg; continue" if $log_cmd;
+            }
+        };
         $lastidx = $index;
     };
     # in principle, when you get here, all is ok.

diff --git a/build-scripts/src/main/perl/Test/Quattor/Panc.pm b/build-scripts/src/main/perl/Test/Quattor/Panc.pm
@@ -157,9 +157,10 @@ sub panc
 
     my @panccmd = qw(panc --formats json --output-dir);
     push(@panccmd, $outputdir);
-    while (my ($option,$value) = each %pancoptions) {
+    foreach my $option (sort keys %pancoptions) {
         push(@panccmd, "--$option");
         # support options like --debug with no value
+        my $value = $pancoptions{$option};
         push(@panccmd, $value) if (defined($value));
     }
     $profile .= ".pan" if ($profile !~ m/\.pan$/ );

diff --git a/build-scripts/src/main/perl/Test/Quattor/RegexpTest.pm b/build-scripts/src/main/perl/Test/Quattor/RegexpTest.pm
@@ -291,12 +291,12 @@ sub make_re_flags
     my ($self, @ignore) = @_;
 
     my @reflags;
-    while (my ($flag, $reflag) = each %FLAGS_REGEXP_MAP) {
+    foreach my $flag (sort keys %FLAGS_REGEXP_MAP) {
         my $val = $self->{flags}->{$flag};
         next if (!defined($val));
         next if (grep {$flag eq $_} @ignore);
         $val = $val ? 0 : 1 if ($flag eq 'casesensitive');
-        push(@reflags, $reflag) if $val;
+        push(@reflags, $FLAGS_REGEXP_MAP{$flag}) if $val;
     }
 
     return join("", sort @reflags);

diff --git a/build-scripts/src/main/perl/Test/Quattor/TextRender.pm b/build-scripts/src/main/perl/Test/Quattor/TextRender.pm
@@ -322,11 +322,11 @@ sub make_namespace
     my ($pans, $ipans) = $self->gather_pan($panpath, $pannamespace);
 
     my @copies;
-    while (my ($pan, $value) = each %$pans) {
+    foreach my $pan (sort keys %$pans) {
         my $dest;
         if ($self->{panunfold}) {
-
             # pan is relative wrt basepath; copy it to $destination/
+            my $value = $pans->{$pan};
             $dest = "$self->{namespacepath}/$value->{expected}";
             my $destdir = dirname($dest);
             if (!-d $destdir) {
@@ -397,7 +397,8 @@ sub test_gather_pan
     is($pans->{$schema}->{type}, "declaration", "Found schema $schema");
 
     # there can be no object templates
-    while (my ($pan, $value) = each %$pans) {
+    foreach my $pan (sort keys %$pans) {
+        my $value = $pans->{$pan};
         $self->notok("No object template $pan found.") if ($value->{type} eq 'object');
     }