1use strict;
2use warnings;
3use Test::More qw(no_plan);
4BEGIN { use_ok('Geo::GDAL') };
5
6use vars qw/%available_driver %test_driver $loaded $verbose @types @fails @tested_drivers/;
7
8$loaded = 1;
9
10$verbose = $ENV{VERBOSE};
11
12# tests:
13#
14# for pre-tested GDAL drivers:
15#   Create dataset
16#   Get/SetGeoTransform
17#   Get/SetNoDataValue
18#   Colortable operations
19#   WriteRaster
20#   Open dataset
21#   ReadRaster
22#   GCPs
23#
24# not yet tested:
25#   Overviews
26#
27# if verbose = 1, all operations (skip,fail,ok) are printed out
28
29system "rm -rf tmp_ds_*" unless $^O eq 'MSWin32';
30
31{
32    # test memory files
33    my $fp = Geo::GDAL::VSIFOpenL('/vsimem/x', 'w');
34    my $c = Geo::GDAL::VSIFWriteL("hello world!\n", $fp);
35    ok($c == 13, 'Wrote 13 characters to a memory file.');
36    Geo::GDAL::VSIFCloseL($fp);
37    $fp = Geo::GDAL::VSIFOpenL('/vsimem/x', 'r');
38    my $b = Geo::GDAL::VSIFReadL(40, $fp);
39    ok($b eq "hello world!\n", 'Read back what I Wrote to a memory file.');
40    Geo::GDAL::VSIFCloseL($fp);
41    Geo::GDAL::Unlink('/vsimem/x');
42}
43
44{
45    my $driver = Geo::GDAL::GetDriver('MEM');
46    my $dataset = $driver->Create('tmp', 10, 10, 3 , 'Int32', {});
47    ok($dataset->isa('Geo::GDAL::Dataset'), 'Geo::GDAL::Dataset');
48    ok($dataset->{RasterXSize} == 10, "Geo::GDAL::Dataset::RasterXSize $dataset->{RasterXSize}");
49    ok($dataset->{RasterCount} == 3, "Geo::GDAL::Dataset::RasterCount $dataset->{RasterCount}");
50    my $drv = $dataset->GetDriver;
51    ok($drv->isa('Geo::GDAL::Driver'), 'Geo::GDAL::Dataset::GetDriver');
52    my @size = $dataset->Size();
53    ok(is_deeply([10,10], \@size), "Geo::GDAL::Dataset::Size @size");
54    my $r = $dataset->GetRasterBand(1);
55    my $g = $dataset->GetRasterBand(2);
56    my $b = $dataset->GetRasterBand(3);
57
58    $b->WriteTile([
59    [1,2,3,4,5,6,7,8,9,10],
60    [1,2,3,4,5,6,7,8,9,10],
61    [1,2,3,4,5,6,7,8,9,10],
62    [1,2,3,0,0,0,0,8,9,10],
63    [1,2,3,0,0,0,0,8,9,10],
64    [1,2,3,0,0,0,0,8,9,10],
65    [1,2,3,0,0,0,0,8,9,10],
66    [1,2,3,4,5,6,7,8,9,10],
67    [1,2,3,4,5,6,7,8,9,10],
68    [1,2,3,4,5,6,7,8,9,10]
69    ]);
70    $r->WriteTile([
71    [1,2,3,4,5,6,7,8,9,10],
72    [1,2,3,4,5,6,7,8,9,10],
73    [1,2,3,4,5,6,7,8,9,10],
74    [1,2,3,0,0,0,0,8,9,10],
75    [1,2,3,0,0,0,0,8,9,10],
76    [1,2,3,0,0,0,0,8,9,10],
77    [1,2,3,0,0,0,0,8,9,10],
78    [1,2,3,4,5,6,7,8,9,10],
79    [1,2,3,4,5,6,7,8,9,10],
80    [1,2,3,4,5,6,7,8,9,10]
81    ]);
82    $g->WriteTile($b->ReadTile);
83    $b->FillNodata($r);
84    #print STDERR "@$_\n" for (@{$b->ReadTile()});
85
86    my @histogram;
87    eval {
88	@histogram = $b->GetHistogram();
89    };
90    ok($#histogram == 255, "Histogram");
91    eval {
92	$b->SetDefaultHistogram(1,10,[0..255]);
93    };
94    my ($min, $max, $histogram);
95    eval {
96	($min,$max,$histogram) = $b->GetDefaultHistogram();
97    };
98    ok(($#$histogram == 255), "Default Histogram $#histogram == 255");
99    eval {
100	@histogram = $b->GetHistogram(Min=>0, Max=>100, Buckets=>20);
101    };
102    ok($#histogram == 19, "Histogram with parameters");
103
104    Geo::GDAL::RegenerateOverview($r, $b, 'GAUSS');
105
106    my $band = $r;
107
108    my $colors = $band->ColorTable(Geo::GDAL::ColorTable->new);
109    my @table = $colors->ColorTable([10,20,30,40],[20,20,30,40]);
110    for (@table) {
111	@$_ = (1,2,3,4) if $_->[0] == 10;
112    }
113    my @table2 = $colors->ColorTable(@table);
114    ok($table[1]->[1] == 20, "colortable 1");
115    ok($table2[0]->[2] == 3, "colortable 2");
116
117    my @data;
118    for my $yoff (0..9) {
119	push @data, [$yoff..9+$yoff];
120    }
121    $band->WriteTile(\@data);
122    for my $yoff (4..6) {
123	for my $xoff (3..4) {
124	    $data[$yoff][$xoff] = 0;
125	}
126    }
127    my $data = $band->ReadTile(3,4,2,3);
128    for my $y (@$data) {
129	for (@$y) {
130	    $_ = 0;
131	}
132    }
133    $band->WriteTile($data,3,4);
134    $data = $band->ReadTile();
135    ok(is_deeply(\@data,$data), "write/read tile");
136}
137
138{
139    my $DOWARN = 0;
140    BEGIN { $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN } }
141    my $r = Geo::GDAL::RasterAttributeTable->new;
142    my @t = $r->FieldTypes;
143    my @u = $r->FieldUsages;
144    my %colors = (Red=>1, Green=>1, Blue=>1, Alpha=>1);
145    my @types;
146    my @usages;
147    for my $u (@u) {
148	for my $t (@t) {
149	    $r->CreateColumn("$t $u", $t, $u); # do not warn about RAT column types
150            push @types, $t;
151            push @usages, $u;
152	}
153    }
154    $DOWARN = 1;
155    my $n = $r->GetColumnCount;
156    my $n2 = @t * @u;
157    ok($n == $n2, "create rat column");
158    $r->SetRowCount(1);
159    my $i = 0;
160    for my $c (0..$n-1) {
161        my $usage = $r->GetUsageOfCol($c);
162        ok($usage eq $usages[$c], "usage $usage eq $usages[$c]");
163        my $type = $r->GetTypeOfCol($c);
164        if ($colors{$usage}) {
165            ok($type eq 'Integer', "type $type eq 'Integer'");
166        } else {
167            ok($type eq $types[$c], "type $type eq $types[$c]");
168        }
169        for ($type) {
170            if (/Integer/) {
171                my $v = $r->Value($i, $c, 12);
172                ok($v == 12, "rat int ($i,$c): $v vs 12");
173            } elsif (/Real/) {
174                my $v = $r->Value($i, $c, 1.23);
175                ok($v == 1.23, "rat real ($i,$c): $v vs 1.23");
176            } elsif (/String/) {
177                my $v = $r->Value($i, $c, "abc");
178                ok($v eq 'abc', "rat str ($i,$c): $v vs 'abc'");
179            }
180        }
181    }
182}
183
184gdal_tests();
185
186SKIP: {
187    my $src;
188    eval {
189        $src = Geo::OSR::SpatialReference->new(EPSG => 2392);
190    };
191
192    skip "GDAL support files not found. Please set GDAL_DATA.", 1 if $@;
193
194    my $xml = $src->ExportToXML();
195    $a = Geo::GDAL::ParseXMLString($xml);
196    $xml = Geo::GDAL::SerializeXMLTree($a);
197    $b = Geo::GDAL::ParseXMLString($xml);
198    ok(is_deeply($a, $b), "xml parsing");
199}
200
201my @tmp = sort keys %available_driver;
202
203#print STDERR "\nGDAL version: ",Geo::GDAL::VersionInfo,"\n";
204#print STDERR "Unexpected failures:\n",@fails,"\n" if @fails;
205#print STDERR "Available drivers were ",join(', ',@tmp),"\n";
206#print STDERR "Drivers used in tests were: ",join(', ',@tested_drivers),"\n";
207
208system "rm -rf tmp_ds_*" unless $^O eq 'MSWin32';
209
210###########################################
211#
212# only subs below
213#
214###########################################
215
216sub gdal_tests {
217
218    my $name = 'MEM';
219
220    my $driver = Geo::GDAL::Driver($name);
221
222    my @create = (qw/Byte Float32 UInt16 Int16 CInt16 CInt32 CFloat32/);
223
224    push @tested_drivers, $name;
225
226    for my $type (@create) {
227
228        my $filename = "tmp_ds_".$driver->{ShortName}."_$type";
229        my $width = 100;
230        my $height = 50;
231        my $bands = 1;
232        my $options = undef;
233
234        my $dataset;
235
236        eval {
237            $dataset = $driver->Create($filename, $width, $height, $bands, $type, {});
238        };
239
240        mytest($dataset, @$, $name, $type, "$name $type dataset create");
241        next unless $dataset;
242
243        mytest($dataset->{RasterXSize} == $width,'RasterXSize',$name,$type,'RasterXSize');
244        mytest($dataset->{RasterYSize} == $height,'RasterYSize',$name,$type,'RasterYSize');
245
246        my $band = $dataset->GetRasterBand(1);
247
248        my $transform = $dataset->GetGeoTransform();
249        $transform->[5] = 12;
250        $dataset->SetGeoTransform($transform);
251        my $transform2 = $dataset->GetGeoTransform();
252        mytest($transform->[5] == $transform2->[5],
253               "$transform->[5] != $transform2->[5]",$name,$type,'Get/SetGeoTransform');
254
255        $band->ColorInterpretation('GreenBand');
256        my $value = $band->ColorInterpretation;
257        mytest($value eq 'GreenBand',"$value ne GreenBand",$name,$type,'ColorInterpretation');
258
259        $band->SetNoDataValue(5);
260        my $value = $band->GetNoDataValue;
261        mytest($value == 5,"$value != 5",$name,$type,'Get/SetNoDataValue');
262
263        my $colortable = Geo::GDAL::ColorTable->new('Gray');
264        my @rgba = (255,0,0,255);
265        $colortable->SetColorEntry(0, \@rgba);
266        $band->ColorTable($colortable);
267        $colortable = $band->ColorTable;
268        my @rgba2 = $colortable->GetColorEntry(0);
269
270        mytest($rgba[0] == $rgba2[0] and
271               $rgba[1] == $rgba2[1] and
272               $rgba[2] == $rgba2[2] and
273               $rgba[3] == $rgba2[3],"colors do not match",$name,$type,'Colortable');
274
275        my $pc;
276        eval {
277            $pc = Geo::GDAL::PackCharacter($band->{DataType});
278        };
279
280        if ($pc) {
281            $pc = "${pc}[$width]";
282            my $scanline = pack($pc,(1..$width));
283
284            for my $yoff (0..$height-1) {
285                $band->WriteRaster( 0, $yoff, $width, 1, $scanline );
286            }
287        }
288
289        my @gcps = ();
290        push @gcps,new Geo::GDAL::GCP(1.1,2.2);
291        push @gcps,new Geo::GDAL::GCP(2.1,3.2);
292        my $po = "GEOGCS[\"WGS 84\",DATUM[\"WGS_1984\",SPHEROID[\"WGS 84\",6378137,298.257223563,AUTHORITY[\"EPSG\",\"7030\"]],AUTHORITY[\"EPSG\",\"6326\"]],PRIMEM[\"Greenwich\",0,AUTHORITY[\"EPSG\",\"8901\"]],UNIT[\"degree\",0.0174532925199433,AUTHORITY[\"EPSG\",\"9122\"]],AXIS[\"Latitude\",NORTH],AXIS[\"Longitude\",EAST],AUTHORITY[\"EPSG\",\"4326\"]]";
293        $dataset->SetGCPs(\@gcps,$po);
294        my $c = $dataset->GetGCPCount();
295        my $p = $dataset->GetGCPProjection();
296        my $gcps = $dataset->GetGCPs();
297        my $y1 = $gcps->[0]->{Y};
298        my $y2 = $gcps->[1]->{Y};
299        my $y1o = $gcps[0]->{Y};
300        my $y2o = $gcps[1]->{Y};
301        mytest(($c == 2 and $p eq $po and $y1 == $y1o and $y2 == $y2o),
302               "$c != 2 or $p ne $po or $y1 != $y1o or $y2 != $y2o",$name,$type,'Set/GetGCPs');
303
304        undef $band;
305        undef $dataset;
306
307        unless ($name eq 'MEM') {
308            eval {
309                $dataset = Geo::GDAL::Open($filename);
310            };
311            mytest($dataset,'no message',$name,$type,"open $filename");
312        }
313
314        if ($dataset) {
315            mytest($dataset->{RasterXSize} == $width,'RasterXSize',$name,$type,'RasterXSize');
316            mytest($dataset->{RasterYSize} == $height,'RasterYSize',$name,$type,'RasterYSize');
317
318            my $band = $dataset->GetRasterBand(1);
319
320            {
321                my @a = ('abc','def');
322                my @b = $band->CategoryNames(@a);
323                ok(is_deeply(\@a, \@b,"$name,$type,CategoryNames"));
324            }
325
326            if ($pc) {
327
328                my $scanline = $band->ReadRaster( 0, 0, $width, 1);
329                my @data = unpack($pc, $scanline);
330                mytest($data[49] == 50,'',$name,$type,'ReadRaster');
331
332            }
333
334        }
335        undef $dataset;
336    }
337}
338
339sub cmp_ar {
340    my($n,$a1,$a2) = @_;
341    return 0 unless $n == @$a1;
342    return 0 unless $#$a1 == $#$a2;
343    for my $i (0..$#$a1) {
344	return 0 unless abs($a1->[$i] - $a2->[$i]) < 0.001;
345    }
346    return 1;
347}
348
349sub mytest {
350    my $test = shift;
351    my $msg = shift;
352    my $context = join(': ',@_);
353    ok($test, $context);
354    unless ($test) {
355	my $err = $msg;
356	if ($@) {
357	    $@ =~ s/\n/ /g;
358	    $@ =~ s/\s+$//;
359	    $@ =~ s/\s+/ /g;
360	    $@ =~ s/^\s+$//;
361	    $err = $@ ? "'$@'" : $msg;
362	}
363	$msg = "$context: $err: not ok\n";
364	push @fails,$msg;
365    } elsif ($test =~ /^skip/) {
366	$msg = "$context: $test.\n";
367    } else {
368	$msg = "$context: ok.\n";
369    }
370    print $msg if $verbose;
371    return $msg;
372}
373
374sub dumphash {
375    my $h = shift;
376    for (keys %$h) {
377	print "$_ $h->{$_}\n";
378    }
379}
380