diff --git a/src/test/perl/PostgreSQL/Test/AdjustUpgrade.pm b/src/test/perl/PostgreSQL/Test/AdjustUpgrade.pm new file mode 100644 index 0000000000..d8fbf0572a --- /dev/null +++ b/src/test/perl/PostgreSQL/Test/AdjustUpgrade.pm @@ -0,0 +1,215 @@ + +# Copyright (c) 2023, PostgreSQL Global Development Group + +=pod + +=head1 NAME + +PostgreSQL::Test::AdjustUpgrade - helper module for cross-version upgrade tests + +=head1 SYNOPSIS + + use PostgreSQL::Test::AdjustUpgrade; + + # Build commands to adjust contents of old-version database before dumping + $statements = adjust_database_contents($old_version, %dbnames); + + # Adjust contents of old pg_dumpall output file to match newer version + $dump = adjust_old_dumpfile($old_version, $dump); + + # Adjust contents of new pg_dumpall output file to match older version + $dump = adjust_new_dumpfile($old_version, $dump); + +=head1 DESCRIPTION + +C encapsulates various hacks needed to +compare the results of cross-version upgrade tests. + +=cut + +package PostgreSQL::Test::AdjustUpgrade; + +use strict; +use warnings; + +use Exporter 'import'; +use PostgreSQL::Version; + +our @EXPORT = qw( + adjust_database_contents + adjust_old_dumpfile + adjust_new_dumpfile +); + +=pod + +=head1 ROUTINES + +=over + +=item $statements = adjust_database_contents($old_version, %dbnames) + +Generate SQL commands to perform any changes to an old-version installation +that are needed before we can pg_upgrade it into the current PostgreSQL +version. + +Typically this involves dropping or adjusting no-longer-supported objects. + +Arguments: + +=over + +=item C: Branch we are upgrading from, represented as a +PostgreSQL::Version object. + +=item C: Hash of database names present in the old installation. + +=back + +Returns a reference to a hash, wherein the keys are database names and the +values are arrayrefs to lists of statements to be run in those databases. + +=cut + +sub adjust_database_contents +{ + my ($old_version, %dbnames) = @_; + my $result = {}; + + # remove dbs of modules known to cause pg_upgrade to fail + # anything not builtin and incompatible should clean up its own db + foreach my $bad_module ('test_ddl_deparse', 'tsearch2') + { + if ($dbnames{"contrib_regression_$bad_module"}) + { + _add_st($result, 'postgres', + "drop database contrib_regression_$bad_module"); + delete($dbnames{"contrib_regression_$bad_module"}); + } + } + + # avoid version number issues with test_ext7 + if ($dbnames{contrib_regression_test_extensions}) + { + _add_st( + $result, + 'contrib_regression_test_extensions', + 'drop extension if exists test_ext7'); + } + + # get rid of dblink's dependencies on regress.so + my $regrdb = + $old_version le '9.4' + ? 'contrib_regression' + : 'contrib_regression_dblink'; + + if ($dbnames{$regrdb}) + { + _add_st( + $result, $regrdb, + 'drop function if exists public.putenv(text)', + 'drop function if exists public.wait_pid(integer)'); + } + + return $result; +} + +# Internal subroutine to add statement(s) to the list for the given db. +sub _add_st +{ + my ($result, $db, @st) = @_; + + $result->{$db} ||= []; + push(@{ $result->{$db} }, @st); +} + +=pod + +=item adjust_old_dumpfile($old_version, $dump) + +Edit a dump output file, taken from the adjusted old-version installation +by current-version C, so that it will match the results of +C on the pg_upgrade'd installation. + +Typically this involves coping with cosmetic differences in the output +of backend subroutines used by pg_dump. + +Arguments: + +=over + +=item C: Branch we are upgrading from, represented as a +PostgreSQL::Version object. + +=item C: Contents of dump file + +=back + +Returns the modified dump text. + +=cut + +sub adjust_old_dumpfile +{ + my ($old_version, $dump) = @_; + + # use Unix newlines + $dump =~ s/\r\n/\n/g; + + # Version comments will certainly not match. + $dump =~ s/^-- Dumped from database version.*\n//mg; + + # Suppress blank lines, as some places in pg_dump emit more or fewer. + $dump =~ s/\n\n+/\n/g; + + return $dump; +} + +=pod + +=item adjust_new_dumpfile($old_version, $dump) + +Edit a dump output file, taken from the pg_upgrade'd installation +by current-version C, so that it will match the old +dump output file as adjusted by C. + +Typically this involves deleting data not present in the old installation. + +Arguments: + +=over + +=item C: Branch we are upgrading from, represented as a +PostgreSQL::Version object. + +=item C: Contents of dump file + +=back + +Returns the modified dump text. + +=cut + +sub adjust_new_dumpfile +{ + my ($old_version, $dump) = @_; + + # use Unix newlines + $dump =~ s/\r\n/\n/g; + + # Version comments will certainly not match. + $dump =~ s/^-- Dumped from database version.*\n//mg; + + # Suppress blank lines, as some places in pg_dump emit more or fewer. + $dump =~ s/\n\n+/\n/g; + + return $dump; +} + +=pod + +=back + +=cut + +1; diff --git a/src/test/perl/PostgreSQL/Version.pm b/src/test/perl/PostgreSQL/Version.pm new file mode 100644 index 0000000000..8d4dbbf694 --- /dev/null +++ b/src/test/perl/PostgreSQL/Version.pm @@ -0,0 +1,167 @@ +############################################################################ +# +# PostgreSQL/Version.pm +# +# Module encapsulating Postgres Version numbers +# +# Copyright (c) 2021-2022, PostgreSQL Global Development Group +# +############################################################################ + +=pod + +=head1 NAME + +PostgreSQL::Version - class representing PostgreSQL version numbers + +=head1 SYNOPSIS + + use PostgreSQL::Version; + + my $version = PostgreSQL::Version->new($version_arg); + + # compare two versions + my $bool = $version1 <= $version2; + + # or compare with a number + $bool = $version < 12; + + # or with a string + $bool = $version lt "13.1"; + + # interpolate in a string + my $stringyval = "version: $version"; + + # get the major version + my $maj = $version->major; + +=head1 DESCRIPTION + +PostgreSQL::Version encapsulates Postgres version numbers, providing parsing +of common version formats and comparison operations. + +=cut + +package PostgreSQL::Version; + +use strict; +use warnings; + +use Scalar::Util qw(blessed); + +use overload + '<=>' => \&_version_cmp, + 'cmp' => \&_version_cmp, + '""' => \&_stringify; + +=pod + +=head1 METHODS + +=over + +=item PostgreSQL::Version->new($version) + +Create a new PostgreSQL::Version instance. + +The argument can be a number like 12, or a string like '12.2' or the output +of a Postgres command like `psql --version` or `pg_config --version`; + +=back + +=cut + +sub new +{ + my $class = shift; + my $arg = shift; + + chomp $arg; + + # Accept standard formats, in case caller has handed us the output of a + # postgres command line tool + my $devel; + ($arg, $devel) = ($1, $2) + if ( + $arg =~ m!^ # beginning of line + (?:\(?PostgreSQL\)?\s)? # ignore PostgreSQL marker + (\d+(?:\.\d+)*) # version number, dotted notation + (devel|(?:alpha|beta|rc)\d+)? # dev marker - see version_stamp.pl + !x); + + # Split into an array + my @numbers = split(/\./, $arg); + + # Treat development versions as having a minor/micro version one less than + # the first released version of that branch. + push @numbers, -1 if ($devel); + + $devel ||= ""; + + return bless { str => "$arg$devel", num => \@numbers }, $class; +} + +# Routine which compares the _pg_version_array obtained for the two +# arguments and returns -1, 0, or 1, allowing comparison between two +# PostgreSQL::Version objects or a PostgreSQL::Version and a version string or number. +# +# If the second argument is not a blessed object we call the constructor +# to make one. +# +# Because we're overloading '<=>' and 'cmp' this function supplies us with +# all the comparison operators ('<' and friends, 'gt' and friends) +# +sub _version_cmp +{ + my ($a, $b, $swapped) = @_; + + $b = __PACKAGE__->new($b) unless blessed($b); + + ($a, $b) = ($b, $a) if $swapped; + + my ($an, $bn) = ($a->{num}, $b->{num}); + + for (my $idx = 0;; $idx++) + { + return 0 + if ($idx >= @$an && $idx >= @$bn); + # treat a missing number as 0 + my ($anum, $bnum) = ($an->[$idx] || 0, $bn->[$idx] || 0); + return $anum <=> $bnum + if ($anum <=> $bnum); + } +} + +# Render the version number using the saved string. +sub _stringify +{ + my $self = shift; + return $self->{str}; +} + +=pod + +=over + +=item major([separator => 'char']) + +Returns the major version. For versions before 10 the parts are separated by +a dot unless the separator argument is given. + +=back + +=cut + +sub major +{ + my ($self, %params) = @_; + my $result = $self->{num}->[0]; + if ($result + 0 < 10) + { + my $sep = $params{separator} || '.'; + $result .= "$sep$self->{num}->[1]"; + } + return $result; +} + +1;