diff options
28 files changed, 712 insertions, 0 deletions
diff --git a/challenge-089/abigail/README b/challenge-089/abigail/README index 5f0d73ae16..129e4fe573 100644 --- a/challenge-089/abigail/README +++ b/challenge-089/abigail/README @@ -1 +1,26 @@ Solution by Abigail + +* Task 1 + * Perl + +* Task 2 + * AWK + * BASIC + * Bash + * bc + * Befunge-98 + * Brainfuck + * C + * Chef + * Cobol + * csh + * Forth + * Fortran + * MUMPS + * Node.js + * Ook! + * Pascal + * Perl + * Python + * Ruby + * SQL diff --git a/challenge-089/abigail/awk/ch-2.awk b/challenge-089/abigail/awk/ch-2.awk new file mode 100644 index 0000000000..f45f20e40e --- /dev/null +++ b/challenge-089/abigail/awk/ch-2.awk @@ -0,0 +1,6 @@ +#!/usr/bin/awk +END { + print "8 1 6"; + print "3 5 7"; + print "4 9 2"; +} diff --git a/challenge-089/abigail/bash/ch-2.sh b/challenge-089/abigail/bash/ch-2.sh new file mode 100644 index 0000000000..5a4b6f1877 --- /dev/null +++ b/challenge-089/abigail/bash/ch-2.sh @@ -0,0 +1,9 @@ +#!/bin/sh + +# +# For challenge and notes, see ../perl/ch-2.pl +# + +echo "8 1 6"; +echo "3 5 7"; +echo "4 9 2"; diff --git a/challenge-089/abigail/basic/ch-2.bas b/challenge-089/abigail/basic/ch-2.bas new file mode 100644 index 0000000000..c8292902de --- /dev/null +++ b/challenge-089/abigail/basic/ch-2.bas @@ -0,0 +1,3 @@ +10 PRINT "8 1 6" +20 PRINT "3 5 7" +30 PRINT "4 9 2" diff --git a/challenge-089/abigail/bc/ch-2.bc b/challenge-089/abigail/bc/ch-2.bc new file mode 100644 index 0000000000..e31cf76f70 --- /dev/null +++ b/challenge-089/abigail/bc/ch-2.bc @@ -0,0 +1,4 @@ +"8 1 6 +3 5 7 +4 9 2 +" diff --git a/challenge-089/abigail/befunge-93/ch-2.bf93 b/challenge-089/abigail/befunge-93/ch-2.bf93 new file mode 100644 index 0000000000..5a308181ff --- /dev/null +++ b/challenge-089/abigail/befunge-93/ch-2.bf93 @@ -0,0 +1,3 @@ +52* "2 9 4" 55+ "7 5 3" 64+ "6 1 8" v + > , v + ^ _@# : < diff --git a/challenge-089/abigail/brainfuck/ch-2.bf b/challenge-089/abigail/brainfuck/ch-2.bf new file mode 100644 index 0000000000..ad93bbbf7e --- /dev/null +++ b/challenge-089/abigail/brainfuck/ch-2.bf @@ -0,0 +1,12 @@ +++[>+++++<-]> # Cell 1 contains 10 ("\n") +>++++++++[>++++<-]> # Cell 3 contains 32 (' ') +>+++++++[>+++++++<-]> # Cell 5 contains 49 ('1') ++++++++ . << . >> # Print 8 +------- . << . >> # Print 1 ++++++ . <<<< . >>>> # Print 6 +--- . << . >> # Print 3 +++ . << . >> # Print 5 +++ . <<<< . >>>> # Print 7 +--- . << . >> # Print 4 ++++++ . << . >> # Print 9 +------- . <<<< . >>>> # Print 2 diff --git a/challenge-089/abigail/c/ch-2.c b/challenge-089/abigail/c/ch-2.c new file mode 100644 index 0000000000..a3fed75423 --- /dev/null +++ b/challenge-089/abigail/c/ch-2.c @@ -0,0 +1,13 @@ +# include <stdio.h> +# include <stdlib.h> + +/* + * See ../perl/ch-2.pl for challenge and notes + */ + +int main (void) { + printf ("8 1 6\n"); + printf ("3 5 7\n"); + printf ("4 9 2\n"); + return (0); +} diff --git a/challenge-089/abigail/chef/ch-2.chef b/challenge-089/abigail/chef/ch-2.chef new file mode 100644 index 0000000000..821f9946ef --- /dev/null +++ b/challenge-089/abigail/chef/ch-2.chef @@ -0,0 +1,32 @@ +Magic Square. + +Ingredients. +10 cups coconut flakes +8 kg duck +6 kg lamb +4 kg chicken +2 kg beef +1 cup honey +1 tablespoon pepper + +Method. +Liquefy coconut flakes. +Put coconut flakes into mixing bowl. +Put lamb into mixing bowl. +Put pepper into mixing bowl. +Put duck into mixing bowl. +Pour contents of the mixing bowl into 1st baking dish. +Clean mixing bowl. +Put coconut flakes into mixing bowl. +Put lamb into mixing bowl. Add honey. +Put chicken into mixing bowl. Add pepper. +Put beef into mixing bowl. Add honey. +Pour contents of the mixing bowl into 2nd baking dish. +Clean mixing bowl. +Put coconut flakes into mixing bowl. +Put beef into mixing bowl. +Put duck into mixing bowl. Add honey. +Put chicken into mixing bowl. +Pour contents of the mixing bowl into 3rd baking dish. + +Serves 3. diff --git a/challenge-089/abigail/cobol/ch-2.cb b/challenge-089/abigail/cobol/ch-2.cb new file mode 100644 index 0000000000..84f8e47584 --- /dev/null +++ b/challenge-089/abigail/cobol/ch-2.cb @@ -0,0 +1,12 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. MAGIC-SQUARE. + + * + * For challenge and notes, see ../perl/ch-2.pl + * + + PROCEDURE DIVISION. + DISPLAY '8 1 6'. + DISPLAY '3 5 7'. + DISPLAY '4 5 2'. + STOP RUN. diff --git a/challenge-089/abigail/csh/ch-2.csh b/challenge-089/abigail/csh/ch-2.csh new file mode 100755 index 0000000000..844a882725 --- /dev/null +++ b/challenge-089/abigail/csh/ch-2.csh @@ -0,0 +1,9 @@ +#!/bin/csh + +# +# For challenge and notes, see ../perl/ch-2.pl +# + +echo "8 1 6"; +echo "3 5 7"; +echo "4 9 2"; diff --git a/challenge-089/abigail/forth/ch-2.fs b/challenge-089/abigail/forth/ch-2.fs new file mode 100644 index 0000000000..4546c0154f --- /dev/null +++ b/challenge-089/abigail/forth/ch-2.fs @@ -0,0 +1,3 @@ +CR .( 8 1 6) +CR .( 3 5 7) +CR .( 4 9 2) diff --git a/challenge-089/abigail/fortran/ch-2.f90 b/challenge-089/abigail/fortran/ch-2.f90 new file mode 100644 index 0000000000..401b6e8f34 --- /dev/null +++ b/challenge-089/abigail/fortran/ch-2.f90 @@ -0,0 +1,10 @@ +! +! For the challenge and notes, see ../perl/ch-2.pl +! + +program magic + implicit none + print *, "8 1 6" + print *, "3 5 7" + print *, "4 9 2" +end diff --git a/challenge-089/abigail/mumps/ch-2.mps b/challenge-089/abigail/mumps/ch-2.mps new file mode 100644 index 0000000000..7b6d4ec20b --- /dev/null +++ b/challenge-089/abigail/mumps/ch-2.mps @@ -0,0 +1,5 @@ +magic() + w "8 1 6",! + w "3 5 7",! + w "4 9 2",! + q diff --git a/challenge-089/abigail/node/ch-2.js b/challenge-089/abigail/node/ch-2.js new file mode 100644 index 0000000000..ddc63f0b6e --- /dev/null +++ b/challenge-089/abigail/node/ch-2.js @@ -0,0 +1,7 @@ +// +// For challenge and notes, see ../perl/ch-2.pl +// + +process . stdout . write ("8 1 6\n" + + "3 5 7\n" + + "4 9 2\n"); diff --git a/challenge-089/abigail/ook/ch-2.ook b/challenge-089/abigail/ook/ch-2.ook new file mode 100644 index 0000000000..aefa8ec98f --- /dev/null +++ b/challenge-089/abigail/ook/ch-2.ook @@ -0,0 +1,23 @@ +Ook. Ook. Ook. Ook. Ook! Ook? Ook. Ook? Ook. Ook. Ook. Ook. Ook. Ook. +Ook. Ook. Ook. Ook. Ook? Ook. Ook! Ook! Ook? Ook! Ook. Ook? Ook. Ook? +Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. +Ook. Ook. Ook! Ook? Ook. Ook? Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. +Ook? Ook. Ook! Ook! Ook? Ook! Ook. Ook? Ook. Ook? Ook. Ook. Ook. Ook. +Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook! Ook? Ook. Ook? +Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. +Ook? Ook. Ook! Ook! Ook? Ook! Ook. Ook? Ook. Ook. Ook. Ook. Ook. Ook. +Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook! Ook. Ook? Ook. Ook? Ook. +Ook! Ook. Ook. Ook? Ook. Ook? Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! +Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook. Ook? Ook. Ook? Ook. Ook! Ook. +Ook. Ook? Ook. Ook? Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. +Ook! Ook. Ook? Ook. Ook? Ook. Ook? Ook. Ook? Ook. Ook! Ook. Ook. Ook? +Ook. Ook? Ook. Ook? Ook. Ook? Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook. +Ook? Ook. Ook? Ook. Ook! Ook. Ook. Ook? Ook. Ook? Ook. Ook. Ook. Ook. +Ook! Ook. Ook? Ook. Ook? Ook. Ook! Ook. Ook. Ook? Ook. Ook? Ook. Ook. +Ook. Ook. Ook! Ook. Ook? Ook. Ook? Ook. Ook? Ook. Ook? Ook. Ook! Ook. +Ook. Ook? Ook. Ook? Ook. Ook? Ook. Ook? Ook! Ook! Ook! Ook! Ook! Ook! +Ook! Ook. Ook? Ook. Ook? Ook. Ook! Ook. Ook. Ook? Ook. Ook? Ook. Ook. +Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook! Ook. Ook? Ook. Ook? Ook. +Ook! Ook. Ook. Ook? Ook. Ook? Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! +Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook. Ook? Ook. Ook? Ook. Ook? Ook. +Ook? Ook. Ook! Ook. Ook. Ook? Ook. Ook? Ook. Ook? diff --git a/challenge-089/abigail/pascal/ch-2.p b/challenge-089/abigail/pascal/ch-2.p new file mode 100644 index 0000000000..43390c415b --- /dev/null +++ b/challenge-089/abigail/pascal/ch-2.p @@ -0,0 +1,11 @@ +Program MagicSquare; + +(* *) +(* For challenge and notes, see ../perl/ch-2.pl *) +(* *) + +begin + writeln ('8 1 6'); + writeln ('3 5 7'); + writeln ('4 9 2'); +end. diff --git a/challenge-089/abigail/perl/ch-1.pl b/challenge-089/abigail/perl/ch-1.pl new file mode 100644 index 0000000000..4b1cf61229 --- /dev/null +++ b/challenge-089/abigail/perl/ch-1.pl @@ -0,0 +1,56 @@ +#!/opt/perl/bin/perl + +use 5.032; + +use strict; +use warnings; +no warnings 'syntax'; + +use experimental 'signatures'; +use experimental 'lexical_subs'; + +# +# Challenge: +# +# You are given a positive integer $N. +# +# Write a script to sum GCD of all possible unique pairs between 1 and $N. +# + +# +# Back in challenge 82, we needed a GCD subroutine as well. +# We copied that one, and added caching. +# + +sub stein; +sub stein ($u, $v) { + state $cache; + $$cache {$u, $v} //= sub ($u, $v) { + return $u if $u == $v || !$v; + return $v if !$u; + my $u_odd = $u % 2; + my $v_odd = $v % 2; + return stein ($u >> 1, $v >> 1) << 1 if !$u_odd && !$v_odd; + return stein ($u >> 1, $v) if !$u_odd && $v_odd; + return stein ($u, $v >> 1) if $u_odd && !$v_odd; + return stein ($u - $v, $v) if $u > $v; + return stein ($v - $u, $u); + } -> ($u, $v); +} + + +# +# Iterate over all pairs, sum the gcd. +# +while (my $N = <>) { + chomp $N; + my $sum = 0; + foreach my $i (1 .. $N) { + foreach my $j ($i + 1 .. $N) { + $sum += stein $i, $j; + } + } + say $sum; +} + +__END__ diff --git a/challenge-089/abigail/perl/ch-2.pl b/challenge-089/abigail/perl/ch-2.pl new file mode 100644 index 0000000000..f23979079e --- /dev/null +++ b/challenge-089/abigail/perl/ch-2.pl @@ -0,0 +1,74 @@ +#!/opt/perl/bin/perl + +use 5.032; + +use strict; +use warnings; +no warnings 'syntax'; + +use experimental 'signatures'; +use experimental 'lexical_subs'; + +# +# Challenge +# +# Write a script to display matrix as below with numbers 1 - 9. +# Please make sure numbers are used once. +# +# [ a b c ] +# [ d e f ] +# [ g h i ] +# +# So that it satisfies the following: +# +# a + b + c = 15 +# d + e + f = 15 +# g + h + i = 15 +# a + d + g = 15 +# b + e + h = 15 +# c + f + i = 15 +# a + e + i = 15 +# c + e + g = 15 +# + +# +# Well, this is utter trival, and there is absolute nothing to +# calculate. +# +# There is only one 3x3 matrix, 8 if you count rotations +# and reflections. +# +# For those who don't know the 3x3 magic square since childhood, +# and who don't look it up on the internet: +# +# - You need an odd number of odd numbers to sum to 15, so each +# row, column or diagonal contain 0 or 2 even numbers. +# - There are 5 odd numbers in the range 1-9, and 4 even numbers. +# - Hence, all the corners contain even numbers, the rest are odd. +# - This means, there are 2 triples with all odd numbers; together +# they contain all the odd numbers, and one odd number (the one +# in the center) is part of both. +# - The only all odd triplet containing a 9 which sums to 15 is +# (9, 5, 1). Which means the other triplet must contain a 7 and a 3, +# and to have that sum to 15, a 5 as well. Which means, 5 is in +# the center. +# - Now we can pick any even number (one of four) and place it in a corner. +# This fixes the number in the opposite corner. We then place the remaining +# two even numbers in the remaining corners (either possibility works). +# - There is now one way to place the remaining four odd numbers. +# +# This leads to the following solutions (all the others can be +# obtained by rotations and reflections): +# +# 8 1 6 +# 3 5 7 +# 4 9 2 +# + +print << '--'; +8 1 6 +3 5 7 +4 9 2 +-- + +__END__ diff --git a/challenge-089/abigail/python/ch-2.py b/challenge-089/abigail/python/ch-2.py new file mode 100755 index 0000000000..6e6ab53b2d --- /dev/null +++ b/challenge-089/abigail/python/ch-2.py @@ -0,0 +1,6 @@ +#!/opt/local/bin/python +# +# +print "8 1 6" +print "3 5 7" +print "4 9 2" diff --git a/challenge-089/abigail/ruby/ch-2.rb b/challenge-089/abigail/ruby/ch-2.rb new file mode 100644 index 0000000000..c4bc2d5bee --- /dev/null +++ b/challenge-089/abigail/ruby/ch-2.rb @@ -0,0 +1,9 @@ +#!/usr/bin/ruby + +# +# For challenge and notes, see ../perl/ch-2.pl +# + +puts "8 1 6"; +puts "3 5 7"; +puts "4 9 2"; diff --git a/challenge-089/abigail/sql/ch-2.sql b/challenge-089/abigail/sql/ch-2.sql new file mode 100644 index 0000000000..8b4cad84e6 --- /dev/null +++ b/challenge-089/abigail/sql/ch-2.sql @@ -0,0 +1,5 @@ +SELECT '8 1 6' +; +SELECT '3 5 7' +; +SELECT '4 9 2' diff --git a/challenge-089/abigail/t/input-1-1 b/challenge-089/abigail/t/input-1-1 new file mode 100644 index 0000000000..b94473479c --- /dev/null +++ b/challenge-089/abigail/t/input-1-1 @@ -0,0 +1,2 @@ +3 +4 diff --git a/challenge-089/abigail/t/input-1-2 b/challenge-089/abigail/t/input-1-2 new file mode 100644 index 0000000000..468f73eeff --- /dev/null +++ b/challenge-089/abigail/t/input-1-2 @@ -0,0 +1,4 @@ +100 +1000 +365 +512 diff --git a/challenge-089/abigail/t/output-1-1.exp b/challenge-089/abigail/t/output-1-1.exp new file mode 100644 index 0000000000..8bd0bca607 --- /dev/null +++ b/challenge-089/abigail/t/output-1-1.exp @@ -0,0 +1,3 @@ +# Given examples +3 +7 diff --git a/challenge-089/abigail/t/output-1-2.exp b/challenge-089/abigail/t/output-1-2.exp new file mode 100644 index 0000000000..1f7240c063 --- /dev/null +++ b/challenge-089/abigail/t/output-1-2.exp @@ -0,0 +1,5 @@ +# Some other examples +13015 +1974690 +222693 +464812 diff --git a/challenge-089/abigail/t/output-2-1.exp b/challenge-089/abigail/t/output-2-1.exp new file mode 100644 index 0000000000..ae726c3fc6 --- /dev/null +++ b/challenge-089/abigail/t/output-2-1.exp @@ -0,0 +1,5 @@ +#% Trim +# There can only be one. +8 1 6 +3 5 7 +4 9 2 diff --git a/challenge-089/abigail/test.pl b/challenge-089/abigail/test.pl new file mode 100755 index 0000000000..d9d74784f7 --- /dev/null +++ b/challenge-089/abigail/test.pl @@ -0,0 +1,356 @@ +#!/opt/perl/bin/perl + +# +# Test the solutions. Either call it with the directory name you +# want to test in, or call it as "../test.pl" from within the directory. +# + +use 5.032; + +use strict; +use warnings; +no warnings 'syntax'; + +chdir ".." if -f "../test.pl"; + +use experimental 'signatures'; + +use Test::More; +use DBI; + +use Getopt::Long; + +GetOptions 'slow' => \my $run_slow_tests, + 'lang|language=s' => \my @languages, +; + +my $HOME = $ENV {HOME}; + +my %languages = ( + Perl => { + exe => "/opt/perl/bin/perl", + ext => "pl", + }, + JavaScript => { + exe => "/usr/local/bin/node", + ext => "js", + dir => "node", + }, + bc => { + exe => "/usr/bin/bc", + ext => "bc", + filter => 's/.*/main($&)/', + }, + awk => { + exe => "/usr/bin/awk", + ext => "awk", + args => ["-f"], + }, + C => { + comp => "/usr/bin/cc", + ext => "c", + }, + SQL => { + ext => "sql", + }, + 'Befunge-93' => { + ext => "bf93", + exe => "$HOME/Bin/run-language", + }, + BASIC => { + ext => "bas", + exe => "$HOME/Bin/run-language", + }, + Bash => { + ext => "sh", + exe => "/bin/sh", + }, + Python => { + ext => "py", + exe => "/opt/local/bin/python", + }, + Ruby => { + ext => "rb", + exe => "/usr/bin/ruby", + }, + Csh => { + ext => "csh", + exe => "/bin/csh", + }, + Fortran => { + ext => "f90", + comp => "/opt/local/bin/gfortran-mp-4.4", + }, + 'Brainfuck' => { + ext => "bf", + exe => "$HOME/Bin/brainfuck", + }, + 'Ook!' => { + ext => "ook", + dir => "ook", + exe => "$HOME/Bin/ook", + }, + MUMPS => { + ext => "mps", + exe => "TIO", # Language::Mumps is really broken + }, + Forth => { + ext => "fs", + exe => "TIO", # Could no build gforth + }, + Chef => { + ext => "chef", + exe => "/opt/perl/bin/chef", + }, + Pascal => { + ext => "p", + exe => "TIO", + }, + Cobol => { + ext => "cb", + exe => "TIO", + }, +); + +my $perl_exe = $languages {Perl} {exe}; + +@languages = sort {lc $a cmp lc $b} keys %languages if !@languages; +my @challenges = @ARGV ? @ARGV : (1, 2); + +foreach my $challenge (@challenges) { + my ($dbh, $query, $tables_info); # Only for SQL tests. + + my @outputs = <t/output-$challenge-*> or next; + subtest "Challenge $challenge" => sub { + foreach my $language (@languages) { + my $info = $languages {$language}; + my $exe = $$info {exe}; + my $ext = $$info {ext}; + my $comp = $$info {comp}; + my $dir = $$info {dir} // lc $language; + my @args = @{$$info {args} // []}; + my $filter = $$info {filter} // ''; + my $ext_out = $$info {ext_out} // "out"; + my $source = "$dir/ch-$challenge.$ext"; + my $compiled; + next unless -r $source; + + subtest $language => sub { + SKIP: { + if ($exe && $exe eq "TIO") { + skip "No executable present, please use tio.net", 1; + } + + # + # Some languages first need to be compiled. + # + if ($comp) { + $compiled = $source =~ s/\.$ext$/.$ext_out/r; + system $comp, "-o", $compiled, $source; + } + + # + # SQL requires requires creating an in-memory database, + # and loading some tables. For that, we need a .tables + # file. We also read the actual query at this time. + # + if ($language eq "SQL") { + my $tables = $source =~ s/\.\Q$ext\E$/.table/r; + ($dbh, $query, $tables_info) = init_sql ($source, $tables); + } + + foreach my $output_exp (@outputs) { + SKIP: { + my $input = $output_exp =~ s/output/input/r + =~ s/\.exp$//r; + my $exp = `cat $output_exp`; + + my $name = $input; + + if (!-f $input) { + $name = "No input"; + $input = "/dev/null"; + } + + my %pragma; + my @options; + + while ($exp =~ s/^\s*#%\s*(.*)\n//) { + my $pragma = $1; + $pragma =~ s/\s+$//; + if ($pragma =~ /^\w+$/) { + $pragma {lc $pragma} = 1; + next; + } + if ($pragma =~ /^\s*(\w+):\s*(.*)/) { + my ($key, $value) = ($1, $2); + if (lc $key eq "opt") { + push @options => $value; + } + } + } + + if ($exp =~ s/^\s*#\s*(.*)\n//) { + $name = $1; + } + + skip "Skipping slow test", 1 + if $pragma {slow} && !$run_slow_tests; + + my $got; + if ($compiled) { + $got = `$perl_exe -ple '$filter' $input |\ + ./$compiled @options`; + } + elsif ($language eq "SQL") { + $got = test_sql ($dbh, $query, $tables_info, $input); + } + else { + $got = `$perl_exe -ple '$filter' $input |\ + $exe @args ./$source @options`; + } + + s/\h+$//gm for $exp, $got; + if ($pragma {trim}) { + s/^\h+//gm for $exp, $got; + } + is $got, $exp, $name; + }} + unlink $compiled if $compiled; + }} + } + } +} + +done_testing; + +# +# Parse the tables SQL, extract the table names, and the column names, +# *EXCLUDING* any primary key of the form "integer PRIMARY KEY" +# We're assuming some sane formatting (one column per line). +# +# Returns an array of arrays. Each (inner) array consists of a table +# name, followed by the name of the columns of that table. +# +# We will also create the database handle, use it to create the tables, +# and return the database handle as a second value. +# +sub init_sql ($query_file, $tables_file) { + my $query = `cat $query_file`; + my $tables = -f $tables_file ? `cat $tables_file` : ""; + + my $in_table = 0; + my @info; + foreach (split /\n/ => $tables) { + if (!$in_table) { + if (/^\s* CREATE \s+ TABLE \s+ (\w+)/xi) { + $in_table = 1; + push @info => [$1]; + } + next; + } + else { + if (/^\s* \)/x) { + $in_table = 0; + next; + } + # Any other line is a column definition + next if /^ \s* \w+ \s+ integer \s+ PRIMARY \s+ KEY \s*,/xi; + if (/^ \s* (\w+)/x) { + push @{$info [-1]} => $1; + } + } + } + # + # Does the query have place holders? + # + if ($query =~ /\?/) { + push @info => ["Placeholder"]; + } + + my $dbh = DBI:: -> connect ("dbi:SQLite:dbname=:memory:", "", "", + {RaiseError => 1, + PrintError => 1, + AutoCommit => 1}); + $dbh -> do ($tables) if $tables; + + return ($dbh, $query, \@info); +} + + +sub test_sql ($dbh, $query, $tables_info, $input) { + # + # For now, assume we each set of N lines, where N is the number of tables + # is a test. We also assume that if a line has P items (space separated), + # and the corresponing table has Q columns (not counting any integer primary + # keys, as SQLite fills them automatically), we have to fill int (P/Q) rows. + # + + # + # Read the input, if any + # + my @input; + if (-f $input) { + open my $i_fh, "<", $input or die "Failed to open $input: $!"; + @input = <$i_fh>; + } + + my $output = ""; + + TEST: + while (@input >= @$tables_info) { + my $real_query = $query; + foreach my $table_info (@$tables_info) { + my ($table, @fields) = @$table_info; + my $input = shift @input; + my @values = split ' ' => $input; + last TEST if @values < @fields && $table ne "Placeholder"; + + # + # Handle place holder queries + # + if ($table eq "Placeholder") { + $real_query =~ s/\?/shift @values/eg; + next; + } + + # + # Clear the table + # + $dbh -> do ("DELETE FROM $table"); + + # + # Construct an input query + # + my $place = "(" . join (", " => ("?") x @fields) . ")"; + my $insert = do {local $" = ", "; <<~ "--"}; + INSERT + INTO $table + (@fields) + VALUES @{[($place) x (@values / @fields)]} + -- + + $dbh -> do ($insert, undef, @values); + } + + + # + # Run the query. If we have multiple results, join columns + # by spaces, and rows by newlines. + # + foreach my $query (split /^\s*;\s*$/m => $real_query) { + my $result = $dbh -> selectall_arrayref ($query); + $output .= join "\n" => map {join " " => @$_} @$result; + $output .= "\n"; + } + + last unless @input; + } + + $output; +} + + + + +__END__ |