From ec9e2ec1c9361b3068546237d9952a47896e2b26 Mon Sep 17 00:00:00 2001 From: Whiteknight Date: Fri, 19 Mar 2010 08:52:41 -0400 Subject: [PATCH 1/8] Update README to include new information about dependencies. --- README | 118 ++++++++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 105 insertions(+), 13 deletions(-) diff --git a/README b/README index 6909499..771acfc 100644 --- a/README +++ b/README @@ -23,39 +23,131 @@ Parrot: http://www.parrot.org PLA is being actively developed. It has core PMC types that build, a build and installation system, and a growing test suite. +PLA currently provides these PMC types: + +=over 4 + +=item NumMatrix2D + +A 2-D matrix containing floating point values. + +=item PMCMatrix2D + +A 2-D matrix containing PMC pointers + +=item ComplexMatrix2D + +A 2-D matrix containing Complex values, optimized to store complex values +directly instead of using an array of Parrot's Complex PMC type. + +=item CharMatrix2D + +A 2-D character matrix that doubles as an array of strings with fixed-row-length +storage. + +=back + +PLA does not yet offer matrix or tensor types with more than two dimensions. + == DEPENDENCIES -Currently depends on Parrot (Version 1.6.0 or higher), make, and CBLAS -(or ATLAS with the CBLAS-like bindings). On Ubuntu or other Debian-based -distros, you can type this incantation: +PLA has several dependencies. To help manage dependencies, you may want +to install Plumage + +http://gitorious.org/parrot-plumage + +This is not a dependency, just a convenience. + +Here are a list of dependencies for PLA: + +=over 4 -sudo apt-get install libatlas3-base -sudo apt-get install libatlas-base-dev +=item Parrot 2.2.0 + +PLA will be built and tested against the 2.2.0 release of Parrot. Get the 2.2.0 +release here: + +https://svn.parrot.org/parrot/tags/RELEASE_2_2_0 + +PLA will not build at all with older releases. PLA will not build with the +long-term supported 2.0.0 release. + +Starting April 2010 PLA will be tracking Parrot's supported releases which are +made public every 3 months. The 2.3.0 release will be in April 2010, and PLA +will be built and tested against that release until the 2.6.0 release in July, +then the 2.9.0 release in October, and then the 3.0.0 release in January. + +PLA expects a built and installed Parrot. For more information about the +installation process + +=item CBLAS or ATLAS + +PLA depends on either CBLAS or ATLAS. The BLAS library is written in Fortran, +so C language bindings are all translations of the Fortran interface. +Unfortunately there is not a good, standard way of translating the Fortran +source to C API bindings, so not all libraries that provide a C API for BLAS +will have an interface compatible with PLA. We are working to be more accepting +of small differences in various interfaces, but this work is moving slowly. + +We recommend the ATLAS library for current development and testing work. On +Ubuntu or other Debian-based distros, you can type this incantation to get it +automatically: + + sudo apt-get install libatlas3-base + sudo apt-get install libatlas-base-dev On Fedora you can type: -sudo yum install atlas-devel + sudo yum install atlas-devel Notice that the default vesions of the atlas library are only generally optimized. If you are able try to use a platform-specific variant (such -as "-sse2" or "-3dnow") for better performance. +as "-sse2" or "-3dnow") for better performance. See the ATLAS homepage for more +information: + +http://math-atlas.sourceforge.net/ + +=item Kakapo Release-10 + +Kakapo is a framework library for the NQP language. PLA currently uses Kakapo to +implement it's unit testing suite. You can build and install PLA without Kakapo, +but you will need the framework to run the test suite. You can obtain Kakapo +from it's source code repository on Gitorious, and get documentation from its +project page on Google Code: + +http://gitorious.org/kakapo +http://code.google.com/p/kakapo-parrot/ + +=item Other + +Currently, PLA is only tested to build and work on Linux and other Unix-like +systems with all the aforementioned prerequisites. The setup process pulls +configuration information from your installed version of Parrot, so it will +attempt to use the same compiler with the same compilation options as Parrot +was compiled with. If another compiler absolutely needs to be used, there may +be a way to specify that, but no documentation about the process exists. + +=back == BUILDING To get, build, test, and install Parrot-Linear-Algebra, follow these steps (on Linux): - git clone git://github.com/Whiteknight/parrot-linear-algebra.git pla - cd pla - parrot setup.pir - parrot setup.pir test - parrot setup.pir install + git clone git://github.com/Whiteknight/parrot-linear-algebra.git pla + cd pla + parrot setup.pir build + parrot setup.pir test + parrot setup.pir install -You may need to run the final command with elevated privileges on your system. +Testing only works if you have Kakapo installed on your system. To install, you +may need root privileges on your system. There is currently no known way to +build or deploy PLA on Windows. == CREDITS Original versions were developed as part of the Matrixy project by Blairuk. +Some parts of the test suite were provided by Austin Hastings. See the file CREDITS for updated information about contributors. From 25242d33778b6bb5a72f333489bf37e4365b02e8 Mon Sep 17 00:00:00 2001 From: Whiteknight Date: Fri, 19 Mar 2010 11:18:27 -0400 Subject: [PATCH 2/8] adding a new harness which uses kakapo and runs completely in a single process without starting new instances of parrot-nqp. does not work because of errors in Test::Builder --- t/harness2 | 130 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 130 insertions(+) create mode 100644 t/harness2 diff --git a/t/harness2 b/t/harness2 new file mode 100644 index 0000000..c539572 --- /dev/null +++ b/t/harness2 @@ -0,0 +1,130 @@ +#! parrot-nqp + +INIT { + pir::load_bytecode('./library/kakapo_full.pbc'); + Nqp::compile_file('t/testlib/matrixtest.nqp'); +} + +MAIN(); + +# TAP grammar in ABNF +# http://testanything.org/wiki/index.php/TAP_at_IETF:_Draft_Standard#Grammar +# TODO: +# verbose mode + +sub MAIN () { + my $total_passed := 0; + my $total_failed := 0; + my $total_files := 0; + my $failed_files := 0; + my $max_length := 30; + my @files := get_all_tests("t", "t/pmc"); + + for @files { + my $filename := $_; + $total_files++; + print_filename($filename, $max_length); + + my $test_output := run_test($filename); + my $plan := $test_output[0]; + my @plan_parts := $plan.split('..'); + my $num_tests := @plan_parts[1]; + my $curr_test := 0; + my $passed := 0; + my $failed := 0; + + $test_output.shift; # we don't need the plan anymore + + for $test_output { + my $line := $_; + + if ( $line ) { + + my $line_parts := $line.split("ok "); + my $right_side := $line_parts[1]; + my $right_side_parts := $right_side.split(' '); + my $test_number := $right_side_parts[0]; + # strip out comments + unless ($test_number > 0) { + my @test_num_parts := $test_number.split(' -'); + $test_number := @test_num_parts[0]; + } + if ($line_parts[0] eq 'not ') { + $failed++; + $curr_test++; + } elsif ($test_number == ($curr_test+1)) { + $passed++; + $curr_test++; + } + } + } + if $failed { + pir::say('failed ' ~ $failed ~ '/' ~ $num_tests ~ ' tests'); + } + else { + if @plan_parts[0] != 1 || $num_tests < 0 { + pir::say('INVALID PLAN: ' ~ @plan_parts.join()); + $failed_files++; + } + else { + pir::say('passed ' ~ $curr_test ~ ' tests'); + } + } + $total_passed := $total_passed + $passed; + $total_failed := $total_failed + $failed; + if $num_tests != $curr_test { + pir::say("Planned to run " ~ $num_tests ~ " tests but ran " ~ $curr_test ~ " tests"); + pir::say("FAILED"); + } + } + if $total_failed { + pir::say("FAILED " ~ $total_failed ~ '/' ~ ($total_passed+$total_failed)); + Q:PIR { + exit 1 + } + } elsif $failed_files { + pir::say("FAILED " ~ $failed_files ~ " files, PASSED " ~ $total_passed ~ ' tests'); + } else { + pir::say("PASSED " ~ $total_passed ~ ' tests in ' ~ $total_files ~ ' files'); + } +} + +sub get_all_tests(*@dirs) { + my $fs := FileSystem.instance; + my @files := Parrot::new("ResizableStringArray"); + for @dirs { + my $dir := $_; + my @rawfiles := $fs.get_contents($dir); + + for @rawfiles { + my $filename := $_; + if pir::index__ISS($filename, ".t") != -1 { + @files.push($dir ~ "/" ~ $filename); + my $length := pir::length__IS($dir ~ "/" ~ $filename); + #if $length > $max_length { + # $max_length := $length; + #} + } + } + } + return (@files); +} + + +sub print_filename($filename, $max_length) { + my $length := pir::length__IS($filename); + my $diff := ($max_length - $length) + 3; + my $elipses := pir::repeat__SSI('.', $diff); + print($filename ~ " " ~ $elipses ~ " "); +} + +sub run_test($filename) { + my $sub := Nqp::compile_file($filename); + my $stdout := Parrot::new("StringHandle"); + $stdout.open("blah", "rw"); + my %save_handles := Program::swap_handles(:stdout($stdout)); + $sub[0](); + Program::swap_handles(|%save_handles); + return ($stdout.readall().split("\n")); +} + From 023e5853df056fe5514709d752d1a706f65b7bf7 Mon Sep 17 00:00:00 2001 From: Whiteknight Date: Fri, 19 Mar 2010 12:02:10 -0400 Subject: [PATCH 3/8] Add a 'fix' to work around the Test::Harness bug. Disclaimer: The workaround is evil. overwrite the harness with the new kakapo-based one. --- t/harness | 108 +++++++++++++++++++++++++++++----------- t/harness2 | 10 ++++ t/pmc/charmatrix2d.t | 8 --- t/pmc/complexmatrix2d.t | 8 --- t/pmc/nummatrix2d.t | 10 +--- t/pmc/pmcmatrix2d.t | 10 +--- 6 files changed, 90 insertions(+), 64 deletions(-) diff --git a/t/harness b/t/harness index e6d024b..791d2c5 100644 --- a/t/harness +++ b/t/harness @@ -1,6 +1,9 @@ #! parrot-nqp -our @ARGS; +INIT { + pir::load_bytecode('./library/kakapo_full.pbc'); + Nqp::compile_file('t/testlib/matrixtest.nqp'); +} MAIN(); @@ -10,45 +13,40 @@ MAIN(); # verbose mode sub MAIN () { - pir::load_bytecode('t/Glue.pbc'); - my $total_passed:= 0; - my $total_failed:= 0; - my $total_files := 0; - my $failed_files:= 0; + my $total_passed := 0; + my $total_failed := 0; + my $total_files := 0; + my $failed_files := 0; + my $max_length := 30; + my @files := get_all_tests("t", "t/pmc"); - for @ARGS { + for @files { my $filename := $_; $total_files++; + print_filename($filename, $max_length); - print($filename ~ '...'); - - my $file := slurp($_); - my $test_output := qx('parrot-nqp', $filename); - my $output := split("\n",$test_output); - my @plan_parts := split('..',$output[0]); - + my $test_output := run_test($filename); + my $plan := $test_output[0]; + my @plan_parts := $plan.split('..'); my $num_tests := @plan_parts[1]; - my $curr_test := 0; - my $passed := 0; - my $failed := 0; - $output.shift; # we don't need the plan anymore + $test_output.shift; # we don't need the plan anymore - for $output { + for $test_output { my $line := $_; if ( $line ) { - my $line_parts := split('ok ', $line); + my $line_parts := $line.split("ok "); my $right_side := $line_parts[1]; - my $right_side_parts := split(' ', $right_side); + my $right_side_parts := $right_side.split(' '); my $test_number := $right_side_parts[0]; # strip out comments unless ($test_number > 0) { - my @test_num_parts := split(' -',$test_number); + my @test_num_parts := $test_number.split(' -'); $test_number := @test_num_parts[0]; } if ($line_parts[0] eq 'not ') { @@ -61,32 +59,82 @@ sub MAIN () { } } if $failed { - say('failed ' ~ $failed ~ '/' ~ $num_tests ~ ' tests'); + pir::say('failed ' ~ $failed ~ '/' ~ $num_tests ~ ' tests'); } else { if @plan_parts[0] != 1 || $num_tests < 0 { - say('INVALID PLAN: ' ~ join('',@plan_parts)); + pir::say('INVALID PLAN: ' ~ @plan_parts.join()); $failed_files++; } else { - say('passed ' ~ $curr_test ~ ' tests'); + pir::say('passed ' ~ $curr_test ~ ' tests'); } } $total_passed := $total_passed + $passed; $total_failed := $total_failed + $failed; if $num_tests != $curr_test { - say("Planned to run " ~ $num_tests ~ " tests but ran " ~ $curr_test ~ " tests"); - say("FAILED"); + pir::say("Planned to run " ~ $num_tests ~ " tests but ran " ~ $curr_test ~ " tests"); + pir::say("FAILED"); } + reset_test_environment(); } if $total_failed { - say("FAILED " ~ $total_failed ~ '/' ~ ($total_passed+$total_failed)); + pir::say("FAILED " ~ $total_failed ~ '/' ~ ($total_passed+$total_failed)); Q:PIR { exit 1 } } elsif $failed_files { - say("FAILED " ~ $failed_files ~ " files, PASSED " ~ $total_passed ~ ' tests'); + pir::say("FAILED " ~ $failed_files ~ " files, PASSED " ~ $total_passed ~ ' tests'); } else { - say("PASSED " ~ $total_passed ~ ' tests in ' ~ $total_files ~ ' files'); + pir::say("PASSED " ~ $total_passed ~ ' tests in ' ~ $total_files ~ ' files'); } } + +sub get_all_tests(*@dirs) { + my $fs := FileSystem.instance; + my @files := Parrot::new("ResizableStringArray"); + for @dirs { + my $dir := $_; + my @rawfiles := $fs.get_contents($dir); + + for @rawfiles { + my $filename := $_; + if pir::index__ISS($filename, ".t") != -1 { + @files.push($dir ~ "/" ~ $filename); + my $length := pir::length__IS($dir ~ "/" ~ $filename); + #if $length > $max_length { + # $max_length := $length; + #} + } + } + } + return (@files); +} + + +sub print_filename($filename, $max_length) { + my $length := pir::length__IS($filename); + my $diff := ($max_length - $length) + 3; + my $elipses := pir::repeat__SSI('.', $diff); + print($filename ~ " " ~ $elipses ~ " "); +} + +sub run_test($filename) { + my $sub := Nqp::compile_file($filename); + my $stdout := Parrot::new("StringHandle"); + $stdout.open("blah", "rw"); + my %save_handles := Program::swap_handles(:stdout($stdout)); + $sub[0](); + Program::swap_handles(|%save_handles); + return ($stdout.readall().split("\n")); +} + +sub reset_test_environment() { + # TODO: This is an evil hack. Test::Builder doesn't clean up it's environment + # so when I try to run multiple tests in a single program instance + # it breaks. When Test::Builder gets fixed, remove this nonsense + Q:PIR { + $P0 = new "Undef" + set_hll_global [ 'Test'; 'Builder'; '_singleton' ], 'singleton', $P0 + }; +} diff --git a/t/harness2 b/t/harness2 index c539572..791d2c5 100644 --- a/t/harness2 +++ b/t/harness2 @@ -76,6 +76,7 @@ sub MAIN () { pir::say("Planned to run " ~ $num_tests ~ " tests but ran " ~ $curr_test ~ " tests"); pir::say("FAILED"); } + reset_test_environment(); } if $total_failed { pir::say("FAILED " ~ $total_failed ~ '/' ~ ($total_passed+$total_failed)); @@ -128,3 +129,12 @@ sub run_test($filename) { return ($stdout.readall().split("\n")); } +sub reset_test_environment() { + # TODO: This is an evil hack. Test::Builder doesn't clean up it's environment + # so when I try to run multiple tests in a single program instance + # it breaks. When Test::Builder gets fixed, remove this nonsense + Q:PIR { + $P0 = new "Undef" + set_hll_global [ 'Test'; 'Builder'; '_singleton' ], 'singleton', $P0 + }; +} diff --git a/t/pmc/charmatrix2d.t b/t/pmc/charmatrix2d.t index 45744e6..3b98a77 100644 --- a/t/pmc/charmatrix2d.t +++ b/t/pmc/charmatrix2d.t @@ -1,11 +1,3 @@ -#! parrot-nqp - -INIT { - pir::load_bytecode('./library/kakapo_full.pbc'); - pir::loadlib__ps("./linalg_group"); - Nqp::compile_file('t/testlib/matrixtest.nqp'); -} - class Test::CharMatrix2D is Pla::Matrix::Testcase; INIT { diff --git a/t/pmc/complexmatrix2d.t b/t/pmc/complexmatrix2d.t index d0e21bb..ffa6876 100644 --- a/t/pmc/complexmatrix2d.t +++ b/t/pmc/complexmatrix2d.t @@ -1,11 +1,3 @@ -#! parrot-nqp - -INIT { - pir::load_bytecode('./library/kakapo_full.pbc'); - pir::loadlib__ps("./linalg_group"); - Nqp::compile_file('t/testlib/matrixtest.nqp'); -} - class Test::ComplexMatrix2D is Pla::Matrix::Testcase; INIT { diff --git a/t/pmc/nummatrix2d.t b/t/pmc/nummatrix2d.t index e804c58..aeffaaf 100644 --- a/t/pmc/nummatrix2d.t +++ b/t/pmc/nummatrix2d.t @@ -1,12 +1,4 @@ -#! parrot-nqp - -INIT { - pir::load_bytecode('./library/kakapo_full.pbc'); - pir::loadlib__ps("./linalg_group"); - Nqp::compile_file('t/testlib/matrixtest.nqp'); -} - -class Test::CharMatrix2D is Pla::Matrix::Testcase; +class Test::NumMatrix2D is Pla::Matrix::Testcase; INIT { use('UnitTest::Testcase'); diff --git a/t/pmc/pmcmatrix2d.t b/t/pmc/pmcmatrix2d.t index aee92fa..bce8002 100644 --- a/t/pmc/pmcmatrix2d.t +++ b/t/pmc/pmcmatrix2d.t @@ -1,12 +1,4 @@ -#! parrot-nqp - -INIT { - pir::load_bytecode('./library/kakapo_full.pbc'); - pir::loadlib__ps("./linalg_group"); - Nqp::compile_file('t/testlib/matrixtest.nqp'); -} - -class Test::CharMatrix2D is Pla::Matrix::Testcase; +class Test::PmcMatrix2D is Pla::Matrix::Testcase; INIT { use('UnitTest::Testcase'); From 33db2acda707d016c7a80ebbcd235d60a3ffd0de Mon Sep 17 00:00:00 2001 From: Whiteknight Date: Fri, 19 Mar 2010 12:26:30 -0400 Subject: [PATCH 4/8] add a run_test utility that allows us to run an individual test file with all the same scaffolding and setup that the harness prepares. --- t/Glue.pir | 732 ----------------------------------------------------- t/run_test | 26 ++ 2 files changed, 26 insertions(+), 732 deletions(-) delete mode 100644 t/Glue.pir create mode 100644 t/run_test diff --git a/t/Glue.pir b/t/Glue.pir deleted file mode 100644 index 6b6280a..0000000 --- a/t/Glue.pir +++ /dev/null @@ -1,732 +0,0 @@ -=head1 NAME - -Glue.pir - Rakudo "glue" builtins (functions/globals) converted for NQP - - -=head1 SYNOPSIS - - # Load this library - load_bytecode('src/lib/Glue.pbc'); - - # External programs - $status_code := run( $command, $and, $args, ...); - $success := do_run($command, $and, $args, ...); - $output := qx( $command, $and, $args, ...); - - # Exceptions - die($message); - try(&code, @args [, &handler]); - - # Hash basics - @keys := keys(%hash); - $found := exists(%hash, $key); - - # OO and types - $does_role := does($object, $role); - - # I/O - $contents := slurp($filename); - spew( $filename, $contents); - append($filename, $contents); - - # Regular expressions - $regex_object := rx($regex_source); - @matches := all_matches($regex, $text); - $edited := subst($original, $regex, $replacement); - - # Filesystems and paths - chdir($path); - $path := cwd(); - mkdir($path [, $mode]); - unlink($path); - @info := stat($path); - $found := path_exists($path); - @names := readdir($directory); - $path := fscat(@path_parts [, $filename]); - - # String basics - $joined := join($delimiter, @strings); - @pieces := split($delimiter, $original); - - # Context - @array := as_array($list, $of, $items, ...); - $result := call_flattened(&code, $mixed, @args, $list, ...); - - # Global variables; - our $PROGRAM_NAME; - our @ARGS; - our %ENV; - our %VM; - our $OS; - our $OSVER; - - -=cut - -.namespace [] - -.include 'interpinfo.pasm' -.include 'sysinfo.pasm' -.include 'iglobals.pasm' - - -=head1 DESCRIPTION - -=head2 Functions - -=over 4 - -=item $status_code := run($command, $and, $args, ...) - -Spawn the command with the given arguments as a new process; returns -the status code of the spawned process, which is equal the the result -of the waitpid system call, right bitshifted by 8. - -=cut - -.sub 'run' - .param pmc command_and_args :slurpy - .local int status - - # returns the result of waitpid - status = spawnw command_and_args - - # return code is waitpid >> 8 - shr status, status, 8 - - .return (status) -.end - - -=item $success := do_run($command, $and, $args, ...) - -Print out the command and arguments, then spawn the command with the given -arguments as a new process; return 1 if the process exited successfully, or -0 if not. - -=cut - -.sub 'do_run' - .param pmc command_and_args :slurpy - - .local string cmd - cmd = join ' ', command_and_args - say cmd - - .local int status - status = spawnw command_and_args - - if status goto failed - .return (1) - failed: - .return (0) -.end - - -=item $output := qx($command, $and, $args, ...) - -Spawn the command with the given arguments as a read only pipe; -return the output of the command as a single string. - -B: Parrot currently implements this B! - -=cut - -.sub 'qx' - .param pmc command_and_args :slurpy - - .local string cmd - cmd = join ' ', command_and_args - - .local pmc pipe - pipe = open cmd, 'rp' - unless pipe goto pipe_open_error - - .local pmc output - pipe.'encoding'('utf8') - output = pipe.'readall'() - pipe.'close'() - .return (output) - - pipe_open_error: - $S0 = 'Unable to execute "' - $S0 .= cmd - $S0 .= '"' - die $S0 -.end - - -=item die($message) - -Kill program, reporting error C<$message>. - -=cut - -.sub 'die' - .param string message - - die message -.end - - -=item $ret := try(&code, @args [, &handler]) - -Call C<&code> with flattened C<@args>. If there are any exceptions, catch -them and invoke C<&handler> with the exception, C<&code>, and C<@args>. -If C<&handler> is absent, simply return C<0> if an exception is caught. -In other words, C implements the following pseudocode: - - try { $ret := &code(|@args) } - catch($ex) { $ret := &handler ?? &handler($ex, &code, @args) !! 0 } - return $ret; - -=cut - -.sub 'try' - .param pmc code - .param pmc args - .param pmc handler :optional - .param int has_handler :opt_flag - - push_eh do_handler - $P0 = code(args :flat) - pop_eh - .return ($P0) - - do_handler: - .local pmc ex - .get_results (ex) - pop_eh - eq has_handler, 0, no_handler - $P0 = handler(ex, code, args) - .return ($P0) - - no_handler: - .return (0) -.end - - -=item @keys := keys(%hash) - -Return an array containing the keys of the C<%hash>. - -=cut - -.sub 'keys' - .param pmc hash - - .local pmc key_list, it - key_list = root_new ['parrot';'ResizableStringArray'] - it = iter hash - - key_loop: - unless it goto no_more_keys - - $S0 = shift it - push key_list, $S0 - - goto key_loop - no_more_keys: - - .return(key_list) -.end - - -=item $found := exists(%hash, $key) - -Determine if C<$key> exists in C<%hash>, returning a true value if so, and a -false value if not. - -=cut - -.sub 'exists' - .param pmc hash - .param string key - - $I0 = exists hash[key] - - .return($I0) -.end - - -=item $does_role := does($object, $role) - -Determine if C<$object> does the C<$role>, returning a true value if so, and a -false value if not. - -=cut - -.sub 'does' - .param pmc object - .param string role - - $I0 = does object, role - - .return($I0) -.end - - -=item $contents := slurp($filename) - -Read the C<$contents> of a file as a single string. - -=cut - -.sub 'slurp' - .param string filename - .local string contents - - $P0 = open filename, 'r' - contents = $P0.'readall'() - close $P0 - .return(contents) -.end - - -=item spew($filename, $contents) - -Write the string C<$contents> to a file. - -=cut - -.sub 'spew' - .param string filename - .param string contents - - $P0 = open filename, 'w' - $P0.'print'(contents) - close $P0 -.end - - -=item append($filename, $contents) - -Append the string C<$contents> to a file. - -=cut - -.sub 'append' - .param string filename - .param string contents - - $P0 = open filename, 'a' - $P0.'print'(contents) - close $P0 -.end - - -=item $regex_object := rx($regex_source) - -Compile C<$regex_source> (a string representing the source code form of a -Perl 6 Regex) into a C<$regex_object>, suitable for using in C and -C. - -=cut - -.sub 'rx' - .param string source - - .local pmc p6regex, object - p6regex = compreg 'PGE::Perl6Regex' - object = p6regex(source) - - .return(object) -.end - -=item @matches := all_matches($regex, $text) - -Find all matches (C<:g> style, not C<:exhaustive>) for C<$regex> in the -C<$text>. The C<$regex> must be a regex object returned by C. - -=cut - -.sub 'all_matches' - .param pmc regex - .param string text - - # Find all matches in the original string - .local pmc matches, match - matches = root_new ['parrot';'ResizablePMCArray'] - match = regex(text) - unless match goto done_matching - - match_loop: - push matches, match - - $I0 = match.'to'() - match = regex(match, 'continue' => $I0) - - unless match goto done_matching - goto match_loop - done_matching: - - .return(matches) -.end - - -=item $edited := subst($original, $regex, $replacement) - -Substitute all matches of the C<$regex> in the C<$original> string with the -C<$replacement>, and return the edited string. The C<$regex> must be a regex -object returned by the C function. - -The C<$replacement> may be either a simple string or a sub that will be called -with each match object in turn, and must return the proper replacement string -for that match. - -=cut - -.sub 'subst' - .param string original - .param pmc regex - .param pmc replacement - - # Find all matches in the original string - .local pmc matches - matches = all_matches(regex, original) - - # Do the substitutions on a clone of the original string - .local string edited - edited = clone original - - # Now replace all the matched substrings - .local pmc match - .local int offset - offset = 0 - replace_loop: - unless matches goto done_replacing - match = shift matches - - # Handle either string or sub replacement - .local string replace_string - $I0 = isa replacement, 'Sub' - if $I0 goto call_replacement_sub - replace_string = replacement - goto have_replace_string - call_replacement_sub: - replace_string = replacement(match) - have_replace_string: - - # Perform the replacement - $I0 = match.'from'() - $I1 = match.'to'() - $I2 = $I1 - $I0 - $I0 += offset - substr edited, $I0, $I2, replace_string - $I3 = length replace_string - $I3 -= $I2 - offset += $I3 - goto replace_loop - done_replacing: - - .return(edited) -.end - -=item chdir($path) - -Change the current working directory to the specified C<$path>. - -=cut - -.sub 'chdir' - .param string path - - .local pmc os - os = root_new [ 'parrot' ; 'OS' ] - os.'chdir'(path) -.end - -=item $path := cwd() - -Return the current working directory. - -=cut - -.sub 'cwd' - .local pmc os - os = root_new [ 'parrot' ; 'OS' ] - - .local string path - path = os.'cwd'() - - .return(path) -.end - -=item mkdir($path [, $mode]) - -Create a directory specified by C<$path> with mode C<$mode>. C<$mode> is -optional and defaults to octal C<777> (full permissions) if absent. C<$mode> -is modified by the user's current C as usual. - -=cut - -.sub 'mkdir' - .param string path - .param int mode :optional - .param int has_mode :opt_flag - - if has_mode goto have_mode - mode = 0o777 - have_mode: - - .local pmc os - os = root_new [ 'parrot' ; 'OS' ] - os.'mkdir'(path, mode) -.end - -=item unlink($path) - -Unlink (delete) a file or empty directory named C<$path> in the filesystem. - -=cut - -.sub 'unlink' - .param string path - - .local pmc os - os = root_new [ 'parrot' ; 'OS' ] - os.'rm'(path) -.end - -=item @info := stat($path) - -Returns a 13-item list of information about the given C<$path>, as in Perl 5. -(See C for more details.) - -=cut - -.sub 'stat' - .param string path - - .local pmc os, stat_list - os = root_new [ 'parrot' ; 'OS' ] - stat_list = os.'stat'(path) - - .return (stat_list) -.end - -=item $found := path_exists($path); - -Return a true value if the C<$path> exists on the filesystem, or a false -value if not. - -=cut - -.sub 'path_exists' - .param string path - - push_eh stat_failed - .local pmc stat_list - stat_list = 'stat'(path) - pop_eh - .return (1) - - stat_failed: - pop_eh - .return (0) -.end - -=item @names := readdir($directory) - -List the names of all entries in the C<$directory>. - -=cut - -.sub 'readdir' - .param string dir - - .local pmc os, names - os = root_new [ 'parrot' ; 'OS' ] - names = os.'readdir'(dir) - - .return (names) -.end - -=item $path := fscat(@path_parts [, $filename]) - -Join C<@path_parts> and C<$filename> strings together with the appropriate -OS separator. If no C<$filename> is supplied, C will I add a -trailing slash (though slashes inside the C<@path_parts> will not be removed, -so don't do that). - -=cut - -.sub 'fscat' - .param pmc parts - .param string filename :optional - .param int has_filename :opt_flag - - .local string sep - $P0 = getinterp - $P1 = $P0[.IGLOBALS_CONFIG_HASH] - sep = $P1['slash'] - - .local string joined - joined = join sep, parts - - unless has_filename goto no_filename - joined .= sep - joined .= filename - no_filename: - - .return (joined) -.end - -=item $joined := join($delimiter, @strings) - -Join C<@strings> together with the specified C<$delimiter>. - -=cut - -.sub 'join' - .param string delim - .param pmc strings - - .local string joined - joined = join delim, strings - - .return (joined) -.end - -=item @pieces := split($delimiter, $original) - -Split the C<$original> string with the specified C<$delimiter>, which is not -included in the resulting C<@pieces>. - -=cut - -.sub 'split' - .param string delim - .param string original - - .local pmc pieces - pieces = split delim, original - - .return (pieces) -.end - - -=item @array := as_array($list, $of, $items, ...) - -Slurp the list of arguments into an array and return it. - -=cut - -.sub 'as_array' - .param pmc items :slurpy - - .return (items) -.end - - -=item $result := call_flattened(&code, $mixed, @args, $list, ...) - -Call C<&code> with flattened arguments. This is done by first slurping all -arguments into an array, then iterating over the array flattening by one level -each element that C. Finally, the C<&code> is tailcalled with -the flattened array using the Parrot C<:flat> flag. - -To avoid flattening an array that should be passed as a single argument, wrap -it with C first, like so: - - call_flattened(&code, as_array(@protected), @will_flatten) - -=cut - -.sub 'call_flattened' - .param pmc code - .param pmc args :slurpy - - .local pmc flattened, args_it, array_it - flattened = root_new ['parrot';'ResizablePMCArray'] - args_it = iter args - - args_loop: - unless args_it goto do_tailcall - $P0 = shift args_it - $I0 = does $P0, 'array' - if $I0 goto flatten_array - push flattened, $P0 - goto args_loop - flatten_array: - array_it = iter $P0 - array_loop: - unless array_it goto args_loop - $P1 = shift array_it - push flattened, $P1 - goto array_loop - - do_tailcall: - .tailcall code(flattened :flat) -.end - -=back - - -=head2 Global Variables - -=over 4 - -=item $PROGRAM_NAME - -Name of running program (argv[0] in C) - -=item @ARGS - -Program's command line arguments (including options, which are NOT parsed) - -=item %VM - -Parrot configuration - -=item %ENV - -Process-wide environment variables - -=item $OS - -Operating system generic name - -=item $OSVER - -Operating system version - -=back - -=cut - -.sub 'onload' :anon :load :init - load_bytecode 'config.pbc' - $P0 = getinterp - $P1 = $P0[.IGLOBALS_CONFIG_HASH] - $P2 = new ['Hash'] - $P2['config'] = $P1 - set_hll_global '%VM', $P2 - - $P1 = $P0[.IGLOBALS_ARGV_LIST] - if $P1 goto have_args - unshift $P1, '' - have_args: - $S0 = shift $P1 - $P2 = box $S0 - set_hll_global '$PROGRAM_NAME', $P2 - set_hll_global '@ARGS', $P1 - - $P0 = root_new ['parrot';'Env'] - set_hll_global '%ENV', $P0 - - $S0 = sysinfo .SYSINFO_PARROT_OS - $P0 = box $S0 - set_hll_global '$OS', $P0 - - $S0 = sysinfo .SYSINFO_PARROT_OS_VERSION - $P0 = box $S0 - set_hll_global '$OSVER', $P0 -.end - - -# Local Variables: -# mode: pir -# fill-column: 100 -# End: -# vim: expandtab shiftwidth=4 ft=pir: diff --git a/t/run_test b/t/run_test new file mode 100644 index 0000000..fff57d7 --- /dev/null +++ b/t/run_test @@ -0,0 +1,26 @@ +#! parrot-nqp + +INIT { + pir::load_bytecode('./library/kakapo_full.pbc'); + Nqp::compile_file('t/testlib/matrixtest.nqp'); + pir::loadlib__ps("./linalg_group"); +} + +class MyProgram is Program { + method main(*@args) { + for @args { + my $test := $_; + my $sub := Nqp::compile_file("t/pmc/" ~ $test); + $sub[0](); + } + } +} + +INIT { + Program::instance( + MyProgram.new( :from_parrot ) + ).run; +} + + + From ef82b813e30e6f88926f939dd8ececdf5f49f37f Mon Sep 17 00:00:00 2001 From: Whiteknight Date: Fri, 19 Mar 2010 12:27:50 -0400 Subject: [PATCH 5/8] fix one test failure in charmatrix2d, remove Glue.pir from the build --- setup.pir | 4 ---- t/pmc/charmatrix2d.t | 8 ++++---- 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/setup.pir b/setup.pir index 9013ed0..80b36b8 100644 --- a/setup.pir +++ b/setup.pir @@ -58,10 +58,6 @@ SOURCES $P0['dynpmc'] = $P2 'system_linker_settings'($P0) - $P4 = new 'Hash' - $P4['t/Glue.pbc'] = 't/Glue.pir' - $P0['pbc_pir'] = $P4 - # test $S0 = get_nqp() $P0['harness_exec'] = $S0 diff --git a/t/pmc/charmatrix2d.t b/t/pmc/charmatrix2d.t index 3b98a77..6c71301 100644 --- a/t/pmc/charmatrix2d.t +++ b/t/pmc/charmatrix2d.t @@ -110,10 +110,10 @@ method test_METHOD_fill() { method test_METHOD_fill_RESIZE() { my $m := self.matrix(); my $n := self.matrix2x2( - self.fancyvalue(), - self.fancyvalue(), - self.fancyvalue(), - self.fancyvalue() + self.fancyvalue(4), + self.fancyvalue(4), + self.fancyvalue(4), + self.fancyvalue(4) ); $m.fill(90, 2, 2); assert_equal($n, $m, "Cannot fill"); From 5979c9fe5e1510c24869f15d16d89d9d9be8c994 Mon Sep 17 00:00:00 2001 From: Whiteknight Date: Fri, 19 Mar 2010 12:42:40 -0400 Subject: [PATCH 6/8] some much needed aesthetic improvements in setup.pir and t/harness --- setup.pir | 30 ++++++++---- t/harness | 6 +-- t/harness2 | 140 ----------------------------------------------------- 3 files changed, 24 insertions(+), 152 deletions(-) delete mode 100644 t/harness2 diff --git a/setup.pir b/setup.pir index 80b36b8..5a0b16c 100644 --- a/setup.pir +++ b/setup.pir @@ -24,13 +24,6 @@ See F. $S0 = shift args load_bytecode 'distutils.pbc' - $I0 = probe_include('cblas.h', 0 :named('verbose')) - if $I0 == 0 goto L1 - say "no cblas.h" - say "install libatlas-base-dev" - end - L1: - $P0 = new 'Hash' $P0['name'] = 'parrot-linear-algebra' $P0['abstract'] = 'Linear Algebra Package for Parrot VM' @@ -46,6 +39,16 @@ See F. $P0['project_uri'] = 'http://github.com/Whiteknight/parrot-linear-algebra' # build + $I0 = elements args + if $I0 == 0 goto probe_files + $S0 = args[0] + if $S0 == "build" goto probe_files + goto no_probe + probe_files: + 'system_linker_settings'($P0) + 'probe for cblas.h'() + no_probe: + $P2 = new 'Hash' $P3 = split "\n", <<'SOURCES' src/pmc/nummatrix2d.pmc @@ -56,12 +59,12 @@ SOURCES $S0 = pop $P3 $P2['linalg_group'] = $P3 $P0['dynpmc'] = $P2 - 'system_linker_settings'($P0) + # test $S0 = get_nqp() $P0['harness_exec'] = $S0 - $P0['harness_files'] = 't/*.t t/pmc/*.t' + $P0['harness_files'] = '' # dist $P5 = glob('src/pmc/pla_matrix_types.h src/*.pir src/*.m examples/*.pir tools/nci/*.pl') @@ -92,6 +95,15 @@ SOURCES .return() .end +.sub 'probe for cblas.h' + $I0 = probe_include('cblas.h', 0 :named('verbose')) + if $I0 == 0 goto L1 + say "no cblas.h" + say "install libatlas-base-dev" + end + L1: +.end + # Local Variables: diff --git a/t/harness b/t/harness index 791d2c5..c430a20 100644 --- a/t/harness +++ b/t/harness @@ -59,7 +59,7 @@ sub MAIN () { } } if $failed { - pir::say('failed ' ~ $failed ~ '/' ~ $num_tests ~ ' tests'); + pir::say('not ok (' ~ $failed ~ '/' ~ $num_tests ~ ' failed)'); } else { if @plan_parts[0] != 1 || $num_tests < 0 { @@ -67,7 +67,7 @@ sub MAIN () { $failed_files++; } else { - pir::say('passed ' ~ $curr_test ~ ' tests'); + pir::say('ok'); } } $total_passed := $total_passed + $passed; @@ -123,7 +123,7 @@ sub run_test($filename) { my $sub := Nqp::compile_file($filename); my $stdout := Parrot::new("StringHandle"); $stdout.open("blah", "rw"); - my %save_handles := Program::swap_handles(:stdout($stdout)); + my %save_handles := Program::swap_handles(:stdout($stdout), :stderr($stdout)); $sub[0](); Program::swap_handles(|%save_handles); return ($stdout.readall().split("\n")); diff --git a/t/harness2 b/t/harness2 deleted file mode 100644 index 791d2c5..0000000 --- a/t/harness2 +++ /dev/null @@ -1,140 +0,0 @@ -#! parrot-nqp - -INIT { - pir::load_bytecode('./library/kakapo_full.pbc'); - Nqp::compile_file('t/testlib/matrixtest.nqp'); -} - -MAIN(); - -# TAP grammar in ABNF -# http://testanything.org/wiki/index.php/TAP_at_IETF:_Draft_Standard#Grammar -# TODO: -# verbose mode - -sub MAIN () { - my $total_passed := 0; - my $total_failed := 0; - my $total_files := 0; - my $failed_files := 0; - my $max_length := 30; - my @files := get_all_tests("t", "t/pmc"); - - for @files { - my $filename := $_; - $total_files++; - print_filename($filename, $max_length); - - my $test_output := run_test($filename); - my $plan := $test_output[0]; - my @plan_parts := $plan.split('..'); - my $num_tests := @plan_parts[1]; - my $curr_test := 0; - my $passed := 0; - my $failed := 0; - - $test_output.shift; # we don't need the plan anymore - - for $test_output { - my $line := $_; - - if ( $line ) { - - my $line_parts := $line.split("ok "); - my $right_side := $line_parts[1]; - my $right_side_parts := $right_side.split(' '); - my $test_number := $right_side_parts[0]; - # strip out comments - unless ($test_number > 0) { - my @test_num_parts := $test_number.split(' -'); - $test_number := @test_num_parts[0]; - } - if ($line_parts[0] eq 'not ') { - $failed++; - $curr_test++; - } elsif ($test_number == ($curr_test+1)) { - $passed++; - $curr_test++; - } - } - } - if $failed { - pir::say('failed ' ~ $failed ~ '/' ~ $num_tests ~ ' tests'); - } - else { - if @plan_parts[0] != 1 || $num_tests < 0 { - pir::say('INVALID PLAN: ' ~ @plan_parts.join()); - $failed_files++; - } - else { - pir::say('passed ' ~ $curr_test ~ ' tests'); - } - } - $total_passed := $total_passed + $passed; - $total_failed := $total_failed + $failed; - if $num_tests != $curr_test { - pir::say("Planned to run " ~ $num_tests ~ " tests but ran " ~ $curr_test ~ " tests"); - pir::say("FAILED"); - } - reset_test_environment(); - } - if $total_failed { - pir::say("FAILED " ~ $total_failed ~ '/' ~ ($total_passed+$total_failed)); - Q:PIR { - exit 1 - } - } elsif $failed_files { - pir::say("FAILED " ~ $failed_files ~ " files, PASSED " ~ $total_passed ~ ' tests'); - } else { - pir::say("PASSED " ~ $total_passed ~ ' tests in ' ~ $total_files ~ ' files'); - } -} - -sub get_all_tests(*@dirs) { - my $fs := FileSystem.instance; - my @files := Parrot::new("ResizableStringArray"); - for @dirs { - my $dir := $_; - my @rawfiles := $fs.get_contents($dir); - - for @rawfiles { - my $filename := $_; - if pir::index__ISS($filename, ".t") != -1 { - @files.push($dir ~ "/" ~ $filename); - my $length := pir::length__IS($dir ~ "/" ~ $filename); - #if $length > $max_length { - # $max_length := $length; - #} - } - } - } - return (@files); -} - - -sub print_filename($filename, $max_length) { - my $length := pir::length__IS($filename); - my $diff := ($max_length - $length) + 3; - my $elipses := pir::repeat__SSI('.', $diff); - print($filename ~ " " ~ $elipses ~ " "); -} - -sub run_test($filename) { - my $sub := Nqp::compile_file($filename); - my $stdout := Parrot::new("StringHandle"); - $stdout.open("blah", "rw"); - my %save_handles := Program::swap_handles(:stdout($stdout)); - $sub[0](); - Program::swap_handles(|%save_handles); - return ($stdout.readall().split("\n")); -} - -sub reset_test_environment() { - # TODO: This is an evil hack. Test::Builder doesn't clean up it's environment - # so when I try to run multiple tests in a single program instance - # it breaks. When Test::Builder gets fixed, remove this nonsense - Q:PIR { - $P0 = new "Undef" - set_hll_global [ 'Test'; 'Builder'; '_singleton' ], 'singleton', $P0 - }; -} From 39602fced89b7ae693a612b9f9ba944168135355 Mon Sep 17 00:00:00 2001 From: Whiteknight Date: Fri, 19 Mar 2010 12:46:33 -0400 Subject: [PATCH 7/8] a few comments in the testlib --- t/testlib/matrixtest.nqp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/t/testlib/matrixtest.nqp b/t/testlib/matrixtest.nqp index 2ba7c53..b702485 100644 --- a/t/testlib/matrixtest.nqp +++ b/t/testlib/matrixtest.nqp @@ -43,6 +43,7 @@ class Pla::Matrix::Testcase is UnitTest::Testcase { return ($m); } + # Create a 2x2 matrix completely filled with a single default value method defaultmatrix2x2() { return self.matrix2x2( self.defaultvalue(), @@ -52,6 +53,7 @@ class Pla::Matrix::Testcase is UnitTest::Testcase { ); } + # Create a 2x2 matrix with interesting values in each slot. method fancymatrix2x2() { return self.matrix2x2( self.fancyvalue(0), From 1860e65096ef1eac64580eef73ba71bc00dba5ce Mon Sep 17 00:00:00 2001 From: Whiteknight Date: Fri, 19 Mar 2010 14:15:59 -0400 Subject: [PATCH 8/8] small fix to run_test utility. When the .run is in the INIT block I get a weird 'No exception handler and no message ' error. When I move it outside, everything works fine. --- t/run_test | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/t/run_test b/t/run_test index fff57d7..493c80a 100644 --- a/t/run_test +++ b/t/run_test @@ -19,8 +19,9 @@ class MyProgram is Program { INIT { Program::instance( MyProgram.new( :from_parrot ) - ).run; + ); } +Program::instance().run;