Bogus cleanup code in PostgresNode.pm - Mailing list pgsql-hackers

I noticed that even when they are successful, buildfarm members bowerbird
and jacana tend to spew a lot of messages like this in their bin-check
steps:

Can't remove directory /home/pgrunner/bf/root/HEAD/pgsql.build/src/bin/scripts/tmp_check/data_main_DdUf/pgdata/global:
Directorynot empty at /usr/lib/perl5/5.8/File/Temp.pm line 898 
Can't remove directory /home/pgrunner/bf/root/HEAD/pgsql.build/src/bin/scripts/tmp_check/data_main_DdUf/pgdata/pg_xlog:
Directorynot empty at /usr/lib/perl5/5.8/File/Temp.pm line 898 
Can't remove directory /home/pgrunner/bf/root/HEAD/pgsql.build/src/bin/scripts/tmp_check/data_main_DdUf/pgdata:
Permissiondenied at /usr/lib/perl5/5.8/File/Temp.pm line 898 
Can't remove directory /home/pgrunner/bf/root/HEAD/pgsql.build/src/bin/scripts/tmp_check/data_main_DdUf: Directory not
emptyat /usr/lib/perl5/5.8/File/Temp.pm line 898 
### Signalling QUIT to 9156 for node "main"
# Running: pg_ctl kill QUIT 9156

What is happening here is that the test script is not bothering to do an
explicit $node->stop operation, and if it doesn't, the automatic cleanup
steps happen in the wrong order: the File::Temp destructor for the temp
data directory runs before PostgresNode.pm's DESTROY function, which is
what's issuing the "pg_ctl kill" command.  On Unix that's just messy,
but on Windows it fails because you can't delete a process's working
directory.  I am not sure whether this is guaranteed wrong or just
sometimes wrong; the Perl docs I can find say that destructors are run in
unspecified order once interpreter shutdown begins.  But by adding some
debug printout I was able to verify on my own machine that the data
directory was already gone when DESTROY runs.

I believe we can fix this by forcing postmaster shutdown in an END
routine instead of a DESTROY routine, and hence propose the attached
patch, which does things in the right order for me.  I'm a pretty
poor Perl programmer, so I'd appreciate somebody vetting this.

            regards, tom lane

diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
index cd2e974..120f3f2 100644
*** a/src/test/perl/PostgresNode.pm
--- b/src/test/perl/PostgresNode.pm
*************** sub stop
*** 662,667 ****
--- 662,668 ----
      my $pgdata = $self->data_dir;
      my $name   = $self->name;
      $mode = 'fast' unless defined $mode;
+     return unless defined $self->{_pid};
      print "### Stopping node \"$name\" using mode $mode\n";
      TestLib::system_log('pg_ctl', '-D', $pgdata, '-m', $mode, 'stop');
      $self->{_pid} = undef;
*************** sub get_new_node
*** 883,896 ****
      return $node;
  }

! # Attempt automatic cleanup
! sub DESTROY
  {
!     my $self = shift;
!     my $name = $self->name;
!     return unless defined $self->{_pid};
!     print "### Signalling QUIT to $self->{_pid} for node \"$name\"\n";
!     TestLib::system_log('pg_ctl', 'kill', 'QUIT', $self->{_pid});
  }

  =pod
--- 884,896 ----
      return $node;
  }

! # Attempt automatic cleanup of all created nodes
! sub END
  {
!     foreach my $node (@all_nodes)
!     {
!         $node->teardown_node;
!     }
  }

  =pod