1#! /usr/bin/perl -w
2
3=pod
4File: aplgorithm testes
5
6Copyright (c) 2013 pgRouting developers
7
8Function contributors:
9  	Celia Virginia Vergara Castillo
10  	Stephen Woodbridge
11  	Vadim Zhukov
12	Nagase Ko
13
14Mail:
15
16------
17
18This program is free software; you can redistribute it and/or modify
19it under the terms of the GNU General Public License as published by
20the Free Software Foundation; either version 2 of the License, or
21(at your option) any later version.
22
23This program is distributed in the hope that it will be useful,
24but WITHOUT ANY WARRANTY; without even the implied warranty of
25MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
26GNU General Public License for more details.
27
28You should have received a copy of the GNU General Public License
29along with this program; if not, write to the Free Software
30Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
31=cut
32
33
34eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
35if 0; #$running_under_some_shell
36
37use strict;
38use lib './';
39use File::Find ();
40use File::Basename;
41use Data::Dumper;
42use Time::HiRes qw(gettimeofday tv_interval);
43$Data::Dumper::Sortkeys = 1;
44
45# for the convenience of &wanted calls, including -eval statements:
46use vars qw/*name *dir *prune/;
47*name   = *File::Find::name;
48*dir    = *File::Find::dir;
49*prune  = *File::Find::prune;
50
51my $POSGRESQL_MIN_VERSION = '9.2';
52my $DOCUMENTATION = 0;
53my $INTERNAL_TESTS = 0;
54my $VERBOSE = 0;
55my $DRYRUN = 0;
56my $DEBUG = 0;
57my $DEBUG1 = 0;
58my $FORCE = 0;
59
60my $DBNAME = "pgr_test__db__test";
61my $DBUSER;
62my $DBHOST;
63my $DBPORT;
64
65sub Usage {
66    die "Usage: doc_queries_generator.pl -pgver vpg -pgisver vpgis -psql /path/to/psql\n" .
67    "       -pgver vpg          - postgresql version\n" .
68    "       -pghost host        - postgresql host or socket directory to use\n" .
69    "       -pgport port        - postgresql port to use\n" .
70    "       -pguser username    - postgresql user role to use\n" .
71    "       -pgisver vpgis      - postgis version\n" .
72    "       -pgrver vpgr        - pgrouting version\n" .
73    "       -psql /path/to/psql - optional path to psql\n" .
74    "       -v                  - verbose messages for small debuging\n" .
75    "       -dbg                - use when CMAKE_BUILD_TYPE = DEBUG\n" .
76    "       -debug              - verbose messages for debuging(enter twice for more)\n" .
77    "       -debug1             - DEBUG1 messages (for timing reports)\n" .
78    "       -clean              - dropdb pgr_test__db__test\n" .
79    "       -ignorenotice       - ignore NOTICE statements when reporting failures\n" .
80    "       -alg 'dir'          - directory to select which algorithm subdirs to test\n" .
81    "       -documentation      - ONLY generate documentation examples\n" .
82    "       -force              - Force tests for unsupported versions >= 9.1 of postgreSQL \n" .
83    "       -h                  - help\n";
84}
85
86print "RUNNING: doc_queries_generator.pl " . join(" ", @ARGV) . "\n";
87
88my ($vpg, $postgis_ver, $vpgr, $psql);
89my $alg = '';
90my @testpath = ("docqueries/");
91my @test_direcotry = ();
92my $clean;
93my $ignore;
94
95$postgis_ver = '';
96
97while (my $a = shift @ARGV) {
98    if ( $a eq '-pgver') {
99        $vpg   = shift @ARGV || Usage();
100    }
101    elsif ($a eq '-pghost') {
102        $DBHOST = shift @ARGV || Usage();
103    }
104    elsif ($a eq '-pgport') {
105        $DBPORT = shift @ARGV || Usage();
106    }
107    elsif ($a eq '-pguser') {
108        $DBUSER = shift @ARGV || Usage();
109    }
110    elsif ($a eq '-pgisver') {
111        $postgis_ver = shift @ARGV || Usage();
112        $postgis_ver = " VERSION '$postgis_ver'";
113    }
114    elsif ($a eq '-pgrver') {
115        $vpgr = shift @ARGV || Usage();
116    }
117    elsif ($a eq '-alg') {
118        $alg = shift @ARGV || Usage();
119        @testpath = ("docqueries/$alg");
120    }
121    elsif ($a eq '-psql') {
122        $psql = shift @ARGV || Usage();
123        die "'$psql' is not executable!\n"
124        unless -x $psql;
125    }
126    elsif ($a =~ /^-h/) {
127        Usage();
128    }
129    elsif ($a =~ /^-clean/) {
130        $clean = 1;;
131    }
132    elsif ($a =~ /^-ignoren/i) {
133        $ignore = 1;;
134    }
135    elsif ($a =~ /^-debug1$/i) {
136        $DEBUG1 = 1 unless $DOCUMENTATION;
137    }
138    elsif ($a =~ /^-debug$/i) {
139        $DEBUG++;
140        $VERBOSE = 1;
141    }
142    elsif ($a =~ /^-v/i) {
143        $VERBOSE = 1;
144    }
145    elsif ($a =~ /^-force/i) {
146        $FORCE = 1;
147    }
148    elsif ($a =~ /^-doc(umentation)?/i) {
149        $DOCUMENTATION = 1;
150        $DEBUG1 = 0; # disbale timing reports during documentation generation
151    }
152    elsif ($a =~ /^-dbg/i) {
153        $INTERNAL_TESTS = 1; #directory internalQueryTests is also tested
154    }
155    else {
156        warn "Error: unknown option '$a'\n";
157        Usage();
158    }
159}
160
161my $connopts = "";
162$connopts .= " -U $DBUSER" if defined $DBUSER;
163$connopts .= " -h $DBHOST" if defined $DBHOST;
164$connopts .= " -p $DBPORT" if defined $DBPORT;
165
166mysystem("dropdb $connopts $DBNAME") if $clean;
167
168%main::tests = ();
169my @cfgs = ();
170my %stats = (z_pass=>0, z_fail=>0, z_crash=>0);
171my $TMP = "/tmp/pgr-test-runner-$$";
172my $TMP2 = "/tmp/pgr-test-runner-$$-2";
173my $TMP3 = "/tmp/pgr-test-runner-$$-3";
174
175if (! $psql) {
176    $psql = findPsql() || die "ERROR: can not find psql, specify it on the command line.\n";
177}
178
179my $OS = "$^O";
180if (length($psql)) {
181    if ($OS =~ /msys/
182        || $OS =~ /MSWin/) {
183        $psql = "\"$psql\"";
184    }
185}
186print "Operative system found: $OS\n";
187
188
189# Traverse desired filesystems
190File::Find::find({wanted => \&want_tests}, @testpath);
191
192die "Error: no test files found. Run this command from the top level pgRouting directory!\n" unless @cfgs;
193
194createTestDB($DBNAME);
195
196$vpg = '' if ! $vpg;
197$postgis_ver = '' if ! $postgis_ver;
198
199# cfgs = SET of configuration file names
200# c  one file in cfgs
201# print join("\n",@cfgs),"\n";
202for my $c (@cfgs) {
203    my $found = 0;
204
205    print "test.conf = $c\n" if $VERBOSE;
206
207    # load the config file for the tests
208    require $c;
209
210    print Data::Dumper->Dump([\%main::tests],['test']) if $VERBOSE;
211
212    if ($main::tests{any} && !$DOCUMENTATION) {
213        push @{$stats{$c}}, run_test($c, $main::tests{any});
214        $found++;
215    }
216    elsif ($main::tests{any}{documentation} && $DOCUMENTATION) {
217        push @{$stats{$c}}, run_test($c, $main::tests{any});
218        $found++;
219    }
220
221    if (! $found) {
222        $stats{$c} = "No tests were found for '$vpg-$postgis_ver'!";
223    }
224}
225
226dropTestDB();
227
228print Data::Dumper->Dump([\%stats], ['stats']);
229
230unlink $TMP;
231unlink $TMP2;
232unlink $TMP3;
233
234if ($stats{z_crash} > 0 || $stats{z_fail} > 0) {
235    exit 1;  # signal we had failures
236}
237
238exit 0;      # signal we passed all the tests
239
240
241# c  one file in cfgs
242# t  contents of array that has keys comment, data and test
243sub run_test {
244    my $c = shift;
245    my $t = shift;
246    my %res = ();
247
248    my $dir = dirname($c);
249
250    $res{comment} = $t->{comment} if $t->{comment};
251    #t->{data}  referencing the key data of the data files
252
253    my $singleDB = "____pgr___single_test___";
254    for my $testName (@{$t->{singleTest}}) {
255        createTestDB($singleDB);
256        mysystem("$psql $connopts -A -t -q -f tools/testers/sampledata.sql' $singleDB >> $TMP2 2>\&1 ");
257        for my $x (@{$t->{data}}) {
258            mysystem("$psql $connopts -A -t -q -f '$dir/$x' $singleDB >> $TMP2 2>\&1 ");
259        }
260        process_single_test($testName, $dir, $singleDB,\%res);
261        mysystem("dropdb $connopts $singleDB");
262    }
263
264    mysystem("$psql $connopts -A -t -q -f tools/testers/sampledata.sql $DBNAME >> $TMP2 2>\&1 ");
265    for my $x (@{$t->{data}}) {
266        mysystem("$psql $connopts -A -t -q -f '$dir/$x' $DBNAME >> $TMP2 2>\&1 ");
267    }
268
269    if ($INTERNAL_TESTS) {
270        for my $x (@{$t->{debugtests}}) {
271            process_single_test($x, $dir,, $DBNAME, \%res)
272        }
273    }
274    if ($DOCUMENTATION) {
275        for my $x (@{$t->{documentation}}) {
276            process_single_test($x, $dir,, $DBNAME, \%res);
277            my $cmd = q(perl -pi -e 's/[ \t]+$//');
278            $cmd .= " $dir/$x.result";
279            mysystem( $cmd );
280        }
281    }
282    else {
283        for my $x (@{$t->{tests}}) {
284            process_single_test($x, $dir,, $DBNAME, \%res)
285        }
286        if ($OS =~/msys/ || $OS=~/MSW/ || $OS =~/cygwin/) {
287            for my $x (@{$t->{windows}}) {
288                process_single_test($x, $dir,, $DBNAME, \%res)
289            }
290        } elsif ($OS=~/Mac/ ||  $OS=~/dar/) {
291            for my $x (@{$t->{macos}}) {
292                process_single_test($x, $dir,, $DBNAME, \%res)
293            }
294        } else {
295            for my $x (@{$t->{linux}}) {
296                process_single_test($x, $dir,, $DBNAME, \%res)
297            }
298        }
299    }
300
301    return \%res;
302}
303
304sub process_single_test{
305    my $x = shift;
306    my $dir = shift;
307    my $database = shift;
308    my $res = shift;
309    #each tests will use clean data
310
311    print "Processing queries $dir/$x";
312    my $t0 = [gettimeofday];
313    #TIN = test_input_file
314    open(TIN, "$dir/$x.test.sql") || do {
315        $res->{"$dir/$x.test.sql"} = "FAILED: could not open '$dir/$x.test.sql' : $!";
316        $stats{z_fail}++;
317        next;
318    };
319
320    my $level = "NOTICE";
321    $level = "WARNING" if $ignore;
322    $level = "DEBUG3" if $DEBUG1;
323
324
325    if ($DOCUMENTATION) {
326        open(PSQL, "|$psql $connopts --set='VERBOSITY terse' -e $database > $dir/$x.result 2>\&1 ") || do {
327            $res->{"$dir/$x.test.sql"} = "FAILED: could not open connection to db : $!";
328            next;
329        };
330    }
331    else {
332        #open(PSQL, "|$psql $connopts --set='VERBOSITY terse' -e $database > $dir/$x.result 2>\&1 ") || do {
333        #    $res->{"$dir/$x.test.sql"} = "FAILED: could not open connection to db : $!";
334        #    $stats{z_fail}++;
335        #    next;
336        #};
337
338        open(PSQL, "|$psql $connopts  --set='VERBOSITY terse' -e $database > $TMP 2>\&1 ") || do {
339            $res->{"$dir/$x.test.sql"} = "FAILED: could not open connection to db : $!";
340            if (!$INTERNAL_TESTS) {
341               $stats{z_fail}++;
342            }
343            next;
344        };
345    }
346
347
348    my @d = ();
349    @d = <TIN>; #reads the whole file into the array @d
350
351    print PSQL "BEGIN;\n";
352    print PSQL "SET client_min_messages TO $level;\n";
353    #prints the whole fle stored in @d
354    print PSQL @d;
355    print PSQL "\nROLLBACK;";
356
357    # executes everything
358    close(PSQL);
359    #closes the input file  /TIN = test input
360    close(TIN);
361
362    if ($DOCUMENTATION) {
363        print "\n";
364        return;
365    }
366
367    my $dfile;
368    my $dfile2;
369    if ($ignore) { #decide how to compare results, if ignoring or not ignoring
370        $dfile2 = $TMP2;
371        mysystem("grep -v NOTICE '$TMP' | grep -v '^CONTEXT:' | grep -v '^PL/pgSQL function' | grep -v '^COPY' > $dfile2");
372        $dfile = $TMP3;
373        mysystem("grep -v NOTICE '$dir/$x.result' | grep -v '^CONTEXT:' | grep -v '^PL/pgSQL function' | grep -v '^COPY' > $dfile");
374    }
375    elsif ($DEBUG1) { #to delete CONTEXT lines
376        $dfile2 = $TMP2;
377        mysystem("grep -v '^CONTEXT:' '$TMP' | grep -v '^PL/pgSQL function' | grep -v '^COPY' > $dfile2");
378        $dfile = $TMP3;
379        mysystem("grep -v '^CONTEXT:' '$dir/$x.result' | grep -v '^PL/pgSQL function' | grep -v '^COPY' > $dfile");
380    }
381    else {
382        $dfile2 = $TMP2;
383        mysystem("grep -v '^COPY' '$TMP' | grep -v 'psql:tools' > $dfile2");
384        $dfile = $TMP3;
385        mysystem("grep -v '^COPY' '$dir/$x.result' | grep -v 'psql:tools' > $dfile");
386    }
387    if (! -f "$dir/$x.result") {
388        $res->{"$dir/$x.test.sql"} = "\nFAILED: result file missing : $!";
389        $stats{z_fail}++;
390        next;
391    }
392
393    # use diff -w to ignore white space differences like \r vs \r\n
394    #ignore white spaces when comparing
395    #dfile is expected results
396    #dfile2 is the actual results
397    my $r = `diff -w '$dfile' '$dfile2' `;
398    #looks for removing leading blanks and trailing blanks
399    $r =~ s/^\s*|\s*$//g;
400    if ($r =~ /connection to server was lost/) {
401        $res->{"$dir/$x.test.sql"} = "CRASHED SERVER: $r";
402        $stats{z_crash}++;
403        # allow the server some time to recover from the crash
404        warn "CRASHED SERVER: '$dir/$x.test.sql', sleeping 5 ...\n";
405        sleep 20;
406    }
407    #if the diff has 0 length then everything was the same, so here we detect changes
408    elsif (length($r)) {
409        $res->{"$dir/$x.test.sql"} = "FAILED: $r";
410        $stats{z_fail}++ unless $DEBUG1;
411        print "\t FAIL\n";
412    }
413    else {
414        $res->{"$dir/$x.test.sql"} = "Passed";
415        $stats{z_pass}++;
416        print "\t PASS\n";
417    }
418    print "    test run time: " . tv_interval($t0, [gettimeofday]) . "\n";
419}
420
421sub createTestDB {
422    my $databaseName = shift;
423    dropTestDB() if dbExists($databaseName);
424
425    my $template;
426
427    my $dbver = getServerVersion();
428    my $dbshare = getSharePath($dbver);
429
430    if ($DEBUG) {
431        print "-- DBVERSION: $dbver\n";
432        print "-- DBSHARE: $dbshare\n";
433    }
434
435    die "
436    Unsupported postgreSQL version $dbver
437    Minimum requierment is $POSGRESQL_MIN_VERSION version
438    Use -force to force the tests\n"
439    unless version_greater_eq($dbver, $POSGRESQL_MIN_VERSION) or ($FORCE and version_greater_eq($dbver, '9.1'));
440
441    die "postGIS extension $postgis_ver not found\n"
442    unless -f "$dbshare/extension/postgis.control";
443
444
445    # Create a database with postgis installed in it
446    mysystem("createdb $connopts $databaseName");
447    die "ERROR: Failed to create database '$databaseName'!\n"
448    unless dbExists($databaseName);
449    my $encoding = '';
450    if ($OS =~ /msys/
451        || $OS =~ /MSWin/) {
452        $encoding = "SET client_encoding TO 'UTF8';";
453    }
454    print "-- Installing postgis extension $postgis_ver\n" if $DEBUG;
455    mysystem("$psql $connopts -c \"$encoding CREATE EXTENSION postgis $postgis_ver \" $databaseName");
456
457    # Install pgrouting into the database
458    my $myver = '';
459    if ($vpgr) {
460        $myver = " VERSION '$vpgr'";
461    }
462    print "Installing pgrouting extension $myver\n" if $DEBUG;
463    mysystem("$psql $connopts -c \"CREATE EXTENSION pgrouting $myver\" $databaseName");
464
465    # Verify pgrouting was installed
466
467    my $pgrv = `$psql $connopts -c "select pgr_version()" $databaseName`;
468    die "ERROR: failed to install pgrouting into the database!\n"
469    unless $pgrv;
470
471    print `$psql $connopts -c "select version();" postgres `, "\n";
472    print `$psql $connopts -c "select postgis_full_version();" $databaseName `, "\n";
473    print `$psql $connopts -c "select pgr_full_version();" $databaseName `, "\n";
474}
475
476sub dropTestDB {
477    mysystem("dropdb $connopts $DBNAME");
478}
479
480sub version_greater_eq {
481    my ($a, $b) = @_;
482
483    return 0 if !$a || !$b;
484
485    my @a = split(/\./, $a);
486    my @b = split(/\./, $b);
487
488    my $va = 0;
489    my $vb = 0;
490
491    while (@a || @b) {
492        $a = shift @a || 0;
493        $b = shift @b || 0;
494        $va = $va*1000+$a;
495        $vb = $vb*1000+$b;
496    }
497
498    return 0 if $va < $vb;
499    return 1;
500}
501
502
503sub getServerVersion {
504    my $v = `$psql $connopts -q -t -c "select version()" postgres`;
505    print "$psql $connopts -q -t -c \"select version()\" postgres\n    # RETURNED: $v\n" if $VERBOSE;
506    if ($v =~ m/PostgreSQL (\d+(\.\d+)?)/) {
507        my $version = $1 + 0;
508        print "    Got: $version\n" if $VERBOSE;
509        $version = int($version) if $version >= 10;
510        print "    Got: $version\n" if $VERBOSE;
511        return $version;
512    }
513    return undef;
514}
515
516sub dbExists {
517    my $dbname = shift;
518
519    my $isdb = `$psql $connopts -l | grep $dbname`;
520    $isdb =~ s/^\s*|\s*$//g;
521    return length($isdb);
522}
523
524sub findPsql {
525    my $psql = `which psql`;
526    $psql =~ s/^\s*|\s*$//g;
527    print "which psql = $psql\n" if $VERBOSE;
528    return length($psql)?$psql:undef;
529}
530
531# getSharePath is complicated by the fact that on Debian we can have multiple
532# versions installed in a cluster. So we get the DB version by connectiong
533# to the port for the server we want. Then we get the share path for the
534# newest version od pg installed on the cluster. And finally we change the
535# in the path to the version of the server.
536
537sub getSharePath {
538    my $pg = shift;
539
540    my $share;
541    my $isdebian = -e "/etc/debian_version";
542    my $pg_config = `which pg_config`;
543    $pg_config =~ s/^\s*|\s*$//g;
544    print "which pg_config = $pg_config\n" if $VERBOSE;
545    if (length($pg_config)) {
546        $share = `"$pg_config" --sharedir`;
547        $share =~ s/^\s*|\s*$//g;
548        if ($isdebian) {
549            $share =~ s/(\d+(\.\d+)?)$/$pg/;
550            if (length($share) && -d $share) {
551                return $share;
552            }
553        } else {
554            return "$share"
555        }
556    }
557    die "Could not determine the postgresql version" unless $pg;
558    $pg =~ s/^(\d+(\.\d+)).*$/$1/;
559    $share = "/usr/share/postgresql/$pg";
560    return $share if -d $share;
561    $share = "/usr/local/share/postgresql/$pg";
562    return $share if -d $share;
563    die "Could not determine the postgresql share dir for ($pg)!\n";
564}
565
566sub mysystem {
567    my $cmd = shift;
568    print "$cmd\n" if $VERBOSE || $DRYRUN;
569    system($cmd) unless $DRYRUN;
570}
571
572sub want_tests {
573#    /^bd_d.*\z/s &&
574#    ($File::Find::prune = 1)
575#    ||
576    /^test\.conf\z/s &&
577    push @cfgs, $name;
578    #print join("\n",@cfgs),"\n";
579}
580
581
582