my
$tempd
= tempdir(
CLEANUP
=> 1 ) or
die
"Couldn't get tempdir\n"
;
my
(
$fileh
,
$file
) = tempfile(
DIR
=>
$tempd
);
for
my
$type
(PDL::Types::types()) {
ok
$type
->bswap,
"$type has bswap"
;
}
print
$fileh
<<EOD;
1,6,11
2,7,
3,8,13
4,,14
5,10,15
EOD
close
(
$fileh
);
my
$x
=
do
{
local
$PDL::undefval
= -1;
rcols
$file
, [], {
colsep
=>
','
};
};
is_pdl
$x
, pdl(
'1 2 3 4 5; 6 7 8 -1 10; 11 -1 13 14 15'
),
"rcols with undefval and missing cols"
;
unlink
(
$file
) ||
warn
"Could not unlink $file: $!"
;
(
$fileh
,
$file
) = tempfile(
DIR
=>
$tempd
);
print
$fileh
<<EOD;
1 2
2 33 FOO
3 7
4 9 FOO
5 66
EOD
close
(
$fileh
);
my
$y
;
(
$x
,
$y
) = rcols
$file
,0,1;
is_pdl
$x
, pdl(
'1 2 3 4 5'
),
"rcols with filename"
;
is_pdl
$y
, pdl(
'2 33 7 9 66'
),
"rcols with filename"
;
(
$x
,
$y
) = rcols
$file
,
"/FOO/"
,0,1;
is_pdl
$x
, pdl(
'2 4'
),
"rcols with filename + pattern"
;
is_pdl
$y
, pdl(
'33 9'
),
"rcols with filename + pattern"
;
open
my
$fh
,
'<'
,
$file
;
my
@slurp
= <
$fh
>;
$x
=
eval
{ rcols
$fh
};
is $@,
''
,
'rcols does not die on a used file handle'
;
close
$fh
;
(
$fileh
,
$file
) = tempfile(
DIR
=>
$tempd
);
print
$fileh
<<EOD;
foo"1" -2-
foo"2" Test -33-
foo"3" jvjtvbjktrbv -7-
foo"4" -9-
fjrhfiurhe foo"5" jjjj -66-
EOD
close
(
$fileh
);
open
OUT,
$file
or
die
"Can not open $file for reading\n"
;
(
$x
,
$y
) = rgrep {/foo
"(.*)"
.*-(.*)-/}
*OUT
;
close
OUT;
is_pdl
$x
, pdl(
'1 2 3 4 5'
),
"rgrep"
;
is_pdl
$y
, pdl(
'2 33 7 9 66'
),
"rgrep"
;
$x
= short(3);
$y
= long(3);
bswap2(
$x
); bswap4(
$y
);
is_pdl
$x
, short(768),
"bswap2"
;
is_pdl
$y
, long(50331648),
"bswap4"
;
$x
= short(3);
$x
->type->bswap->(
$x
);
is_pdl
$x
, short(768),
"bswap Type method"
;
eval
{
$x
->bswap8};
like $@,
qr/Tried to/
,
'bswap of greater than ndarray type-size gives error'
;
(
$fileh
,
$file
) = tempfile(
DIR
=>
$tempd
);
print
$fileh
<<EOD;
0.231862613
0.20324005
0.067813045
0.040103501
0.438047631
0.283293628
0.375427346
0.195821617
0.189897617
0.035941205
0.339051483
0.096540854
0.25047197
0.579782013
0.236164184
0.221568561
0.009776015
0.290377604
0.785569601
0.260724391
EOD
close
(
$fileh
);
$x
= PDL->null;
$x
->rasc(
$file
,20);
is_pdl
$x
, pdl(
'0.231862613 0.20324005 0.067813045 0.040103501 0.438047631 0.283293628 0.375427346 0.195821617 0.189897617 0.035941205 0.339051483 0.096540854 0.25047197 0.579782013 0.236164184 0.221568561 0.009776015 0.290377604 0.785569601 0.260724391'
),
"rasc on null ndarray"
;
$y
= zeroes(float,20,2);
$y
->rasc(
$file
);
is_pdl
$y
, float(
'0.231862613 0.20324005 0.067813045 0.040103501 0.438047631 0.283293628 0.375427346 0.195821617 0.189897617 0.035941205 0.339051483 0.096540854 0.25047197 0.579782013 0.236164184 0.221568561 0.009776015 0.290377604 0.785569601 0.260724391; 0 0 0 0 0 0 0 0 0 0'
),
"rasc on existing ndarray"
;
eval
{
$y
->rasc(
"file_that_does_not_exist"
) };
like $@,
qr/Can't open/
,
"rasc on non-existant file"
;
unlink
(
$file
) ||
warn
"Could not unlink $file: $!"
;
(
$fileh
,
$file
) = tempfile(
DIR
=>
$tempd
);
print
$fileh
<<EOD;
1 2
# comment line
3 4
-5 6
7 8
EOD
close
(
$fileh
);
(
$x
,
$y
) = rcols
$file
,0,1;
is_pdl
$x
, pdl(1,3,-5,7),
"rcols: default"
;
is_pdl
$y
, pdl(2,4,6,8),
"rcols: default"
;
(
$x
,
$y
) = rcols \
*DATA
,0,1;
is_pdl
$x
, pdl(1,3,-5,7),
"rcols: fh"
;
is_pdl
$y
, pdl(2,4,6,8),
"rcols: fh"
;
(
$x
,
$y
) = rcols
$file
,0,1, {
INCLUDE
=>
'/^-/'
};
is_pdl
$x
, pdl([-5]),
"rcols: include pattern"
;
is_pdl
$y
, pdl([6]),
"rcols: include pattern"
;
(
$x
,
$y
) = rcols
$file
,0,1, {
LINES
=>
'-2:0'
};
is_pdl
$x
, pdl(-5,3,1),
"rcols: lines option"
;
is_pdl
$y
, pdl(6,4,2),
"rcols: lines option"
;
(
$x
,
$y
) = rcols
$file
, {
DEFTYPE
=> long };
is_pdl
$x
, long(1,3,-5,7),
"rcols: deftype option"
;
is_pdl
$y
, long(2,4,6,8),
"rcols: deftype option"
;
(
$x
,
$y
) = rcols
$file
, {
TYPES
=> [ ushort ] };
is_pdl
$x
, ushort(1,3,-5,7),
"rcols: types option"
;
is_pdl
$y
, double(2,4,6,8),
"rcols: types option"
;
my
$ix
= PDL->rcols(
$file
, [0,1], {
TYPES
=> [ indx ],
IGNORE
=>
qr/^\s*#/
});
is_pdl
$ix
, indx(
'1 3 -5 7; 2 4 6 8'
),
"rcols: types option"
;
isa_ok
$PDL::IO::Misc::deftype
,
"PDL::Type"
,
"PDL::IO::Misc::deftype"
;
is
$PDL::IO::Misc::deftype
,
'double'
,
"PDL::IO::Misc::deftype check"
;
$PDL::IO::Misc::deftype
= short;
(
$x
,
$y
) = rcols
$file
;
is(
$x
->get_datatype, short->enum,
"rcols: can read in as 'short'"
);
unlink
(
$file
) or
warn
"Could not unlink $file: $!"
;
(
$fileh
,
$file
) = tempfile(
DIR
=>
$tempd
);
eval
{ wcols
$x
,
$y
,
$fileh
};
is $@,
''
,
"wcols"
;
unlink
(
$file
) or
warn
"Could not unlink $file: $!"
;
(
$fileh
,
$file
) = tempfile(
DIR
=>
$tempd
);
eval
{ wcols
$x
,
$y
,
$fileh
, {
FORMAT
=>
"%0.3d %0.3d"
}};
is $@,
''
,
"wcols FORMAT option"
;
unlink
(
$file
) or
warn
"Could not unlink $file: $!"
;
(
$fileh
,
$file
) = tempfile(
DIR
=>
$tempd
);
eval
{ wcols
"%d %d"
,
$x
,
$y
,
$fileh
;};
is $@,
''
,
"wcols format_string"
;
unlink
(
$file
) or
warn
"Could not unlink $file: $!"
;
(
$fileh
,
$file
) = tempfile(
DIR
=>
$tempd
);
eval
{ wcols
"arg %d %d"
,
$x
,
$y
,
$fileh
, {
FORMAT
=>
"option %d %d"
};};
is $@,
''
,
"wcols format_string override"
;
open
$fileh
,
"<"
,
$file
or
warn
"Can't open $file: $!"
;
readline
*$fileh
;
like
readline
(
$fileh
),
qr/^arg/
,
"wcols format_string obeyed"
;
unlink
(
$file
) or
warn
"Could not unlink $file: $!"
;
done_testing;