Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

See log.

 * Rewrote PSpec library. It works in "nom" now. It's now loosely based
   on RSpec 2.0 rather than RSpec 1.0.
 * Pickle and associated files are moved into its own project.
  • Loading branch information...
commit eace2dd5bd65ec08df4234865d5c9ea96faf55c7 1 parent 4f8c32e
Timothy Totten authored
View
69 Changelog.txt
@@ -1,69 +0,0 @@
-Version 4.0.0
- * This will be a complete rewrite. Stay tuned.
-
-Version 3.0.1
- * Fixed a sub definition in PSpec.pm
- * Made Story.pm compile properly.
- * Added edit.sh from ww6 for easy compiling (./edit.sh -c)
-
-Version 3.0.0
- * Split the story handling into its own library: Pickle
- * Split the 'times' stuff into a Times library.
- * The 'x' infix operator is no longer exported by default from Times.
- * Reworked the tests to use the new libraries.
-
-Version 2.5.1
- * Added an overloaded definition of the 'x' infix operator.
- * Fixed the comments for the Cucumber-like functionality.
- * Added a caveat to the README about the new Rakudo master branch.
- * Added a TODO section to the README, outlining my ideas for 3.0
-
-Version 2.5.0
- * Added step chaining, using a new declare statement.
- * Added Cucumber Tables. You can use a Table object.
- * Added a hashMap method to Array objects. Used in the Table class,
- and in the Outlines functionality.
- * Added multiline text, using a Pair object.
- * Made a 'matching' function as a helper for handlers that use
- Tables or Mutiline text. Use 'given matching $line'.
-
-Version 2.4.0
- * Added Scenario Outlines functionality, and a spec test for it.
- * Refactored a bit.
- * Changed how verbosity works, use -vv for double verbosity now.
- * Reorganized the directories again.
- The core tests are now in 't' and example tests are in 'examples'.
- * Preparing for tables and multiline input support (next version).
-
-Version 2.3.0
- * Some bug fixes
- * Reworked the story handler significantly
- * Added Background support to the story handler
- * Expanded test coverage
- * Made the story tests quiet by default. Pass '-v' if you want
- The story to be read out.
-
-Version 2.2.0
- * Made the times operator more like the .times method.
- * Reorganized the files into directories such as 'lib', 'spec', etc.
- * Added a story test to the pspec.t specification.
- * Added a README file.
-
-Version 2.1.0
- * Implemented a .times method for Int objects,
- solution provided by Carl Masak.
-
-Version 2.0.0
- * Implemented minimal Cucumber-like "story" handling.
-
-Version 1.2.0
- * Made a new syntax for comparisons like >, <, gt, etc.
-
-Version 1.1.0
- * Made should-be a public function as well as infix operator.
- * Added ability to use special pair objects for more advanced comparisons.
-
-Version 1.0.0
- * First release
-
-
View
7 META.info
@@ -0,0 +1,7 @@
+{
+ "name" : "PSpec",
+ "version" : "*",
+ "description" : "An RSpec-like testing framework for Perl 6",
+ "depends" : [],
+ "source-url" : "git://github.com/supernovus/PSpec.git"
+}
View
39 README.md
@@ -0,0 +1,39 @@
+# PSpec -- RSpec for Perl 6
+
+## Introduction
+
+PSpec is an implementation of Ruby's RSpec library, in Perl 6.
+It's currently very minimal, and does not implement much of RSpec.
+
+## Status
+
+ * Supports basic "describe" commands.
+ * Supports a very simplistic "should" statement.
+ * Has eq(), lt() and gt() subs that perform simplistic tests.
+
+## TODO
+
+Lots. This is barely functional, but is pretty much back to the level of
+the last working version prior to the rewrite.
+
+## Credits
+
+Well, I must send cudos to the original authors of RSpec and Cucumber,
+without them, this wouldn't exist.
+
+Also, a big cheers to Carl Masak, who is always friendly and helpful!
+And a call-out to Larry Wall whose help on the #perl6 channel has been
+greatly appreciated! I guess I should also thank him for creating Perl :-)
+
+Since writing the original version of this Credits section, I've received
+a lot of help and feedback from many people on the #perl6 channel. Thanks
+to the whole Perl 6 community for being awesome!
+
+## Author
+
+[Timothy Totten](https://github.com/supernovus/)
+
+## License
+
+[Artistic License 2.0](http://www.perlfoundation.org/artistic_license_2_0)
+
View
112 README.txt
@@ -1,112 +0,0 @@
-+------------------------------------------------------------------------------+
-+ PSpec: An RSpec + Cucumber inspired BDD Test Framework for Perl 6 +
-+------------------------------------------------------------------------------+
-
-~ Note ~
-
-This hasn't really been worked on since early 2010, and is quite obsolete
-and broken in modern versions of Rakudo Perl 6 (it last worked in the
-'alpha' branch, which predates 'ng', which predates 'nom'. Yeah, it's old.)
-
-I am planning a full scale rewrite of this library, stay tuned.
-
-~ Introduction ~
-
-PSpec was started as a fun experiment to see if I could make a library
-in Perl 6 that would allow me to create a test that looked similar to
-the one on the front page of the RSpec website.
-
-After making one, I turned my attention to the example on the Cucumber
-website, and added a simple story handler to the library.
-
-The story handler has been separated out as it's own library (which
-still depends on PSpec) called Pickle.
-
-Pickle currently handles simple stories, backgrounds, scenario outlines,
-tables, and multiline text.
-
-There is also support for chaining rules. If you want to call another rule
-from a step definition, use: declare "test for $rule";
-
-In addition to the basic testing stuff, the PSpec project also includes some
-utility functionality, mostly separated out into other libraries, such
-as the Times library which provides a 'times' operator.
-
-Pickle also has a tag parser method for Str objects (called 'replace-tags').
-Pass it a hash, and it will replace any instance of <key> with the
-mapped value. Useful for templates (and Scenario Outlines.)
-
-There is an object called Table which is used by Pickle to provide
-Cucumber-like Tables. It allows multiple "views" of the data from the
-table.
-
-Oh, and for no particular reason whatsoever, there is a reverse polish
-calculator class called Calculator also included, it's used in a few of
-the examples and tests.
-
-~ Usage ~
-
-From the main directory, you can run the individual specification tests
-by doing:
-
- $ perl6 ./examples/name-of-test.t
-
-If you want to run all of the specification tests, you can also use the
-'prove' utility as provided with Perl 5.
-
- $ prove -v --perl perl6 -r ./t/
-
-Oh, and now the story based tests are quiet by default. If you want
-them to display their story (as TAP comments) then call the test
-with the -v flag. For example:
-
- $ perl6 ./t/pspec-story.t -v
-
-The test scripts in the 'examples' folder have intentional "failing" tests
-to show how the output from such tests would appear.
-
-The tests in the 't' folder on the other hand are used to test PSpec itself
-and should pass. If they don't, there is a problem.
-
-~ Documentation ~
-
-This README file is it for now.
-
-If you want to enable extra verbosity, just keep adding v characters to
-the flag. So -vv is double verbosity, -vvv is triple, etc.
-
-Currently enabling double verbosity will allow you to see the statements
-being run by Scenario Outlines for each Example.
-
-I'm not that great at writing documentation, see the code, it's pretty
-self explanitory. I will add Pod (Perl 6 POD) documentation to the PSpec
-library soon, I promise!
-
-For now, please read the original article that I wrote introducing the
-PSpec library:
-
- http://huri.net/articles/2010/01/pspec.html
-
-~ Credits ~
-
-Well, I must send cudos to the original authors of RSpec and Cucumber,
-without them, this wouldn't exist.
-
-Also, a big cheers to Carl Masak, who is always friendly and helpful!
-And a call-out to Larry Wall whose help on the #perl6 channel has been
-greatly appreciated! I guess I should also thank him for creating Perl :-)
-
-Since writing the original version of this Credits section, I've received
-a lot of help and feedback from many people on the #perl6 channel. Thanks
-to the whole Perl 6 community for being awesome!
-
-~ License ~
-
-This work is licensed under the Artistic License 2.0, the same license that
-Perl 6 itself uses. Please see the LICENSE.txt for the full text of the
-license.
-
-~ Summary ~
-
-Well, that's all folks. Have fun!
-
View
54 examples/bowling.t
@@ -1,54 +0,0 @@
-#!/usr/local/bin/perl6
-
-use v6;
-
-BEGIN { @*INC.unshift('lib'); }
-
-use PSpec;
-use Bowling;
-use Times;
-
-## See PSpec for more information on 'describe', 'times' and 'should-be'.
-
-sub bowl ($times, $hit) {
- my $bowling = Bowling.new;
- $times times { $bowling.hit($hit); }
- return $bowling;
-}
-
-describe Bowling, "score", [
- ## The first one is a direct copy from the RSpec front page.
- 'returns 0 for all gutter game' => {
- my $bowling = Bowling.new;
- 20 times { $bowling.hit(0) }
- $bowling.score should-be 0;
- },
- ## The following two use a subroutine to make it shorter.
- 'returns 1 for a single pin' => {
- bowl(1, 1).score should-be 1;
- },
- ## And yes, this one has an intentional typo in the desired value.
- 'returns 200 for 20 strikes' => {
- bowl(20, 10).score should-be 201;
- },
- ## Now we want to test something a bit more complicated.
- 'the return is greater than 20 if 2 hits 11 times' => {
- bowl(11,2).score should-be ('> 20' => { $^a > 20 });
- },
- ## And now, the same thing, but with an intentional typo.
- 'typo return greater than 30 if 2 hits 11 times' => {
- bowl(11,2).score should-be ('> 30' => { $^a > 30 });
- },
- ## A new comparison operator that is even simpler than the Pair array.
- 'testing the new operator' => {
- bowl(11,2).score should-be ( '>', 30 );
- },
- # And if you don't care about the 'got:/expected:' stuff,
- # just pass a regular old test on as the closure.
- # Of course, the benefits of the 'got/expected' is why the
- # should-be operator exists, but anyway...
- 'a regular perl test, not using should-be' => {
- bowl(11,2).score == 22;
- },
-];
-
View
49 examples/calc.t
@@ -1,49 +0,0 @@
-#!/usr/local/bin/perl6
-
-use v6;
-
-BEGIN { @*INC.unshift('lib'); }
-
-use Pickle;
-use Calculator;
-
-our $calculator = Calculator.new;
-
-sub MAIN ( $verbose=0 ) {
-
-handle-story(
- lines("examples/stories/calculator.story"),
- :verbose($verbose),
- -> $line {
- given $line {
-
- ## Every Scenario, we should start with a clear calculator.
- when / Scenario\: / {
- #diag "====> Clearing Calculator";
- $calculator.clear;
- }
-
- ## A rule for entering the numbers.
- when /:s have entered (.*?) into the calculator/ {
- my $num = +$0;
- $calculator.push: $num;
- #diag "====> Entered $num in calculator";
- }
-
- ## And one for pressing the operation buttons.
- when /:s press (.*)/ {
- #diag "====> Pressing $0 on calculator";
- $calculator."$0"();
- }
-
- ## Finally, a way to get back the results.
- when /:s the result should be (\d+) on the screen/ {
- assert $calculator.total should-be +$0;
- }
-
- }
- }
-);
-
-}
-
View
86 examples/stories/calculator.story
@@ -1,86 +0,0 @@
-Feature: Addition
- In order to avoid silly mistakes
- As a math idiot
- I want to be told the sum of two numbers
-
- Scenario: Add two numbers
- Given I have entered 50 into the calculator
- And I have entered 70 into the calculator
- When I press add
- Then the result should be 120 on the screen
-
- Scenario: Add five numbers, with implicit add
- Given I have entered 10 into the calculator
- And I have entered 20 into the calculator
- And I have entered 30 into the calculator
- And I have entered 40 into the calculator
- And I have entered 50 into the calculator
- Then the result should be 150 on the screen
-
-Feature: Subtraction
- In order to do our bookkeeping
- As a total moron
- I want to be told the difference between two numbers
-
- Scenario: Subtract two numbers
- Given I have entered 50 into the calculator
- And I have entered 20 into the calculator
- When I press subtract
- Then the result should be 30 on the screen
-
-Feature: Multiplication
- In order to show this is up with the times
- As a calculator of four functions
- I want to see it multiply
-
- Scenario: Multiply two numbers
- Given I have entered 20 into the calculator
- And I have entered 5 into the calculator
- When I press multiply
- Then the result should be 100 on the screen
-
-Feature: Division
- In order to show how modular this is, it must be divided
- As a purveyor of bad puns
- I want to see the quotient
-
- Scenario: Divide two numbers
- Given I have entered 100 into the calculator
- And I have entered 4 into the calculator
- When I press divide
- Then the result should be 25 on the screen
-
- Scenario: Intentionally broken test
- Given I have entered 100 into the calculator
- And I have entered 25 into the calculator
- When I press divide
- Then the result should be 5 on the screen
-
-Feature: Common scenarios with a background
- In order to show how backgrounds works
- As a developer of this lovely library
- I want to see a set of scenarios with a common background
-
- Background:
- Given I have entered 100 into the calculator
-
- Scenario: Add 50
- Given I have entered 50 into the calculator
- When I press add
- Then the result should be 150 on the screen
-
- Scenario: Subtract 25
- Given I have entered 25 into the calculator
- When I press subtract
- Then the result should be 75 on the screen
-
- Scenario: Multiply by 5
- Given I have entered 5 into the calculator
- When I press multiply
- Then the result should be 500 on the screen
-
- Scenario: Divide by 2
- Given I have entered 2 into the calculator
- When I press divide
- Then the result should be 50 on the screen
-
View
10 lib/Bowling.pm
@@ -1,10 +0,0 @@
-#!/usr/local/bin/perl6
-
-class Bowling {
- has $.score is rw = 0;
-
- method hit ($pins) {
- $.score += $pins;
- }
-}
-
View
51 lib/Calculator.pm
@@ -1,51 +0,0 @@
-## A boring RPN calculator class.
-
-class Calculator {
- has @.stack;
-
- method add {
- given @.stack {
- .push( .pop + .pop );
- }
- }
-
- method subtract {
- given @.stack {
- .push( .pop R- .pop );
- }
- }
-
- method multiply {
- given @.stack {
- .push( .pop * .pop );
- }
- }
-
- method divide {
- given @.stack {
- .push( .pop R/ .pop );
- }
- }
-
- method push (Num $number) {
- @.stack.push($number);
- }
-
- method total () {
- [+] @.stack;
- }
-
- method first (Int $i) {
- @.stack[$i];
- }
-
- method last (Int $i=1) {
- @.stack[*-$i];
- }
-
- method clear {
- @.stack.splice;
- }
-
-}
-
View
153 lib/PSpec.pm
@@ -1,153 +0,0 @@
-# -----------------------------------------------------------------------------
-# PSpec: RSpec + Cucumber for Perl 6
-# See: http://huri.net/tech/pspec
-# or: http://github.org/supernovus/PSpec
-# -----------------------------------------------------------------------------
-
-module PSpec:ver<3.0.1>:auth<http://huri.net/>;
-
-our $tests_run = 0;
-our $failed_tests = 0;
-our $die_on_fail = 0;
-our $test_plan = 0;
-
-# New infix operator: should-be
-# Performs a test, and if it fails, lists the value that was returned,
-# as well as what was expected. Example:
-#
-# $one should-be 1;
-#
-
-multi sub infix:<should-be> (Any $a, Any $b) is export(:DEFAULT) {
- should-be( $a ~~ $b, $a, $b );
-}
-
-multi sub infix:<should-be> (Num $a, Num $b) is export(:DEFAULT) {
- should-be( $a == $b, $a, $b );
-}
-
-multi sub infix:<should-be> (Str $a, Str $b) is export(:DEFAULT) {
- should-be( $a eq $b, $a, $b );
-}
-
-# Infix operator: should-be (Any, Pair)
-# A special version of the should-be operator which allows you to
-# specify a tag as the 'expected' as well as a more complex comparision
-# closure. Example:
-#
-# $five should-be ( '> 4' => { $^a > 4 } );
-#
-
-multi sub infix:<should-be> (Any $a, Pair $b) is export(:DEFAULT) {
- my $code = $b.value;
- my $result = $code($a);
- should-be($result, $a, $b.key);
-}
-
-# A special version of the should-be operator made specifically for
-# comparison operators such as '>', '<', 'gt', etc. Uses a simpler
-# syntax than the above operator. Example:
-#
-# $five should-be ( '>', '4' );
-#
-
-multi sub infix:<should-be> (Any $a, @array) is export(:DEFAULT) {
- my $expected = @array.join(' ');
- my $result = eval("$a $expected");
- should-be($result, $a, $expected);
-}
-
-# Public function: should-be (Boolean, $got, $expected)
-# The function which powers all of the above infix operators.
-# Normally, you'd want to use the infix operators for better readability
-# but if you want, you can run the function version directly. Example:
-#
-# should-be $five > 4, $five, '> 4';
-#
-# This is not very pretty, but does allow for the most flexibility.
-
-sub should-be (Bool $result, Any $got, Any $expected) is export(:DEFAULT) {
- if !$result {
- diag '-' x 76;
- diag "expected: $expected";
- diag "got: $got";
- }
- return $result;
-}
-
-# Public function: plan ($number)
-# Adds the specified number to the planned number of tests.
-# By default the test suites have no plan, so this is optional.
-
-sub plan ($count=1) is export(:DEFAULT) { $test_plan += $count; }
-
-# API function: diag ($message)
-# Prints a message prefixed with '# ' so-as to make it suitable
-# for TAP formatted output.
-
-sub diag ($message) is export(:DEFAULT) { say "# " ~$message; }
-
-# Public function: die_on_fail (Bool)
-# If called as die_on_fail; it will set the test set to bail out if
-# any individual test fails. You can disable this feature again
-# by calling die_on_fail(False);
-
-sub die_on_fail ($fail=1) is export(:DEFAULT) {
- $die_on_fail = $fail;
-}
-
-# API function: ok ($boolean, $description)
-# Provides the Test::Simple like 'ok()' functionality.
-# Outputs in TAP format (does not support nested TAP yet.)
-
-sub ok ($cond, $desc) is export(:ALL) {
- $tests_run++;
- unless $cond {
- print "not ";
- $failed_tests++;
- }
- say "ok ", $tests_run, " - ", $desc;
- if !$cond && $die_on_fail {
- die "Test failed. Stopping test";
- }
- return $cond;
-}
-
-# Public function: describe ($class_name, $method_name, @tests)
-# Implements a describe statement inspired by the one from RSpec.
-# The @tests array must contain Pair objects, where the key is the
-# name of the test, and the value is a closure containing the actual
-# test to perform. As an example:
-#
-# describe "PSpec", "times", [
-# 'operator works' => {
-# my $value = 0;
-# 20 times { $value++ }
-# $value should-be 20;
-# },
-# ];
-#
-
-sub describe ($class, $name, @tests) is export(:DEFAULT) {
- for @tests -> $pair {
- my $sub = $pair.value;
- my $value = $sub();
- ok $value, "$class.$name: {$pair.key}";
- }
-}
-
-END {
- if !$test_plan {
- $test_plan = $tests_run;
- }
- say "1..$test_plan"; ## Yes, we're backwards here.
- if $test_plan != $tests_run {
- diag "You planned $test_plan tests, but only ran $tests_run";
- }
- if $failed_tests {
- diag "Well, $failed_tests tests out of $tests_run failed!";
- }
-}
-
-## End of library
-
View
91 lib/PSpec.pm6
@@ -0,0 +1,91 @@
+use v6;
+use Test;
+
+module PSpec:ver<4.0.0>:auth<http://huri.net/>;
+
+## Perform a block of code x number of times.
+multi sub infix:<times> (Int $num, &closure) is export
+{
+ for ^$num { closure() }
+}
+
+## Same thing, just the other way around.
+sub infix:<xxx> (&closure, Int $num) is export
+{
+ $num times &closure;
+}
+
+## Returns the output of a test to describe.
+sub infix:<should> ($got, $want) is export
+{
+ if ($want ~~ Callable)
+ {
+ return $want($got);
+ }
+ else
+ {
+ return $got, $want;
+ }
+}
+
+## eq, the most basic test possible. The same as passing the raw value.
+sub eq ($val) is export
+{
+ return $val;
+}
+
+## gt, is a value greater than?
+multi sub gt (Numeric $want) is export
+{
+ -> $got
+ {
+ $got > $want;
+ }
+}
+
+## lt, is a value lesser than?
+multi sub lt (Numeric $want) is export
+{
+ -> $got
+ {
+ $got < $want;
+ }
+}
+
+# Public function: describe ($class_name, $method_name, @tests)
+# Implements a describe statement inspired by the one from RSpec.
+# The @tests array must contain Pair objects, where the key is the
+# name of the test, and the value is a closure containing the actual
+# test to perform. The output must be sent by the 'should' operator.
+#
+# describe "PSpec", "times", [
+# 'operator works' => {
+# my $value = 0;
+# 20 times { $value++ }
+# return $value, 20;
+# },
+# ];
+#
+
+sub describe ($class, $name, @tests) is export {
+ for @tests -> $pair {
+ my $sub = $pair.value;
+ my @return = $sub();
+ my $test = "$class.$name: {$pair.key}";
+ if @return.elems == 1
+ {
+ ok @return[0], $test;
+ }
+ elsif @return.elems == 2
+ {
+ is @return[0], @return[1], $test;
+ }
+ else
+ {
+ die "invalid test paramters";
+ }
+ }
+}
+
+## End of library
+
View
253 lib/Pickle.pm
@@ -1,253 +0,0 @@
-use v6;
-
-#use PSpec :ALL;
-use PSpec;
-
-use MONKEY_TYPING;
-
-## A tag replacement parser for Str. Pass it a hash, and optionally
-# a prefix and suffix and it will replace any instances of the keys
-# with the mapped values. Useful for templates!
-# NOTE: This method MODIFIES the String object that calls it, use carefully!
-
-augment class Str {
- method replace-tags (%tags, $prefix='<', $suffix='>') {
- for %tags.kv -> $key, $value {
- self.=subst("$prefix$key$suffix", $value);
- }
- return self;
- }
-}
-
-use Table;
-
-module Pickle:ver<3.0.0>:auth<http://huri.net/>;
-
-# This module needs to be documented properly.
-# It's documentation currently sucks.
-# I also plan on writing some Pod for this at some point.
-
-sub check-verbose is export(:DEFAULT) {
- my $verbose = 0;
- if @*ARGS[0] ~~ / ^ \- (v+) / {
- $verbose = ~$0.chars;
- }
- return $verbose;
-}
-
-our $feature_name = '';
-our $scenario_name = '';
-our @call_queue; ## Now we add statements in handlers.
-
-sub declare (Str $line) is export(:DEFAULT) {
- @call_queue.push: $line;
-}
-
-sub split-def ($line) {
- my @def = $line.split(/:s \| /);
- @def.pop; ## Kill the last empty field.
- @def.shift; ## Kill the first empty field.
- return @def;
-}
-
-sub build-fields ($line, @fields) {
- my @temp_fields = split-def $line;
- return @temp_fields.hashMap(@fields);
-}
-
-sub lines-handler (@lines, @handlers) {
- for @lines -> $line {
- line-handler $line, @handlers;
- }
-}
-
-sub line-handler ($line, @handlers) {
- for @handlers -> $handle {
- $handle($line);
- }
-}
-
-## The public story handler function.
-# Calls the private method.
-
-sub handle-story (
- @story,
- :$verbose=check-verbose(),
- Code *@handlers
-) is export(:DEFAULT) {
- story-handler(@story, :verbose($verbose), @handlers);
-}
-
-## A quick way to check verbosity levels.
-
-sub chain-handler (@story, @handlers, $verbose, $min) {
- my $inner_verbose = 0;
- if ($verbose > $min) { $inner_verbose = $verbose; }
- story-handler(@story, :verbose($inner_verbose), @handlers);
-}
-
-## The real story handler.
-sub story-handler (@story, @handlers, :$verbose=0 ) {
-
- ## For backgrounds
- my $in_background = 0;
- my @background;
-
- ## For tables
- my $previous_line = '';
- my $table = Table.new;
-
- ## For multiline text
- my $multiline = '';
- my @multiline;
- my $line_length = 0;
-
- ## For outlines
- my $outline_name = '';
- my $in_outline = 0;
- my @outline_text;
- my $in_examples = 0;
- my @example_fields;
-
- for @story -> $line {
- if $verbose { diag $line; }
- my $follow_dispatch = 1;
-
- given $line {
- when Table { } # We skip tables. Handle elsewhere.
- when Pair { } # We skip pairs. Handle elsewhere.
- if $in_examples {
- when not /:s ^ \| / {
- $in_examples = 0;
- }
- }
- elsif !$in_outline && !$in_background {
- if $table.key {
- when not /:s ^ \| / {
- line-handler $table, @handlers;
- $table.clear;
- continue;
- }
- }
- if $multiline {
- when /:s ^ \"\"\" $/ {
- ## We've reached the end of the text.
- my $linePair = $multiline => @multiline;
- line-handler $linePair, @handlers;
- @multiline.splice;
- $multiline = '';
- $line_length = 0;
- }
- when not /:s ^ \"\"\" $/ {
- $line.=substr($line_length);
- @multiline.push: $line;
- $follow_dispatch = 0;
- }
- }
- else {
- when /^(<.ws>)\"\"\"<.ws>$/ {
- $line_length = ~$0.chars;
- $follow_dispatch = 0;
- $multiline = $previous_line;
- }
- }
- when /:s ^ \| / {
- $follow_dispatch = 0;
- $table.key = $previous_line if !$table.key;
- my @fields = split-def $line;
- $table.push: \@fields;
- }
- }
- when /:s Feature\: (.*)/ {
- @background.splice; ## Kill existing backgrounds.
- $feature_name = $0;
- $follow_dispatch = 1;
- }
- when /:s Scenario Outline\: (.*)/ {
- @outline_text.splice; ## Make sure this is empty.
- $outline_name = $0;
- $in_outline = 1;
- }
- if ($in_outline) {
- when /:s Examples\:/ {
- @example_fields.splice; ## Make sure this is empty.
- $in_outline = 0;
- $in_examples = 1;
- }
- }
- when /:s Scenario\: (.*)/ {
- $scenario_name = $0;
- $in_background = 0;
- if @background {
- $follow_dispatch = 0; ## No dispatch.
- line-handler $line, @handlers; ## Run this now.
- ## Then run the rest:
- chain-handler @background, @handlers, $verbose, 2;
- }
- }
- when /:s Background\:/ {
- $in_background = 1;
- }
- }
-
- if $in_outline {
- @outline_text.push: $line;
- $follow_dispatch = 0;
- }
-
- if $in_examples && $line ~~ /:s ^ \| / {
- $follow_dispatch = 0;
- if @example_fields {
- my %example = build-fields($line, @example_fields);
- $scenario_name = $outline_name ~ ' # ' ~ $in_examples++;
- line-handler "Subtest: $scenario_name", @handlers;
- my @outline = @outline_text;
- @outline>>.replace-tags(%example);
- chain-handler @outline, @handlers, $verbose, 1;
- }
- else {
- ## Get rid of the first line, it's the Outline statement.
- @outline_text.shift;
- @example_fields = split-def $line;
- }
- }
-
- if $in_background {
- if $line !~~ /:s Background\: / {
- @background.push: $line;
- }
- $follow_dispatch = 0;
- }
-
- if $follow_dispatch {
- line-handler $line, @handlers;
- }
-
- $previous_line = $line;
-
- ## Next up, run anything in the call queue.
- if @call_queue {
- my @chain_story = @call_queue;
- @call_queue.splice;
- chain-handler @chain_story, @handlers, $verbose, 1;
- }
-
- }
-}
-
-sub assert ($condition) is export(:DEFAULT) {
- return ok $condition, "$feature_name: $scenario_name";
-}
-
-## Use for handlers that need to support tables and multiline text.
-
-sub matching ($line) is export(:DEFAULT) {
- my $matcher = $line;
- if $line ~~ Table | Pair {
- $matcher = $line.key;
- }
- return $matcher;
-}
-
-## End of Library
-
View
35 lib/Story.pm
@@ -1,35 +0,0 @@
-use Times;
-use PSpec;
-
-module Story;
-
-my $value;
-
-our sub default-handler () {
- return -> $line {
- given $line {
-
- ## A rule for entering the numbers.
- when /:s initial value of (\d+)/ {
- $value = +$0;
- }
-
- ## One for incrementing.
- when /:s increment (\d+) times/ {
- +$0.Int times { $value++ }
- }
-
- ## One for decrementing.
- when /:s decrement (\d+) times/ {
- +$0.Int times { $value-- }
- }
-
- ## Finally, a way to get back the results.
- when /:s value should be (\d+)/ {
- assert $value should-be +$0;
- }
-
- }
- }
-}
-
View
59 lib/Table.pm
@@ -1,59 +0,0 @@
-## A Cucumber-like Table class, and modifications to Array.
-
-use MONKEY_TYPING;
-
-augment class Array {
- method hashMap (@fields) {
- my %fields;
- for @fields Z self -> $field, $value {
- if $field {
- %fields{$field} = $value;
- }
- }
- return %fields;
- }
-}
-
-class Table is Array {
- has $.key is rw; ## The name of the table.
- has @!hashes; ## An array of hashes.
- has @!flat; ## A flat version of the array.
-
- method hashes ($rebuild?) {
- if $rebuild {
- @!hashes.splice;
- }
- if !@!hashes {
- my @table = self;
- my $fields = @table.shift;
- for @table -> $row {
- if $row !~~ Array { die "Row was not an array"; }
- my %hash = $row.hashMap($fields);
- @!hashes.push: {%hash};
- }
- }
- return @!hashes;
- }
-
- method flatten ($rebuild?) {
- if $rebuild {
- @!flat.splice;
- }
- if !@!flat {
- my @table = self;
- for @table -> $row {
- @!flat.push: @($row);
- }
- }
- return @!flat;
- }
-
- method clear {
- $.key = '';
- self.splice;
- @!hashes.splice;
- @!flat.splice;
- }
-
-}
-
View
23 lib/Times.pm
@@ -1,23 +0,0 @@
-
-module Times:ver<3.0.0>:auth<http://huri.net/>;
-
-# New infix operator: times
-# Specify a number, and a block of code. The block of code will be
-# executed the specified number of times.
-# Example: 20 times { say "hello" }
-
-multi sub infix:<times> (Int $num, &closure) is export(:DEFAULT) {
- for ^$num { closure() }
-}
-
-# Overloaded infix operator: x
-# Specify a block of code, x, then an integer.
-# It calls $integer times { block of code }.
-# Example: { say "hello" } x 20
-
-multi sub infix:<x> (&closure, Int $num) is export(:ALL) {
- $num times &closure;
-}
-
-## End of Library
-
View
25 t/01-times.t
@@ -1,25 +0,0 @@
-#!/usr/local/bin/perl6
-
-use v6;
-
-BEGIN { @*INC.unshift('lib'); }
-
-use PSpec;
-use Times;
-#use Times :ALL;
-
-describe "PSpec", "times", [
- 'operator works' => {
- my $value = 0;
- 20 times { $value++ }
- $value should-be 20;
- },
- "overloaded x operator" => {
- my $value = 0;
- { $value++ } x 30;
- $value should-be 30;
- },
-];
-
-## End of tests
-
View
45 t/basic.t
@@ -0,0 +1,45 @@
+#!/usr/local/bin/perl6
+
+use v6;
+
+BEGIN { @*INC.push('lib'); }
+
+use Test;
+use PSpec;
+
+plan 5;
+
+describe "PSpec", "operators",
+[
+ 'eq' =>
+ {
+ 20 should eq(20);
+ },
+ 'gt' =>
+ {
+ 20 should gt(15);
+ },
+ 'lt' =>
+ {
+ 20 should lt(25);
+ }
+];
+
+describe "PSpec", "helpers",
+[
+ 'times' =>
+ {
+ my $value = 0;
+ 20 times { $value++ }
+ $value, 20;
+ },
+ 'xxx' =>
+ {
+ my $value = 50;
+ { $value--; } xxx 25;
+ $value, 25;
+ }
+];
+
+## End of tests
+
View
39 t/stories/basic.story
@@ -1,39 +0,0 @@
-Feature: Story Handling
- In order to provide Cucumber like functionality to PSpec
- As a computer programmer
- I want to be able to read plain text stories and parse them as tests
-
- Scenario: Increment 20 times
- Given an initial value of 0
- When I increment 20 times
- Then the value should be 20
-
- Scenario: Decrement from 50, 20 times
- Given an initial value of 50
- When I decrement 20 times
- Then the value should be 30
-
- Scenario: Mixed increment and decrement
- Given an initial value of 100
- When I decrement 60 times
- And I increment 30 times
- Then the value should be 70
-
-Feature: Story Backgrounds
- In order to provide the Background functionality from Cucumber
- As a computer programmer
- I want to be able to have a section that will be parsed for every scenario
-
- Background:
- Given an initial value of 100
- When I decrement 50 times
-
- Scenario: Add 25
- When I increment 25 times
- Then the value should be 75
-
- Scenario: Subtract 25
- When I decrement 25 times
- Then the value should be 25
-
-
View
17 t/stories/chain.story
@@ -1,17 +0,0 @@
-Feature: Story Rule Chaining
- In order to provide Cucumber's ability to chain steps
- As a computer programmer
- I want to be able to have one rule call another rule.
-
- Scenario: Increment 20 by 10
- Given we increment 20 by 10
- Then the value should be 30
-
- Scenario: Decrement 50 by 20
- Given we decrement 50 by 20
- Then the value should be 30
-
- Scenario: Increment and decrement together
- Given we take 100 75 steps higher and 125 steps lower
- Then the value should be 50
-
View
21 t/stories/multiline.story
@@ -1,21 +0,0 @@
-Feature: Tables
- In order to provide the multiline text from Cucumber in PSpec
- As a computer programmer
- I want to be able to use Python like """ quotes
-
- Scenario: Flipping a single line
- Given the value is: Ooga booga
- Then the result is: agoob agoO
-
- Scenario: Flipping a multi line
- Given the value is:
- """
- Hello World
- Goodbye Universe
- """
- Then the result is:
- """
- dlroW olleH
- esrevinU eybdooG
- """
-
View
19 t/stories/outline.story
@@ -1,19 +0,0 @@
-Feature: Story Outlines
- In order to provide the Scenario Outline functionality from Cucumber
- As a computer programmer
- I want to be able to have a template and a table of data to work with
-
- Scenario Outline: Templates
- Given an initial value of <init>
- When I <action> <count> times
- Then the value should be <value>
-
- Examples:
- | init | action | count | value |
- | 10 | increment | 10 | 20 |
- | 30 | decrement | 20 | 10 |
- | 50 | decrement | 25 | 25 |
- | 75 | decrement | 25 | 50 |
- | 100 | increment | 50 | 150 |
-
-
View
36 t/stories/table.story
@@ -1,36 +0,0 @@
-Feature: Tables
- In order to provide the Tables from Cucumber in PSpec
- As a computer programmer
- I want to be able to supply various forms of tables
-
- Scenario: A list of hashes
- Given an initial value of 0
- When we perform the operations on the following table:
- | number | operation |
- | 10 | add |
- | 40 | add |
- | 20 | subtract |
- | 2 | multiply |
- | 4 | divide |
- Then the result should be 15
-
- Scenario: Two flat lists
- Given the following numbers:
- | 10 |
- | 40 |
- | 20 |
- | 4 |
- When we perform the following operations:
- | add |
- | subtract |
- | multiply |
- Then the result should be 160
-
- Scenario: Subtract columns and add rows
- Given the following table:
- | 100 | 20 | 5 |
- | 30 | 10 | 5 |
- | 10 | 5 | 0 |
- Then the result should be 95
-
-
View
16 t/story-basic.t
@@ -1,16 +0,0 @@
-#!/usr/local/bin/perl6
-
-use v6;
-
-BEGIN { @*INC.unshift('lib'); }
-
-use Pickle;
-use Story;
-
-handle-story(
- lines("t/stories/basic.story"),
- Story::default-handler(),
-);
-
-## End of tests
-
View
29 t/story-chain.t
@@ -1,29 +0,0 @@
-#!/usr/local/bin/perl6
-
-use v6;
-
-BEGIN { @*INC.unshift('lib'); }
-
-use Pickle;
-use Story;
-
-handle-story(
- lines("t/stories/chain.story"),
- Story::default-handler(),
- -> $line {
- given $line {
- when /:s \w+ (increment|decrement) (\d+) by (\d+) / {
- declare "initial value of $1";
- declare "$0 $2 times";
- }
- when /:s take (\d+) (\d+) steps higher and (\d+) steps lower / {
- declare "initial value of $0";
- declare "increment $1 times";
- declare "decrement $2 times";
- }
- }
- },
-);
-
-## End of tests
-
View
46 t/story-multiline.t
@@ -1,46 +0,0 @@
-#!/usr/local/bin/perl6
-
-use v6;
-
-BEGIN { @*INC.unshift('lib'); }
-
-use Pickle;
-
-my $found = '';
-my @found;
-
-handle-story(
- lines("t/stories/multiline.story"),
- -> $line {
- given matching $line {
- if $line ~~ Pair {
- when /:s value is\: $/ {
- #diag "Found a multiline value:";
- #diag $line.value.join("\n# ");
- @found = @($line.value);
- }
- when /:s result is\: $/ {
- #diag "Found a multiline result:";
- #diag $line.value.join("\n# ");
- my @flipped = @found>>.flip;
- my $result = @flipped.join("\n");
- my $expected = $line.value.join("\n");
- assert $result should-be $expected;
- }
- }
- when /:s value is\: (.+) $/ {
- #diag "Found a single value:";
- #diag "$0";
- $found = ~$0;
- }
- when /:s result is\: (.+) $/ {
- #diag "Found a singe result:";
- #diag "$0";
- assert $found.flip should-be ~$0;
- }
- }
- },
-);
-
-## End of tests
-
View
16 t/story-outline.t
@@ -1,16 +0,0 @@
-#!/usr/local/bin/perl6
-
-use v6;
-
-BEGIN { @*INC.unshift('lib'); }
-
-use Pickle;
-use Story;
-
-handle-story(
- lines("t/stories/outline.story"),
- Story::default-handler(),
-);
-
-## End of tests
-
View
70 t/story-table.t
@@ -1,70 +0,0 @@
-#!/usr/local/bin/perl6
-
-use v6;
-
-BEGIN { @*INC.unshift('lib'); }
-
-use Pickle;
-use Calculator;
-
-our $calculator = Calculator.new;
-
-handle-story(
- lines("t/stories/table.story"),
- -> $line {
- given matching $line {
- if $line ~~ Table {
- when /:s operations on the following table/ {
- my @ops = $line.hashes;
- #diag "++ " ~ @ops.perl;
- for @ops -> $op {
- #diag "-- " ~ $op.perl;
- $calculator.push: +$op<number>;
- $calculator."{$op<operation>}";
- }
- }
- when /:s the following (numbers|operations)/ {
- my $what = $0;
- my @flat = $line.flatten;
- #diag @flat.perl;
- for @flat -> $flat {
- if !$flat { next; }
- if $what eq 'numbers' {
- #diag "++ Pushing $flat";
- $calculator.push: +$flat;
- }
- else {
- #diag "-- Performing $flat";
- $calculator."$flat";
- #diag "Value is "~ $calculator.last;
- }
- }
- }
- when /:s the following table/ {
- for @($line) -> $table {
- #diag $table.perl;
- my $number = $table.shift;
- for @($table) -> $sub {
- #diag "--# $number - $sub";
- $number -= $sub;
- }
- #diag "==# $number";
- $calculator.push: +$number;
- }
- }
- }
- when / Scenario\: / {
- $calculator.clear;
- }
- when /:s the result should be (\d+)/ {
- assert $calculator.total should-be +$0;
- }
- when /:s an initial value of (\d+)/ {
- $calculator.push: +$0;
- }
- }
- },
-);
-
-## End of tests
-
Please sign in to comment.
Something went wrong with that request. Please try again.