5 | # Published under the same terms as perl itself
6 | COPYRIGHT
7 |
8 | use strict;
9 | use utf8;
10 | use warnings;
11 | use warnings FATAL => 'uninitialized';
12 | use experimental 'signatures';
13 |
14 | use Getopt::Long;
15 | use Chj::xperlfunc qw(xslurp);
16 |
17 | my ($email_full) = $copyright =~ / by ([^\n]*)/s;
18 |
19 | my ($mydir, $myname);
20 |
21 | BEGIN {
22 | $0 =~ /(.*?)([^\/]+)\z/s or die "?";
23 | ($mydir, $myname) = ($1, $2);
24 | }
25 |
26 | my $pathpattern = "t/*.t";
27 |
28 | sub usage {
29 | print STDERR map {"$_\n"} @_ if @_;
30 | print "$myname [ files ]
31 |
32 | Check the files or $pathpattern for some issues, like not calling the right
33 | Perl.
34 |
35 | ($email_full)
36 | ";
37 | exit(@_ ? 1 : 0);
38 | }
39 |
40 | our $verbose = 0;
41 |
42 | #our $opt_dry;
43 | GetOptions(
44 | "verbose" => \$verbose,
45 | "help" => sub {usage},
46 |
47 | #"dry-run"=> \$opt_dry,
48 | ) or exit 1;
49 |
50 | my $issues = 0;
51 |
52 | sub issue ($path, $line, $msg) {
53 | $issues++;
54 | warn "$myname: $msg in $path line $line\n";
55 | }
56 |
57 | sub match_line { scalar split /\n/, substr $_[0], 0, pos($_[0]) }
58 |
59 | # use FP::Repl::Trap;
60 |
61 | sub tcheck ($path) {
62 | my $str = xslurp $path;
63 | while ($str =~ /xsystem\b/g) {
64 | issue $path, match_line($str),
65 | "uses x?xsystem instead of _safe variant";
66 | }
67 | while ($str =~ /system_safe\b/g) {
68 | my $rest = substr $str, pos($str);
69 | my $before = substr $str, 0, pos($str) - length("system_safe");
70 | my @lbefore = split /\n/, $before;
71 | my $l = $lbefore[-1];
72 | next if $l =~ /use Chj::xperlfunc/;
73 |
74 | $rest =~ s/\s+//;
75 | $rest =~ s/\(//;
76 | if (my ($cmd) = $rest =~ /^qw\(([^()]+)\)/s) {
77 | next if $cmd =~ /^(git|diff)/;
78 | }
79 | $rest =~ s/\s+//;
80 | next if $rest =~ /^\$\^X\b/;
81 | next if $rest =~ /^\@cmd/; # not Perl, right?
82 | issue $path, scalar @lbefore, 'must use $^X to call Perl scripts';
83 |
84 | # use FP::Repl; repl;
85 | }
86 | }
87 |
88 | if (@ARGV) {
89 | tcheck $_ for @ARGV;
90 | } else {
91 | tcheck $_ for glob $pathpattern;
92 | }
93 |
94 | exit($issues ? 1 : 0);
95 |
--------------------------------------------------------------------------------
/meta/tail-expand:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | # Expand some .pm files to avoid dependency on Sub::Call::Tail:
8 |
9 | # (XX could also include intro/more_tailcalls here and call this
10 | # instead from t/trampoline-fix, but so what)
11 |
12 | use strict;
13 | use warnings;
14 | use warnings FATAL => 'uninitialized';
15 |
16 | use lib "./lib";
17 | use Chj::xperlfunc qw(dirname xxsystem_safe xLmtime XLmtime xmkdir_p);
18 |
19 | my $windows = 1; #($^O =~ /win32/i);
20 |
21 | sub executable {
22 | my ($path) = @_;
23 | if ($windows) {
24 |
25 | # -x apparently doesn't work; thus:
26 | open my $in, "<", $path or die "open '$path': $!";
27 | my $line = <$in>;
28 | close $in;
29 | $line =~ /^#!/
30 | } else {
31 | -x $path
32 | }
33 | }
34 |
35 | open my $manif, "<", "MANIFEST" or die "$!";
36 |
37 | local $_;
38 | while (<$manif>) {
39 | chomp;
40 | next unless m{^htmlgen/}; # if m{^(?:lib|meta)/};
41 | next unless m|\.pm$| or executable $_;
42 | my $from = $_;
43 | my $to = "." . $from;
44 |
45 | my $t_from = xLmtime $from;
46 | my $expand = sub {
47 | xxsystem_safe($^X, "bin/expand-tail", $from, $to);
48 | };
49 | if (my $t_to = XLmtime $to) {
50 | if ($t_from >= $t_to) {
51 | &$expand;
52 | }
53 | } else {
54 | xmkdir_p dirname $to;
55 | &$expand;
56 | }
57 | }
58 |
59 | close $manif or die $!;
60 |
61 |
--------------------------------------------------------------------------------
/meta/test-modules:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | use strict;
4 | use warnings FATAL => 'uninitialized';
5 |
6 | use Cwd 'abs_path';
7 |
8 | my ($mydir, $myname);
9 |
10 | BEGIN {
11 | my $location = (-l $0) ? abs_path($0) : $0;
12 | $location =~ /(.*?)([^\/]+)\z/s or die "?";
13 | ($mydir, $myname) = ($1, $2);
14 | }
15 |
16 | use lib "$mydir/../lib";
17 |
18 | use Getopt::Long;
19 | use Chj::singlequote 'singlequote';
20 |
21 | sub usage {
22 | print STDERR map {"$_\n"} @_ if @_;
23 | print "$myname modulename...
24 |
25 | Loads the given modules, then runs the test suite on those. Exits
26 | with 0 for success, 1 for any kind of failure.
27 |
28 | Options:
29 | -x turns on tracing using -d:Trace
30 | -d ... or -d=... passed to Perl as -d:...
31 |
32 | ";
33 | exit(@_ ? 1 : 0);
34 | }
35 |
36 | our $verbose = 0;
37 | our $opt_x;
38 | our $opt_d;
39 | GetOptions(
40 | "verbose" => \$verbose,
41 | "help" => sub {usage},
42 | "x" => \$opt_x,
43 | "d=s" => \$opt_d
44 | ) or exit 1;
45 | usage unless @ARGV;
46 |
47 | $ENV{RUN_TESTS} ||= 1;
48 |
49 | my @cmd = (
50 | qw(perl -w -Mlib=lib -Mlib=htmlgen),
51 | ($opt_x ? "-d:Trace" : ()),
52 | (defined $opt_d ? "-d:$opt_d" : ()),
53 | (map {"-M$_"} @ARGV),
54 | "-MChj::TEST=:all",
55 | "-e",
56 | '$r= run_tests('
57 | . join(", ", map { singlequote $_ } @ARGV)
58 | . '); exit( $$r{failures} // $$r{fail})'
59 | );
60 |
61 | # Note: accessing field {fail} as a fall back above to cater for
62 | # older versions of Chj::TEST.
63 |
64 | system @cmd;
65 |
66 | exit($? == 0 ? 0 : 1);
67 |
--------------------------------------------------------------------------------
/meta/test.pl:
--------------------------------------------------------------------------------
1 |
2 | # general setup for testing.
3 |
4 | $ENV{TEST} = 1; # make sure that Chj::TEST TEST { } snippets are not
5 | # dropped because of an accidental setting of the TEST
6 | # env var by the user.
7 |
8 | 1
9 |
--------------------------------------------------------------------------------
/meta/update-pod:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2019-2020 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | # find modules from functional-perl working directory (not installed)
12 | use Cwd 'abs_path';
13 | our ($mydir, $myname);
14 |
15 | BEGIN {
16 | my $location = (-l $0) ? abs_path($0) : $0;
17 | $location =~ /(.*?)([^\/]+?)_?\z/s or die "?";
18 | ($mydir, $myname) = ($1, $2);
19 | }
20 | use lib "$mydir/../lib";
21 |
22 | sub usage {
23 | print STDERR map {"$_\n"} @_ if @_;
24 | print "$myname
25 |
26 | Update the autogenerated POD parts in some of the modules.
27 |
28 | ";
29 | exit(@_ ? 1 : 0);
30 | }
31 |
32 | use Getopt::Long;
33 | our $verbose = 0;
34 | GetOptions(
35 | "verbose" => \$verbose,
36 | "help" => sub {usage},
37 |
38 | #"dry-run" => \$opt_dry,
39 | ) or exit 1;
40 | usage if @ARGV;
41 |
42 | use FunctionalPerl ":all";
43 |
44 | my $newpart = FunctionalPerl::export_desc2pod;
45 |
46 | sub is_see_also {
47 | $_[0] =~ /^=head1 SEE ALSO/
48 | }
49 |
50 | sub is_head1 {
51 | $_[0] =~ /^=head1 /
52 | }
53 |
54 | my $file = "lib/FunctionalPerl.pm";
55 |
56 | xfile_replace_lines $file, sub {
57 | my ($lines) = @_;
58 | my ($top, $rest)
59 | = Keep($lines)->take_while_and_rest(complement \&is_see_also);
60 | $rest->ref(2) eq
61 | "This is the list of supported import tags and the modules and other tags that they import:\n"
62 | or die "no match";
63 | my ($top2, $rest2) = $rest->split_at(4);
64 | $top2->last eq "\n" or die "no match";
65 | my ($_drop, $remainder)
66 | = $rest2->take_while_and_rest(complement \&is_head1);
67 | my $res = stream_append($top, $top2, cons $newpart, $remainder);
68 |
69 | #repl;
70 | $res
71 | };
72 |
73 |
--------------------------------------------------------------------------------
/meta/with-profiling:
--------------------------------------------------------------------------------
1 | #!/bin/bash
2 |
3 | set -euo pipefail
4 | IFS=
5 |
6 | export PERL5OPT=-d:NYTProf
7 |
8 | exec "$@"
9 |
--------------------------------------------------------------------------------
/t-extra/evil-env.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use Cwd 'abs_path';
12 | our ($mydir, $myname);
13 |
14 | BEGIN {
15 | my $location = (-l $0) ? abs_path($0) : $0;
16 | $location =~ /(.*?)([^\/]+?)_?\z/s or die "?";
17 | ($mydir, $myname) = ($1, $2);
18 | }
19 |
20 | #use lib "$mydir/../lib";
21 |
22 | $ENV{TEST} = "0";
23 |
24 | exec "make", "test" or exit 127;
25 |
26 |
--------------------------------------------------------------------------------
/t-extra/out-of-order.t:
--------------------------------------------------------------------------------
1 | #!/bin/bash
2 |
3 | set -euo pipefail
4 | IFS=
5 |
6 | # check that tests work even when called in any order; XX for now just
7 | # deletes tail-expanded files, should actually freshly unpack the
8 | # distribution tarball?
9 |
10 | # uses scripts from chj-bin, really only meant to be run by the
11 | # maintainer; look at the output whether it contains FAILED or other
12 | # issues
13 | ele bash -c '
14 | for f in t/*.t; do
15 | rm -rf .htmlgen # XX and all other tail-expanded files
16 | echo "&&&& $f:"
17 | if $f; then
18 | echo OK
19 | else
20 | echo FAILED
21 | fi
22 | done
23 | '
24 |
25 |
--------------------------------------------------------------------------------
/t-slow/csvstreams.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2020 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use Test::Requires qw(5.020 Text::CSV);
12 | use Test::More;
13 |
14 | use lib "./lib";
15 | use Chj::xperlfunc ":all";
16 |
17 | require "./meta/find-perl.pl";
18 |
19 | require "./testmem.pl";
20 | setlimit_mem_MB($^V->{version}[1] < 15 ? 30 : 80)
21 | ; # 14 is enough on 32bit Debian, 64bit will need more
22 |
23 | SKIP: {
24 | if (0) {
25 | warn "todo: fix perl issue or functional-perl bug";
26 | skip "Perl issue or functional-perl bug?", 3; # XXX
27 | }
28 |
29 | is xsystem_safe($^X, qw"examples/gen-csv t/test-a.csv 40000"), 0;
30 |
31 | # 20000 pass on 32bit Debian even with bug
32 |
33 | is xsystem_safe(
34 | $^X, qw"examples/csv_to_xml_short t/test-a.csv t/test-a.xml"
35 | ),
36 | 0;
37 |
38 | is xsystem_safe($^X, qw"examples/csv_to_xml t/test-a.csv -o t/test-a.xml"),
39 | 0;
40 | }
41 |
42 | done_testing;
43 |
--------------------------------------------------------------------------------
/t/csv_to_xml.expected:
--------------------------------------------------------------------------------
1 |
2 | 0.123123443.3foobar
--------------------------------------------------------------------------------
/t/csv_to_xml.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | our $len = 210;
12 | require "./meta/readin.pl";
13 | require "./meta/find-perl.pl";
14 |
15 | use Test::Requires qw(Text::CSV);
16 | use Test::More;
17 |
18 | is readin("perl examples/csv_to_xml examples/csv_to_xml-example.csv|"),
19 | readin("< t/csv_to_xml.expected");
20 |
21 | done_testing;
22 |
--------------------------------------------------------------------------------
/t/dbi.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use lib "./lib";
12 | use Chj::xperlfunc ":all";
13 |
14 | require "./meta/find-perl.pl";
15 |
16 | $ENV{RUN_TESTS} = 1;
17 | xexec_safe $^X, "examples/dbi";
18 |
19 |
--------------------------------------------------------------------------------
/t/examples-csv-to-json.data/a.csv:
--------------------------------------------------------------------------------
1 | Omega,Puritas,Triangle,Amplitude
2 | 41.00,1,Humble Bumble,"Miami, Florida"
3 | 40.09,3,Pretense Pusher,"New York, New York"
4 |
--------------------------------------------------------------------------------
/t/examples-csv-to-json.data/a.json:
--------------------------------------------------------------------------------
1 | [
2 | {
3 | "Amplitude": "Miami, Florida",
4 | "Omega": "41.00",
5 | "Puritas": "1",
6 | "Triangle": "Humble Bumble"
7 | },
8 | {
9 | "Amplitude": "New York, New York",
10 | "Omega": "40.09",
11 | "Puritas": "3",
12 | "Triangle": "Pretense Pusher"
13 | }
14 | ]
15 |
--------------------------------------------------------------------------------
/t/examples-csv-to-json.data/a.mint:
--------------------------------------------------------------------------------
1 | [
2 | {
3 | amplitude = "Miami, Florida",
4 | omega = "41.00",
5 | puritas = "1",
6 | triangle = "Humble Bumble"
7 | },
8 | {
9 | amplitude = "New York, New York",
10 | omega = "40.09",
11 | puritas = "3",
12 | triangle = "Pretense Pusher"
13 | }
14 | ]
15 |
--------------------------------------------------------------------------------
/t/examples-csv-to-json.data/a_auto-integers.json:
--------------------------------------------------------------------------------
1 | [
2 | {
3 | "Amplitude": "Miami, Florida",
4 | "Omega": 41,
5 | "Puritas": 1,
6 | "Triangle": "Humble Bumble"
7 | },
8 | {
9 | "Amplitude": "New York, New York",
10 | "Omega": 40.09,
11 | "Puritas": 3,
12 | "Triangle": "Pretense Pusher"
13 | }
14 | ]
15 |
--------------------------------------------------------------------------------
/t/examples-csv-to-json.data/a_auto-numbers.json:
--------------------------------------------------------------------------------
1 | [
2 | {
3 | "Amplitude": "Miami, Florida",
4 | "Omega": 41.00,
5 | "Puritas": 1,
6 | "Triangle": "Humble Bumble"
7 | },
8 | {
9 | "Amplitude": "New York, New York",
10 | "Omega": 40.09,
11 | "Puritas": 3,
12 | "Triangle": "Pretense Pusher"
13 | }
14 | ]
15 |
--------------------------------------------------------------------------------
/t/examples-csv-to-json.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2021 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 | use Test::Requires { experimental => '"signatures"' }; # usually "5.020"
11 | use experimental 'signatures';
12 |
13 | use lib "./lib";
14 | use Test::Requires qw(JSON Text::CSV);
15 | use Test::More;
16 | use Chj::xperlfunc qw(xxsystem_safe xsystem_safe xslurp);
17 |
18 | # XX move to a lib?
19 |
20 | sub cmp ($a, $b) {
21 | xslurp($a) eq xslurp($b)
22 | }
23 |
24 | sub stripCR($str) {
25 | $str =~ s/\r//;
26 | }
27 |
28 | sub cmp_stripCR ($a, $b) {
29 | stripCR(xslurp($a)) eq stripCR(xslurp($b))
30 | }
31 |
32 | # /move
33 |
34 | sub t ($direct_mode, $result_file, @options) {
35 | local $ENV{GIT_PAGER} = ""; # disable git calling a pager
36 | my $inpath = "t/examples-csv-to-json.data/a.csv";
37 | my $result_path = "t/examples-csv-to-json.data/$result_file";
38 | my $outpath = $direct_mode ? $result_path : "$result_path-out";
39 | xxsystem_safe $^X, "examples/csv-to-json", $inpath, @options, $outpath;
40 | if ($direct_mode) {
41 | 0 == xsystem_safe(qw(git diff --exit-code), $result_path)
42 | } else {
43 |
44 | # 0 == xxsystem_safe(qw(diff --strip-trailing-cr -u), $result_path, $outpath);
45 | # ^ does not work on Windows, so:
46 | cmp_stripCR $result_path, $outpath
47 | }
48 | }
49 |
50 | sub tests_in_gitmode ($direct_mode) {
51 | ok t($direct_mode, "a.json");
52 | ok t($direct_mode, "a.mint", "--mint");
53 | ok t($direct_mode, "a_auto-integers.json", "--auto-integers");
54 | ok t($direct_mode, "a_auto-numbers.json", "--auto-numbers");
55 | }
56 |
57 | tests_in_gitmode(-e ".git");
58 |
59 | done_testing;
60 |
--------------------------------------------------------------------------------
/t/examples-fibs.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use lib "./lib";
12 | use Chj::xperlfunc ":all";
13 |
14 | require "./meta/find-perl.pl";
15 |
16 | $ENV{RUN_TESTS} = 1;
17 | xexec_safe $^X, "examples/fibs";
18 |
19 |
--------------------------------------------------------------------------------
/t/examples-functional-classes.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use lib "./lib";
12 | use Chj::xperlfunc ":all";
13 |
14 | require "./meta/find-perl.pl";
15 |
16 | $ENV{RUN_TESTS} = 1;
17 | xexec_safe $^X, "examples/functional-classes";
18 |
19 |
--------------------------------------------------------------------------------
/t/examples-hiring-without-whiteboards.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2020 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use lib "./lib";
12 | use Test::Requires qw(5.020 FP::Repl::Dependencies);
13 | use Chj::xperlfunc ":all";
14 |
15 | require "./meta/find-perl.pl";
16 |
17 | $ENV{RUN_TESTS} = 1;
18 | xexec_safe $^X, "examples/hiring-without-whiteboards";
19 |
20 |
--------------------------------------------------------------------------------
/t/examples-logic.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2020 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use Test::Requires qw(5.020);
12 |
13 | use lib "./lib";
14 | use Chj::xperlfunc ":all";
15 |
16 | require "./meta/find-perl.pl";
17 |
18 | $ENV{RUN_TESTS} = 1;
19 | xexec_safe $^X, "examples/logic";
20 |
--------------------------------------------------------------------------------
/t/examples-perlweekly-111-1.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2021 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 | use Test::Requires { experimental => '"signatures"' };
11 | use experimental 'signatures';
12 |
13 | use lib "./lib";
14 | use Test::Requires qw(FP::autobox v5.32.1 FP::SortedPureArray);
15 | use Test::More;
16 | use Chj::xperlfunc qw(xexec_safe);
17 |
18 | $ENV{RUN_TESTS} = 1;
19 | xexec_safe $^X, "examples/perl-weekly-challenges/111-1-search_matrix", "--test";
20 |
--------------------------------------------------------------------------------
/t/examples-perlweekly-113-1.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2021 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 | use Test::Requires { experimental => '"signatures"' };
11 | use experimental 'signatures';
12 |
13 | use lib "./lib";
14 |
15 | use Test::Requires { experimental => '"signatures"',
16 | feature => '"current_sub"' };
17 | use Test::More;
18 | use Chj::xperlfunc qw(xexec_safe);
19 |
20 | $ENV{RUN_TESTS} = 1;
21 | xexec_safe $^X, "examples/perl-weekly-challenges/113-1-represent_integer",
22 | "--test";
23 |
--------------------------------------------------------------------------------
/t/examples-perlweekly-113-2.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2021 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 | use Test::Requires { experimental => '"signatures"' };
11 | use experimental 'signatures';
12 |
13 | use lib "./lib";
14 |
15 | use Test::Requires { experimental => '"signatures"' };
16 | use Test::More;
17 | use Chj::xperlfunc qw(xexec_safe);
18 |
19 | $ENV{RUN_TESTS} = 1;
20 | xexec_safe $^X, "examples/perl-weekly-challenges/113-2-recreate_binary_tree",
21 | "--test";
22 |
--------------------------------------------------------------------------------
/t/examples-primes.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use lib "./lib";
12 | use Chj::xperlfunc ":all";
13 |
14 | require "./meta/find-perl.pl";
15 |
16 | $ENV{RUN_TESTS} = 1;
17 | xexec_safe $^X, "examples/primes";
18 |
--------------------------------------------------------------------------------
/t/examples-sendprepare:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2019-2020 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use Test::Requires qw(5.020);
12 |
13 | use lib "./lib";
14 | use Chj::xperlfunc ":all";
15 |
16 | require "./meta/find-perl.pl";
17 |
18 | $ENV{RUN_TESTS} = 1;
19 | xexec_safe $^X, "examples/sendprepare";
20 |
--------------------------------------------------------------------------------
/t/functional_XML-t-div.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use lib "./lib";
12 | use Chj::xperlfunc ":all";
13 |
14 | require "./meta/find-perl.pl";
15 |
16 | $ENV{RUN_TESTS} = 1;
17 | xexec_safe $^X, "functional_XML/t/div";
18 |
19 | # XX run functional_XML/t/stream as well? That one is slow, though.
20 |
--------------------------------------------------------------------------------
/t/functional_XML-test.expected:
--------------------------------------------------------------------------------
1 |
2 |
3 | example page - Hello WorldHello World
Garçon méchanique, "1 < 2" is true. this will be 404
By Christian Jaeger, last modified at Sun Apr 26 18:03:20 1970 (or something).
--------------------------------------------------------------------------------
/t/functional_XML-test.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use lib "./lib";
12 | use Chj::xperlfunc ":all";
13 | use Test::More;
14 |
15 | require "./meta/find-perl.pl";
16 |
17 | our $len = 672;
18 |
19 | xxsystem_safe($^X, "functional_XML/test", 10001000);
20 |
21 | is xslurp("out.xhtml"), xslurp("t/functional_XML-test.expected");
22 |
23 | done_testing;
24 |
--------------------------------------------------------------------------------
/t/htmlgen.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use Test::Requires '5.020';
12 |
13 | use Test::Requires + {
14 |
15 | #'Sub::Call::Tail' => 0,
16 | 'Text::Markdown' => 0,
17 | 'HTML::TreeBuilder' => 0,
18 | 'Perl::Tidy' => 0,
19 | };
20 |
21 | use lib "./lib";
22 | use Chj::xperlfunc ":all";
23 |
24 | require "./meta/find-perl.pl";
25 |
26 | $ENV{RUN_TESTS} = 1;
27 | xexec_safe $^X, "website/gen";
28 |
--------------------------------------------------------------------------------
/t/intro-basics.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use lib "./lib";
12 | use Chj::xperlfunc ":all";
13 |
14 | require "./meta/find-perl.pl";
15 |
16 | $ENV{RUN_TESTS} = 1;
17 | xexec_safe $^X, "intro/basics";
18 |
--------------------------------------------------------------------------------
/t/maintainer/perhaps:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | use strict;
4 | use warnings;
5 | use warnings FATAL => 'uninitialized';
6 |
7 | # "What happens here?: "
8 |
9 | use Test::More;
10 |
11 | {
12 | my ($a, $b) = (0, undef) or die "no";
13 |
14 | is_deeply [$a, $b], [0, undef], "t1";
15 | }
16 |
17 | like(
18 | (
19 | eval {
20 | my ($a, $b) = do {
21 | (0, undef) or die "no"
22 | };
23 | 1
24 | }
25 | || $@
26 | ),
27 | qr/^no at /,
28 | "t2"
29 | );
30 |
31 | {
32 | is_deeply [my ($a, $b) = (0, undef)], [0, undef], "t3";
33 | }
34 |
35 | {
36 | is_deeply [
37 | do { my ($a, $b) = (0, undef) }
38 | ],
39 | [0, undef], "t3b";
40 | }
41 |
42 | {
43 | is_deeply [
44 | scalar do { my ($a, $b) = (0, undef) }
45 | ],
46 | [2], "t3c";
47 | }
48 |
49 | {
50 | is_deeply [
51 | scalar do { my ($a, $b) = () }
52 | ],
53 | [0], "t3d";
54 | }
55 |
56 | {
57 | is_deeply [my ($a, $b) = (0, undef) or die "no"], [2], "t4";
58 | }
59 |
60 | done_testing;
61 |
62 |
--------------------------------------------------------------------------------
/t/perl-goto-leak.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | require "./meta/readin.pl";
12 |
13 | use Test::More;
14 |
15 | require "./meta/find-perl.pl";
16 |
17 | require "./testmem.pl";
18 | setlimit_mem_MB(30);
19 |
20 | SKIP: {
21 | skip "Perl issue", 1 unless $ENV{TEST_PERL};
22 |
23 | is readin("perl t/perl/goto-leak 100000 1 |"), "5000050000\n";
24 | }
25 |
26 | done_testing;
27 |
--------------------------------------------------------------------------------
/t/perl-weaken-coderef-correctness.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use lib "./lib";
12 | use Chj::xperlfunc ":all";
13 |
14 | require "./meta/find-perl.pl";
15 |
16 | # test t/perl-weaken-coderef without memory pressure, to check code
17 | # correctness aside memory behaviour
18 |
19 | $ENV{TEST_PERL} = 1;
20 | $ENV{N} = 800;
21 | $ENV{RES} = 320400;
22 | xexec_safe $^X, "t/perl-weaken-coderef.t";
23 |
--------------------------------------------------------------------------------
/t/perl-weaken-coderef.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | require "./meta/readin.pl";
12 |
13 | require "./meta/find-perl.pl";
14 |
15 | use Test::More;
16 |
17 | require "./testmem.pl";
18 | setlimit_mem_MB($^V->{version}[1] < 15 ? 30 : 80);
19 |
20 | is readin("perl t/perl/weaken-coderef 2 50000 |"), "3\n";
21 |
22 | my $n = $ENV{N} // 80000;
23 | my $res = ($ENV{RES} // 3200040000) . "\n";
24 |
25 | is readin("perl t/perl/weaken-coderef $n 1 |"), $res;
26 |
27 | SKIP: {
28 | skip "Perl issue", 3 unless $ENV{TEST_PERL};
29 |
30 | # XXX is this really a perl issue?
31 |
32 | is readin("perl t/perl/weaken-coderef-alternative-fix Y $n 1 |"), $res;
33 |
34 | is readin("perl t/perl/weaken-coderef-alternative-fix rec $n 1 |"), $res;
35 |
36 | is readin(
37 | "perl t/perl/weaken-coderef-alternative-fix haskell_uncurried $n 1 |"),
38 | $res;
39 |
40 | is readin("perl t/perl/weaken-coderef-alternative-fix '' $n 1 |"), $res;
41 |
42 | }
43 |
44 | done_testing;
45 |
--------------------------------------------------------------------------------
/t/perl/__SUB__-gc:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | my $copyright = <<'COPYRIGHT';
4 | # Copyright 2021 by Christian Jaeger
5 | # Published under the same terms as perl itself
6 | COPYRIGHT
7 |
8 | use strict;
9 | use utf8;
10 | use warnings;
11 | use warnings FATAL => 'uninitialized';
12 | use experimental 'signatures';
13 | use feature 'current_sub'; # __SUB__
14 |
15 | my ($mydir, $myname);
16 |
17 | BEGIN {
18 | $0 =~ /(.*?)([^\/]+)\z/s or die "?";
19 | ($mydir, $myname) = ($1, $2);
20 | }
21 |
22 | # Just some random stupid curried and partially self-recursive
23 | # function:
24 | sub foo($x) {
25 |
26 | sub ($y) {
27 |
28 | # warn "f called";
29 | my $f = __SUB__;
30 |
31 | sub ($z) {
32 | $z < 1000 ? $f->($x * $y)->($z + $y) : $z
33 | }
34 | }
35 | }
36 |
37 | # Now show that this doesn't leak:
38 | sub t ($n) {
39 | my $res;
40 | for (1 .. $n) {
41 | $res = foo(50)->(30)->(30);
42 | }
43 | $res
44 | }
45 |
46 | warn
47 | "Please verify manually from outside (e.g. `top`) that this process, pid $$, doesn't increase memory usage over time";
48 |
49 | my $res = t 10000000;
50 |
51 | # use FP::Repl; repl;
52 |
--------------------------------------------------------------------------------
/t/perl/weaken-coderef:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2020 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use Test::Requires qw(BSD::Resource);
12 | import BSD::Resource;
13 | use Scalar::Util "weaken";
14 | use FP::Carp;
15 |
16 | sub rss {
17 | @_ == 0 or fp_croak_arity 0;
18 | (BSD::Resource::getrusage(BSD::Resource::RUSAGE_SELF()))[2]
19 | }
20 |
21 | sub naturals {
22 | my $f;
23 | $f = sub {
24 | my ($n) = @_;
25 | my $f = $f;
26 | sub {
27 | if ($n > 0) { [$n, &$f($n - 1)] }
28 | else {
29 | undef
30 | }
31 | }
32 | };
33 | my $f_ = $f;
34 | weaken $f;
35 | goto &$f_;
36 | }
37 |
38 | sub stream_sum {
39 | my ($s) = @_;
40 |
41 | #weaken $_[0];
42 | # ^ not necessary here, since, unlike with FP::Lazy::Promise,
43 | # resulting value is not saved in its 'generating container'
44 | my $tot = 0;
45 | LP: {
46 | if (my $fs = &$s) {
47 | ($tot, $s) = ($$fs[0] + $tot, $$fs[1]);
48 | goto LP;
49 | } else {
50 | $tot
51 | }
52 | }
53 | }
54 |
55 | @ARGV == 2 or die "usage: $0 n N";
56 | my ($n, $N) = @ARGV;
57 |
58 | my $start = rss;
59 |
60 | my $res;
61 | for (1 .. $N) {
62 | my $ns = naturals $n;
63 | $res = stream_sum $ns;
64 | }
65 |
66 | print $res, "\n";
67 |
68 | my $end = rss;
69 |
70 | if (($end - $start) / $start > 1.5) {
71 | die "leaked: $start .. $end";
72 | }
73 |
74 |
--------------------------------------------------------------------------------
/t/perl/weaken-coderef-alternative:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use Scalar::Util "weaken";
12 |
13 | sub foo {
14 | my $f = sub {
15 | my ($f, $n) = @_;
16 | sub {
17 | if ($n > 0) {
18 | $n + &{ &$f($f, $n - 1) }
19 | } else {
20 | 0
21 | }
22 | }
23 | };
24 | &$f($f, @_);
25 | }
26 |
27 | my $res = &{ foo 2 };
28 |
29 | print $res, "\n";
30 |
31 |
--------------------------------------------------------------------------------
/t/perl/weaken-coderef-alternative-FP:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | # find modules from functional-perl working directory (not installed)
12 | use Cwd 'abs_path';
13 | our ($mydir, $myname);
14 |
15 | BEGIN {
16 | my $location = (-l $0) ? abs_path($0) : $0;
17 | $location =~ /(.*?)([^\/]+?)_?\z/s or die "?";
18 | ($mydir, $myname) = ($1, $2);
19 | }
20 | use lib "$mydir/../../lib";
21 |
22 | use Scalar::Util 'weaken';
23 |
24 | @ARGV == 3 or die "usage: $0 impl n m";
25 | our ($impl, $n, $m) = @ARGV;
26 |
27 | use FP::List ":all";
28 | use FP::Lazy ":all";
29 |
30 | sub naturals {
31 | my $f;
32 | $f = sub {
33 | my ($n) = @_;
34 | my $f = $f;
35 | lazy {
36 | if ($n > 0) {
37 | cons $n, &$f($n - 1)
38 | } else {
39 | null
40 | }
41 | }
42 | };
43 | my $f_ = $f;
44 | weaken $f;
45 | goto &$f_;
46 | }
47 |
48 | sub stream_sum {
49 | my ($s) = @_;
50 | weaken $_[0];
51 |
52 | # ^ not necessary here, since, unlike with FP::Lazy::Promise,
53 | # resulting value is not saved in its 'generating container'
54 | my $lp;
55 | $lp = sub {
56 | my ($tot, $s) = @_;
57 | weaken $_[1];
58 | FORCE $s;
59 | if (is_null $s) {
60 | $tot
61 | } else {
62 | @_ = (car($s) + $tot, cdr $s);
63 | goto &$lp;
64 | }
65 | };
66 | @_ = (0, $s);
67 | my $lp_ = $lp;
68 | weaken $lp;
69 | goto &$lp_;
70 | }
71 |
72 | my $res;
73 | for (1 .. $m) {
74 | my $ns = naturals $n;
75 | $res = stream_sum $ns;
76 | }
77 |
78 | print $res, "\n";
79 |
80 |
--------------------------------------------------------------------------------
/t/perl/weaken-coderef-alternative-__SUB__:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | # "This token is only available under use v5.16 or the "current_sub" feature"
12 | use v5.16;
13 |
14 | sub foo {
15 | my $f = sub {
16 | my ($n) = @_;
17 | my $f = __SUB__;
18 | sub {
19 | if ($n > 0) {
20 | $n + &{ &$f($n - 1) }
21 | } else {
22 | 0
23 | }
24 | }
25 | };
26 | goto &$f
27 | }
28 |
29 | my $res = &{ foo 2 };
30 |
31 | print $res, "\n";
32 |
33 |
--------------------------------------------------------------------------------
/t/perl/weaken-coderef-alternative-fix:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | # find modules from functional-perl working directory (not installed)
12 | use Cwd 'abs_path';
13 | our ($mydir, $myname);
14 |
15 | BEGIN {
16 | my $location = (-l $0) ? abs_path($0) : $0;
17 | $location =~ /(.*?)([^\/]+?)_?\z/s or die "?";
18 | ($mydir, $myname) = ($1, $2);
19 | }
20 | use lib "$mydir/../../lib";
21 |
22 | use Scalar::Util 'weaken';
23 |
24 | @ARGV == 3 or die "usage: $0 impl n m";
25 | our ($impl, $n, $m) = @ARGV;
26 |
27 | use FP::fix;
28 |
29 | if ($impl) {
30 | $impl =~ /^\w+\z/ or die "invalid arg";
31 | undef *fix;
32 | *fix = eval '\&FP::fix::' . $impl;
33 | }
34 |
35 | sub naturals {
36 | my $f = fix sub {
37 | my ($f, $n) = @_;
38 | sub {
39 | if ($n > 0) { [$n, &$f($n - 1)] }
40 | else {
41 | undef
42 | }
43 | }
44 | };
45 | goto &$f;
46 | }
47 |
48 | sub stream_sum {
49 | my ($s) = @_;
50 | weaken $_[0];
51 |
52 | # ^ not necessary here, since, unlike with FP::Lazy::Promise,
53 | # resulting value is not saved in its 'generating container'
54 | my $lp = fix sub {
55 | my ($lp, $tot, $s) = @_;
56 | weaken $_[2];
57 | if (my $fs = &$s) {
58 | @_ = ($$fs[0] + $tot, $$fs[1]);
59 | goto &$lp;
60 | } else {
61 | $tot
62 | }
63 | };
64 | @_ = (0, $s);
65 | my $lp_ = $lp;
66 | weaken $lp;
67 | goto &$lp_;
68 | }
69 |
70 | my $res;
71 | for (1 .. $m) {
72 | my $ns = naturals $n;
73 | $res = stream_sum $ns;
74 | }
75 |
76 | print $res, "\n";
77 |
78 |
--------------------------------------------------------------------------------
/t/perl/weaken-coderef-alternative-local:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | sub foo {
12 | local *f = sub {
13 | my ($n) = @_;
14 |
15 | #f($n); # works, endless recursion.
16 | #my $f = \&f; # does not work on either v5.14.2 or bleadperl
17 | my $f = *f{CODE}; # neither does this (both give undef)
18 | sub {
19 | if ($n > 0) {
20 | $n + &{ &$f($n - 1) }
21 | } else {
22 | 0
23 | }
24 | }
25 | };
26 | f(@_);
27 | }
28 |
29 | my $res = &{ foo 2 };
30 |
31 | print $res, "\n";
32 |
33 |
--------------------------------------------------------------------------------
/t/perl/weaken-coderef-simplified:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use Scalar::Util "weaken";
12 |
13 | sub foo {
14 | my $f;
15 | $f = sub {
16 | my ($n) = @_;
17 | my $f = $f; # create a new, strong binding for f to prevent it
18 | # from being freed (upon return from f)
19 | sub {
20 | if ($n > 0) {
21 | $n + &{ &$f($n - 1) }
22 | } else {
23 | 0
24 | }
25 | }
26 | };
27 | my $f_ = $f;
28 | weaken $f;
29 | &$f_;
30 | }
31 |
32 | my $res = &{ foo 2 };
33 |
34 | print $res, "\n";
35 |
36 |
--------------------------------------------------------------------------------
/t/predicates.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use lib "./lib";
12 | use Chj::xperlfunc ":all";
13 | require "./meta/find-perl.pl";
14 |
15 | $ENV{RUN_TESTS} = 1;
16 | xexec_safe $^X, "examples/predicates";
17 |
--------------------------------------------------------------------------------
/t/require_and_run_tests.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | # find modules from functional-perl working directory (not installed)
12 | use Cwd 'abs_path';
13 | our ($mydir, $myname);
14 |
15 | BEGIN {
16 | my $location = (-l $0) ? abs_path($0) : $0;
17 | $location =~ /(.*?)([^\/]+?)_?\z/s or die "?";
18 | ($mydir, $myname) = ($1, $2);
19 | }
20 |
21 | BEGIN {
22 | # switch Chj::TEST to TAP style testing (unless requested 'old'), and
23 | # disable FP::Repl::Trap / FP::Repl::AutoTrap (unless requested
24 | # otherwise by another setting than "1"):
25 | $ENV{RUN_TESTS} ||= 1;
26 | }
27 |
28 | use Test::More;
29 | use lib "./meta";
30 | use FunctionalPerl::TailExpand;
31 | use FunctionalPerl::ModuleList;
32 | use FunctionalPerl::Dependencies 'module_needs';
33 | use Chj::Backtrace;
34 |
35 | require "./meta/find-perl.pl";
36 |
37 | plan tests => 2;
38 |
39 | subtest "require" => sub {
40 | my $modules = do {
41 | if (my $mnl = $ENV{MODULENAMELIST}) { [split /\s+|,/, $mnl] }
42 | else {
43 | modulenamelist
44 | }
45 | };
46 |
47 | for my $module (@$modules) {
48 | SKIP: {
49 | if (my @needs = module_needs $module) {
50 | skip "require $module - can't use @needs", 1;
51 | }
52 | require_ok $module;
53 | }
54 | }
55 | };
56 |
57 | subtest "run_tests" => sub {
58 |
59 | # already loaded by require_ok above:
60 | Chj::TEST::run_tests();
61 | };
62 |
63 | #use Chj::ruse;
64 | #use Chj::Backtrace;
65 | #use FP::Repl;
66 | #repl;
67 |
--------------------------------------------------------------------------------
/t/skip-internal.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use lib "./lib";
12 | use Chj::xperlfunc ":all";
13 | require "./meta/find-perl.pl";
14 |
15 | $ENV{RUN_TESTS} = 1;
16 | xexec_safe $^X, "examples/skip";
17 |
--------------------------------------------------------------------------------
/t/skip-leak.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | require "./meta/readin.pl";
12 | require "./meta/find-perl.pl";
13 | use Test::More;
14 |
15 | require "./testmem.pl";
16 | setlimit_mem_MB(50);
17 |
18 | use lib "./lib";
19 | use Chj::chompspace;
20 |
21 | is chompspace(
22 | readin(
23 | "( dd bs=10000 count=20000 2>/dev/null < /dev/zero || head -c 200000000 /dev/zero) | perl examples/skip --leaktest 10000000 1 | wc -c |"
24 | )
25 | ),
26 | "189999999";
27 |
28 | done_testing;
29 |
--------------------------------------------------------------------------------
/t/skip.input:
--------------------------------------------------------------------------------
1 | Hello World.
--------------------------------------------------------------------------------
/t/skip.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | require "./meta/readin.pl";
12 | require "./meta/find-perl.pl";
13 | use Test::More;
14 |
15 | # test non-seekable input
16 | is readin("echo hallo | perl examples/skip 1 2 |"), "all";
17 |
18 | sub t {
19 | my ($bufsiz) = @_;
20 | is readin("perl examples/skip --bufsiz $bufsiz 1 0 < t/skip.input|"),
21 | "ello World.";
22 | is readin("perl examples/skip --bufsiz $bufsiz 0 1 < t/skip.input|"),
23 | "Hello World";
24 | is readin("perl examples/skip --bufsiz $bufsiz 4 5 < t/skip.input|"),
25 | "o W";
26 | is readin("perl examples/skip --bufsiz $bufsiz 10 1 < t/skip.input|"), "d";
27 | is readin("perl examples/skip --bufsiz $bufsiz 11 1 < t/skip.input|"), "";
28 | is readin("perl examples/skip --bufsiz $bufsiz 11 2 < t/skip.input 2>&1 |",
29 | sub { $_[0] }),
30 | "skip: only 1 byte(s) left after skipping 11 byte(s)\n";
31 | is readin("perl examples/skip --bufsiz $bufsiz 12 1 < t/skip.input 2>&1 |",
32 | sub { $_[0] }),
33 | "skip: no remainder left after skipping 12 byte(s)\n";
34 | }
35 |
36 | t 1024;
37 | t 1;
38 | t 3;
39 |
40 | done_testing;
41 |
--------------------------------------------------------------------------------
/t/testlazy.expected:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pflanze/functional-perl/f2fcc20eabea03a2fffb4af57d33110bd4f2a359/t/testlazy.expected
--------------------------------------------------------------------------------
/t/testlazy.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | our $len = 1000;
12 | require "./meta/readin.pl";
13 | require "./meta/find-perl.pl";
14 | use Test::More;
15 |
16 | use POSIX 'SIGPIPE';
17 | our $sigpipe_is_fine = sub {
18 | my ($buf, $default_on_error) = @_;
19 | $? == SIGPIPE ? $buf : &$default_on_error();
20 | };
21 |
22 | is readin("perl functional_XML/testlazy |", $sigpipe_is_fine),
23 | readin("< t/testlazy.expected");
24 |
25 | done_testing;
26 |
--------------------------------------------------------------------------------
/t/testlazy10.expected:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pflanze/functional-perl/f2fcc20eabea03a2fffb4af57d33110bd4f2a359/t/testlazy10.expected
--------------------------------------------------------------------------------
/t/testlazy10.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | our $len = 759;
12 | require "./meta/readin.pl";
13 | require "./meta/find-perl.pl";
14 | use Test::More;
15 |
16 | $ENV{N} = 10;
17 | $ENV{T} = 0;
18 | $ENV{TZ} = "MET";
19 | is readin("LANG=C TZ=UTC perl functional_XML/testlazy |"),
20 | readin("< t/testlazy10.expected");
21 |
22 | done_testing;
23 |
--------------------------------------------------------------------------------
/t/trampoline-fix.t:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use lib "./lib";
12 | use Chj::xperlfunc ":all";
13 | require "./meta/find-perl.pl"; # I'm still doing this just to be sure..
14 | require "./testmem.pl";
15 |
16 | # bleadperl on 64bit system needs enormeously more memory than v5.14.2
17 | # on 32bit. FIXME for the right combinations (or/and increase
18 | # iteration count to trigger it even with too high limits)
19 | my $m = ($^V->{version}[1] < 15 ? 30 : 100);
20 | warn "m=$m" if $ENV{RUN_TESTS_VERBOSE};
21 | setlimit_mem_MB($m);
22 |
23 | use Test::Requires qw(Method::Signatures);
24 |
25 | # Also need Sub::Call::Tail:
26 |
27 | if (eval { require Sub::Call::Tail; 1 }) {
28 |
29 | $ENV{RUN_TESTS} = 1;
30 | xexec_safe $^X, "intro/more_tailcalls";
31 |
32 | } else {
33 |
34 | # hack to run it without Sub::Call::Tail, e.g. on bleadperl where
35 | # this can't be installed currently.
36 | xxsystem_safe($^X, "bin/expand-tail", "intro/more_tailcalls",
37 | "intro/.expansion-more_tailcalls");
38 |
39 | $ENV{RUN_TESTS} = 1;
40 | xexec_safe $^X, "intro/.expansion-more_tailcalls";
41 | }
42 |
--------------------------------------------------------------------------------
/testmem.pl:
--------------------------------------------------------------------------------
1 | use Test::Requires qw(BSD::Resource);
2 | use FP::Carp;
3 | import BSD::Resource;
4 |
5 | sub MB {
6 | @_ == 1 or fp_croak_arity 1;
7 | $_[0] * 1048576
8 | }
9 |
10 | my $RLIMIT_KIND =
11 |
12 | # At least OpenBSD does not have RLIMIT_VMEM; RLIMIT_DATA is the
13 | # memory limit it supports. Linux does, too, so just use that one
14 | RLIMIT_DATA;
15 |
16 | sub setlimit_mem_MB {
17 | @_ == 1 or fp_croak_arity 1;
18 | my ($limit_MB) = @_;
19 | my $limit = MB $limit_MB;
20 | setrlimit $RLIMIT_KIND, $limit, $limit or die "setrlimit: $!";
21 | }
22 |
23 | 1
24 |
--------------------------------------------------------------------------------
/website/FP-logo.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/pflanze/functional-perl/f2fcc20eabea03a2fffb4af57d33110bd4f2a359/website/FP-logo.png
--------------------------------------------------------------------------------
/website/FP.css:
--------------------------------------------------------------------------------
1 | .logo2 {
2 | font-weight: bold;
3 | font-size:24px;
4 | }
5 | .footer_legalese {
6 | text-align: center;
7 | font-size: small;
8 | }
9 | .editandhist {
10 | text-align: right;
11 | font-size: small;
12 | margin-bottom: -1em;
13 | }
--------------------------------------------------------------------------------
/website/gen:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env perl
2 |
3 | # Copyright (c) 2015-2019 Christian Jaeger, copying@christianjaeger.ch
4 | # This is free software. See the file COPYING.md that came bundled
5 | # with this file.
6 |
7 | use strict;
8 | use warnings;
9 | use warnings FATAL => 'uninitialized';
10 |
11 | use Cwd 'abs_path';
12 | our ($mydir, $myname);
13 |
14 | BEGIN {
15 | my $location = (-l $0) ? abs_path($0) : $0;
16 | $location =~ /(.*?)([^\/]+?)_?\z/s or die "?";
17 | ($mydir, $myname) = ($1, $2);
18 | }
19 |
20 | unless ($ENV{SUB_CALL_TAIL}) {
21 | use lib "./meta";
22 | require FunctionalPerl::TailExpand;
23 | }
24 |
25 | chdir $mydir or die "chdir $mydir: $!";
26 |
27 | my $inbase = "..";
28 | my $outbase = "www";
29 | my $configpath = "./gen-config.pl";
30 |
31 | # make it work by default without Sub::Call::Tail:
32 | my $prefix = $ENV{SUB_CALL_TAIL} ? "" : ".";
33 |
34 | my $gen = "../${prefix}htmlgen/gen";
35 |
36 | exec $^X, $gen, $configpath, $inbase, $outbase, @ARGV
37 | or die
38 | "possibly missing '$gen', run 'meta/tail-expand' (or simply 'make test') first";
39 |
--------------------------------------------------------------------------------
/website/logo.pl:
--------------------------------------------------------------------------------
1 | use strict;
2 | use warnings;
3 | use warnings FATAL => 'uninitialized';
4 | use PXML::XHTML ":all";
5 |
6 | my $homeurl = "http://functional-perl.org";
7 | my $logo_from_base = "FP-logo.png";
8 |
9 | sub {
10 | my ($path0) = @_;
11 | +{
12 | homeurl => $homeurl,
13 | logo => DIV(
14 | { class => "header" },
15 | A(
16 | { href => "$homeurl", class => "header" },
17 | SPAN({ class => "logo2" }, "Functional "),
18 | IMG(
19 | {
20 | src => path_diff($path0, $logo_from_base),
21 | alt => "Logo",
22 | border => 0
23 | }
24 | ),
25 | SPAN({ class => "logo2" }, " Perl")
26 | ),
27 | SPAN(
28 | { class => "logo2" },
29 | " $nbsp $nbsp $nbsp $nbsp $nbsp $nbsp $nbsp $nbsp $nbsp"
30 | )
31 | ),
32 | }
33 | }
34 |
--------------------------------------------------------------------------------
/website/sync:
--------------------------------------------------------------------------------
1 | #!/bin/bash
2 | set -euo pipefail
3 | # enable job control consistently, not just when there is a tty:
4 | set -m
5 | IFS=
6 |
7 | mydir=$(dirname "$0")
8 |
9 | set -x
10 |
11 | rsync -auvz --delete --exclude .git --exclude lpw-talk --exclude london.pm-talk "$mydir"/www/. servi:www/functional-perl.org/.
12 |
13 |
--------------------------------------------------------------------------------