pax_global_header00006660000000000000000000000064147544705700014527gustar00rootroot0000000000000052 comment=c467c659b2c5b7029e20909331e072d7301af1d5 emacs-buttercup-1.37/000077500000000000000000000000001475447057000145645ustar00rootroot00000000000000emacs-buttercup-1.37/.bumpversion.cfg000066400000000000000000000002251475447057000176730ustar00rootroot00000000000000[bumpversion] current_version = 1.37 parse = (?P\d+)\.(?P.*) serialize = {major}.{minor} files = buttercup.el commit = True tag = True emacs-buttercup-1.37/.elpaignore000066400000000000000000000001131475447057000167050ustar00rootroot00000000000000.bumpversion.cfg .elpaignore .github Makefile README.md docs scripts tests emacs-buttercup-1.37/.github/000077500000000000000000000000001475447057000161245ustar00rootroot00000000000000emacs-buttercup-1.37/.github/workflows/000077500000000000000000000000001475447057000201615ustar00rootroot00000000000000emacs-buttercup-1.37/.github/workflows/test.yml000066400000000000000000000020521475447057000216620ustar00rootroot00000000000000name: Build and test permissions: actions: read checks: read contents: read deployments: none id-token: none issues: read discussions: none packages: none pages: none pull-requests: read repository-projects: read security-events: read statuses: read on: pull_request: push: branches: - 'master' - '*' paths-ignore: - 'bin/*' - 'docs/images/*' - 'docs/running-tests.md' - 'scripts' jobs: build: name: Build and test runs-on: ubuntu-latest strategy: matrix: emacs_version: - 24.4 - 24.5 - 25.1 - 25.2 - 25.3 - 26.1 - 26.2 - 26.3 - 27.1 - 28.1 - 28.2 - 29.1 - 29.2 - 29.3 - 29.4 - release-snapshot - snapshot steps: - uses: purcell/setup-emacs@master with: version: ${{ matrix.emacs_version }} - uses: actions/checkout@v4 - name: Run tests run: make check emacs-buttercup-1.37/.gitignore000066400000000000000000000001161475447057000165520ustar00rootroot00000000000000*.elc /dist # ELPA-generated files /buttercup-autoloads.el /buttercup-pkg.el emacs-buttercup-1.37/LICENSE000066400000000000000000001045151475447057000155770ustar00rootroot00000000000000 GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The GNU General Public License is a free, copyleft license for software and other kinds of works. The licenses for most software and other practical works are designed to take away your freedom to share and change the works. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change all versions of a program--to make sure it remains free software for all its users. We, the Free Software Foundation, use the GNU General Public License for most of our software; it applies also to any other work released this way by its authors. You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for them if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs, and that you know you can do these things. To protect your rights, we need to prevent others from denying you these rights or asking you to surrender the rights. Therefore, you have certain responsibilities if you distribute copies of the software, or if you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether gratis or for a fee, you must pass on to the recipients the same freedoms that you received. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. Developers that use the GNU GPL protect your rights with two steps: (1) assert copyright on the software, and (2) offer you this License giving you legal permission to copy, distribute and/or modify it. For the developers' and authors' protection, the GPL clearly explains that there is no warranty for this free software. For both users' and authors' sake, the GPL requires that modified versions be marked as changed, so that their problems will not be attributed erroneously to authors of previous versions. Some devices are designed to deny users access to install or run modified versions of the software inside them, although the manufacturer can do so. This is fundamentally incompatible with the aim of protecting users' freedom to change the software. The systematic pattern of such abuse occurs in the area of products for individuals to use, which is precisely where it is most unacceptable. Therefore, we have designed this version of the GPL to prohibit the practice for those products. If such problems arise substantially in other domains, we stand ready to extend this provision to those domains in future versions of the GPL, as needed to protect the freedom of users. Finally, every program is threatened constantly by software patents. States should not allow patents to restrict development and use of software on general-purpose computers, but in those that do, we wish to avoid the special danger that patents applied to a free program could make it effectively proprietary. To prevent this, the GPL assures that patents cannot be used to render the program non-free. The precise terms and conditions for copying, distribution and modification follow. TERMS AND CONDITIONS 0. Definitions. "This License" refers to version 3 of the GNU General Public License. "Copyright" also means copyright-like laws that apply to other kinds of works, such as semiconductor masks. "The Program" refers to any copyrightable work licensed under this License. Each licensee is addressed as "you". "Licensees" and "recipients" may be individuals or organizations. To "modify" a work means to copy from or adapt all or part of the work in a fashion requiring copyright permission, other than the making of an exact copy. The resulting work is called a "modified version" of the earlier work or a work "based on" the earlier work. A "covered work" means either the unmodified Program or a work based on the Program. To "propagate" a work means to do anything with it that, without permission, would make you directly or secondarily liable for infringement under applicable copyright law, except executing it on a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. To "convey" a work means any kind of propagation that enables other parties to make or receive copies. Mere interaction with a user through a computer network, with no transfer of a copy, is not conveying. An interactive user interface displays "Appropriate Legal Notices" to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to the extent that warranties are provided), that licensees may convey the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. 1. Source Code. The "source code" for a work means the preferred form of the work for making modifications to it. "Object code" means any non-source form of a work. A "Standard Interface" means an interface that either is an official standard defined by a recognized standards body, or, in the case of interfaces specified for a particular programming language, one that is widely used among developers working in that language. The "System Libraries" of an executable work include anything, other than the work as a whole, that (a) is included in the normal form of packaging a Major Component, but which is not part of that Major Component, and (b) serves only to enable use of the work with that Major Component, or to implement a Standard Interface for which an implementation is available to the public in source code form. A "Major Component", in this context, means a major essential component (kernel, window system, and so on) of the specific operating system (if any) on which the executable work runs, or a compiler used to produce the work, or an object code interpreter used to run it. The "Corresponding Source" for a work in object code form means all the source code needed to generate, install, and (for an executable work) run the object code and to modify the work, including scripts to control those activities. However, it does not include the work's System Libraries, or general-purpose tools or generally available free programs which are used unmodified in performing those activities but which are not part of the work. For example, Corresponding Source includes interface definition files associated with source files for the work, and the source code for shared libraries and dynamically linked subprograms that the work is specifically designed to require, such as by intimate data communication or control flow between those subprograms and other parts of the work. The Corresponding Source need not include anything that users can regenerate automatically from other parts of the Corresponding Source. The Corresponding Source for a work in source code form is that same work. 2. Basic Permissions. All rights granted under this License are granted for the term of copyright on the Program, and are irrevocable provided the stated conditions are met. This License explicitly affirms your unlimited permission to run the unmodified Program. The output from running a covered work is covered by this License only if the output, given its content, constitutes a covered work. This License acknowledges your rights of fair use or other equivalent, as provided by copyright law. You may make, run and propagate covered works that you do not convey, without conditions so long as your license otherwise remains in force. You may convey covered works to others for the sole purpose of having them make modifications exclusively for you, or provide you with facilities for running those works, provided that you comply with the terms of this License in conveying all material for which you do not control copyright. Those thus making or running the covered works for you must do so exclusively on your behalf, under your direction and control, on terms that prohibit them from making any copies of your copyrighted material outside their relationship with you. Conveying under any other circumstances is permitted solely under the conditions stated below. Sublicensing is not allowed; section 10 makes it unnecessary. 3. Protecting Users' Legal Rights From Anti-Circumvention Law. No covered work shall be deemed part of an effective technological measure under any applicable law fulfilling obligations under article 11 of the WIPO copyright treaty adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention of such measures. When you convey a covered work, you waive any legal power to forbid circumvention of technological measures to the extent such circumvention is effected by exercising rights under this License with respect to the covered work, and you disclaim any intention to limit operation or modification of the work as a means of enforcing, against the work's users, your or third parties' legal rights to forbid circumvention of technological measures. 4. Conveying Verbatim Copies. You may convey verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice; keep intact all notices stating that this License and any non-permissive terms added in accord with section 7 apply to the code; keep intact all notices of the absence of any warranty; and give all recipients a copy of this License along with the Program. You may charge any price or no price for each copy that you convey, and you may offer support or warranty protection for a fee. 5. Conveying Modified Source Versions. You may convey a work based on the Program, or the modifications to produce it from the Program, in the form of source code under the terms of section 4, provided that you also meet all of these conditions: a) The work must carry prominent notices stating that you modified it, and giving a relevant date. b) The work must carry prominent notices stating that it is released under this License and any conditions added under section 7. This requirement modifies the requirement in section 4 to "keep intact all notices". c) You must license the entire work, as a whole, under this License to anyone who comes into possession of a copy. This License will therefore apply, along with any applicable section 7 additional terms, to the whole of the work, and all its parts, regardless of how they are packaged. This License gives no permission to license the work in any other way, but it does not invalidate such permission if you have separately received it. d) If the work has interactive user interfaces, each must display Appropriate Legal Notices; however, if the Program has interactive interfaces that do not display Appropriate Legal Notices, your work need not make them do so. A compilation of a covered work with other separate and independent works, which are not by their nature extensions of the covered work, and which are not combined with it such as to form a larger program, in or on a volume of a storage or distribution medium, is called an "aggregate" if the compilation and its resulting copyright are not used to limit the access or legal rights of the compilation's users beyond what the individual works permit. Inclusion of a covered work in an aggregate does not cause this License to apply to the other parts of the aggregate. 6. Conveying Non-Source Forms. You may convey a covered work in object code form under the terms of sections 4 and 5, provided that you also convey the machine-readable Corresponding Source under the terms of this License, in one of these ways: a) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by the Corresponding Source fixed on a durable physical medium customarily used for software interchange. b) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by a written offer, valid for at least three years and valid for as long as you offer spare parts or customer support for that product model, to give anyone who possesses the object code either (1) a copy of the Corresponding Source for all the software in the product that is covered by this License, on a durable physical medium customarily used for software interchange, for a price no more than your reasonable cost of physically performing this conveying of source, or (2) access to copy the Corresponding Source from a network server at no charge. c) Convey individual copies of the object code with a copy of the written offer to provide the Corresponding Source. This alternative is allowed only occasionally and noncommercially, and only if you received the object code with such an offer, in accord with subsection 6b. d) Convey the object code by offering access from a designated place (gratis or for a charge), and offer equivalent access to the Corresponding Source in the same way through the same place at no further charge. You need not require recipients to copy the Corresponding Source along with the object code. If the place to copy the object code is a network server, the Corresponding Source may be on a different server (operated by you or a third party) that supports equivalent copying facilities, provided you maintain clear directions next to the object code saying where to find the Corresponding Source. Regardless of what server hosts the Corresponding Source, you remain obligated to ensure that it is available for as long as needed to satisfy these requirements. e) Convey the object code using peer-to-peer transmission, provided you inform other peers where the object code and Corresponding Source of the work are being offered to the general public at no charge under subsection 6d. A separable portion of the object code, whose source code is excluded from the Corresponding Source as a System Library, need not be included in conveying the object code work. A "User Product" is either (1) a "consumer product", which means any tangible personal property which is normally used for personal, family, or household purposes, or (2) anything designed or sold for incorporation into a dwelling. In determining whether a product is a consumer product, doubtful cases shall be resolved in favor of coverage. For a particular product received by a particular user, "normally used" refers to a typical or common use of that class of product, regardless of the status of the particular user or of the way in which the particular user actually uses, or expects or is expected to use, the product. A product is a consumer product regardless of whether the product has substantial commercial, industrial or non-consumer uses, unless such uses represent the only significant mode of use of the product. "Installation Information" for a User Product means any methods, procedures, authorization keys, or other information required to install and execute modified versions of a covered work in that User Product from a modified version of its Corresponding Source. The information must suffice to ensure that the continued functioning of the modified object code is in no case prevented or interfered with solely because modification has been made. If you convey an object code work under this section in, or with, or specifically for use in, a User Product, and the conveying occurs as part of a transaction in which the right of possession and use of the User Product is transferred to the recipient in perpetuity or for a fixed term (regardless of how the transaction is characterized), the Corresponding Source conveyed under this section must be accompanied by the Installation Information. But this requirement does not apply if neither you nor any third party retains the ability to install modified object code on the User Product (for example, the work has been installed in ROM). The requirement to provide Installation Information does not include a requirement to continue to provide support service, warranty, or updates for a work that has been modified or installed by the recipient, or for the User Product in which it has been modified or installed. Access to a network may be denied when the modification itself materially and adversely affects the operation of the network or violates the rules and protocols for communication across the network. Corresponding Source conveyed, and Installation Information provided, in accord with this section must be in a format that is publicly documented (and with an implementation available to the public in source code form), and must require no special password or key for unpacking, reading or copying. 7. Additional Terms. "Additional permissions" are terms that supplement the terms of this License by making exceptions from one or more of its conditions. Additional permissions that are applicable to the entire Program shall be treated as though they were included in this License, to the extent that they are valid under applicable law. If additional permissions apply only to part of the Program, that part may be used separately under those permissions, but the entire Program remains governed by this License without regard to the additional permissions. When you convey a copy of a covered work, you may at your option remove any additional permissions from that copy, or from any part of it. (Additional permissions may be written to require their own removal in certain cases when you modify the work.) You may place additional permissions on material, added by you to a covered work, for which you have or can give appropriate copyright permission. Notwithstanding any other provision of this License, for material you add to a covered work, you may (if authorized by the copyright holders of that material) supplement the terms of this License with terms: a) Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or b) Requiring preservation of specified reasonable legal notices or author attributions in that material or in the Appropriate Legal Notices displayed by works containing it; or c) Prohibiting misrepresentation of the origin of that material, or requiring that modified versions of such material be marked in reasonable ways as different from the original version; or d) Limiting the use for publicity purposes of names of licensors or authors of the material; or e) Declining to grant rights under trademark law for use of some trade names, trademarks, or service marks; or f) Requiring indemnification of licensors and authors of that material by anyone who conveys the material (or modified versions of it) with contractual assumptions of liability to the recipient, for any liability that these contractual assumptions directly impose on those licensors and authors. All other non-permissive additional terms are considered "further restrictions" within the meaning of section 10. If the Program as you received it, or any part of it, contains a notice stating that it is governed by this License along with a term that is a further restriction, you may remove that term. If a license document contains a further restriction but permits relicensing or conveying under this License, you may add to a covered work material governed by the terms of that license document, provided that the further restriction does not survive such relicensing or conveying. If you add terms to a covered work in accord with this section, you must place, in the relevant source files, a statement of the additional terms that apply to those files, or a notice indicating where to find the applicable terms. Additional terms, permissive or non-permissive, may be stated in the form of a separately written license, or stated as exceptions; the above requirements apply either way. 8. Termination. You may not propagate or modify a covered work except as expressly provided under this License. Any attempt otherwise to propagate or modify it is void, and will automatically terminate your rights under this License (including any patent licenses granted under the third paragraph of section 11). However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, you do not qualify to receive new licenses for the same material under section 10. 9. Acceptance Not Required for Having Copies. You are not required to accept this License in order to receive or run a copy of the Program. Ancillary propagation of a covered work occurring solely as a consequence of using peer-to-peer transmission to receive a copy likewise does not require acceptance. However, nothing other than this License grants you permission to propagate or modify any covered work. These actions infringe copyright if you do not accept this License. Therefore, by modifying or propagating a covered work, you indicate your acceptance of this License to do so. 10. Automatic Licensing of Downstream Recipients. Each time you convey a covered work, the recipient automatically receives a license from the original licensors, to run, modify and propagate that work, subject to this License. You are not responsible for enforcing compliance by third parties with this License. An "entity transaction" is a transaction transferring control of an organization, or substantially all assets of one, or subdividing an organization, or merging organizations. If propagation of a covered work results from an entity transaction, each party to that transaction who receives a copy of the work also receives whatever licenses to the work the party's predecessor in interest had or could give under the previous paragraph, plus a right to possession of the Corresponding Source of the work from the predecessor in interest, if the predecessor has it or can get it with reasonable efforts. You may not impose any further restrictions on the exercise of the rights granted or affirmed under this License. For example, you may not impose a license fee, royalty, or other charge for exercise of rights granted under this License, and you may not initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging that any patent claim is infringed by making, using, selling, offering for sale, or importing the Program or any portion of it. 11. Patents. A "contributor" is a copyright holder who authorizes use under this License of the Program or a work on which the Program is based. The work thus licensed is called the contributor's "contributor version". A contributor's "essential patent claims" are all patent claims owned or controlled by the contributor, whether already acquired or hereafter acquired, that would be infringed by some manner, permitted by this License, of making, using, or selling its contributor version, but do not include claims that would be infringed only as a consequence of further modification of the contributor version. For purposes of this definition, "control" includes the right to grant patent sublicenses in a manner consistent with the requirements of this License. Each contributor grants you a non-exclusive, worldwide, royalty-free patent license under the contributor's essential patent claims, to make, use, sell, offer for sale, import and otherwise run, modify and propagate the contents of its contributor version. In the following three paragraphs, a "patent license" is any express agreement or commitment, however denominated, not to enforce a patent (such as an express permission to practice a patent or covenant not to sue for patent infringement). To "grant" such a patent license to a party means to make such an agreement or commitment not to enforce a patent against the party. If you convey a covered work, knowingly relying on a patent license, and the Corresponding Source of the work is not available for anyone to copy, free of charge and under the terms of this License, through a publicly available network server or other readily accessible means, then you must either (1) cause the Corresponding Source to be so available, or (2) arrange to deprive yourself of the benefit of the patent license for this particular work, or (3) arrange, in a manner consistent with the requirements of this License, to extend the patent license to downstream recipients. "Knowingly relying" means you have actual knowledge that, but for the patent license, your conveying the covered work in a country, or your recipient's use of the covered work in a country, would infringe one or more identifiable patents in that country that you have reason to believe are valid. If, pursuant to or in connection with a single transaction or arrangement, you convey, or propagate by procuring conveyance of, a covered work, and grant a patent license to some of the parties receiving the covered work authorizing them to use, propagate, modify or convey a specific copy of the covered work, then the patent license you grant is automatically extended to all recipients of the covered work and works based on it. A patent license is "discriminatory" if it does not include within the scope of its coverage, prohibits the exercise of, or is conditioned on the non-exercise of one or more of the rights that are specifically granted under this License. You may not convey a covered work if you are a party to an arrangement with a third party that is in the business of distributing software, under which you make payment to the third party based on the extent of your activity of conveying the work, and under which the third party grants, to any of the parties who would receive the covered work from you, a discriminatory patent license (a) in connection with copies of the covered work conveyed by you (or copies made from those copies), or (b) primarily for and in connection with specific products or compilations that contain the covered work, unless you entered into that arrangement, or that patent license was granted, prior to 28 March 2007. Nothing in this License shall be construed as excluding or limiting any implied license or other defenses to infringement that may otherwise be available to you under applicable patent law. 12. No Surrender of Others' Freedom. If conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot convey a covered work so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not convey it at all. For example, if you agree to terms that obligate you to collect a royalty for further conveying from those to whom you convey the Program, the only way you could satisfy both those terms and this License would be to refrain entirely from conveying the Program. 13. Use with the GNU Affero General Public License. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed under version 3 of the GNU Affero General Public License into a single combined work, and to convey the resulting work. The terms of this License will continue to apply to the part which is the covered work, but the special requirements of the GNU Affero General Public License, section 13, concerning interaction through a network will apply to the combination as such. 14. Revised Versions of this License. The Free Software Foundation may publish revised and/or new versions of the GNU General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies that a certain numbered version of the GNU General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that numbered version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the GNU General Public License, you may choose any version ever published by the Free Software Foundation. If the Program specifies that a proxy can decide which future versions of the GNU General Public License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Program. Later license versions may give you additional or different permissions. However, no additional obligations are imposed on any author or copyright holder as a result of your choosing to follow a later version. 15. Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. Limitation of Liability. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 17. Interpretation of Sections 15 and 16. If the disclaimer of warranty and limitation of liability provided above cannot be given local legal effect according to their terms, reviewing courts shall apply local law that most closely approximates an absolute waiver of all civil liability in connection with the Program, unless a warranty or assumption of liability accompanies a copy of the Program in return for a fee. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . Also add information on how to contact you by electronic and paper mail. If the program does terminal interaction, make it output a short notice like this when it starts in an interactive mode: Copyright (C) This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, your program's commands might be different; for a GUI interface, you would use an "about box". You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU GPL, see . The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, please read . emacs-buttercup-1.37/Makefile000066400000000000000000000011111475447057000162160ustar00rootroot00000000000000EMACS := emacs VERSION := $(shell sed -ne 's/^;; Version: \(.*\)/\1/p' buttercup.el) ELISP_FILES := $(filter-out buttercup-pkg.el,$(wildcard *.el)) .PHONY: test compile clean all: test check test: check-buttercup check-docs check-buttercup test-buttercup: compile ./bin/buttercup -L . tests $(if $(CI),--traceback pretty) check-docs test-docs: compile $(EMACS) -batch -L . -l buttercup.el -f buttercup-run-markdown docs/writing-tests.md compile: $(patsubst %.el,%.elc,$(ELISP_FILES)) %.elc: %.el $(EMACS) -batch -L . -f batch-byte-compile $< clean: rm -f *.elc tests/*.elc emacs-buttercup-1.37/README.md000066400000000000000000000103511475447057000160430ustar00rootroot00000000000000# Buttercup — Behavior-Driven Emacs Lisp Testing [![Build and test](https://github.com/jorgenschaefer/emacs-buttercup/actions/workflows/test.yml/badge.svg)](https://github.com/jorgenschaefer/emacs-buttercup/actions/workflows/test.yml) [![NonGNU ELPA](https://elpa.nongnu.org/nongnu/buttercup.svg)](https://elpa.nongnu.org/nongnu/buttercup.html) [![MELPA Stable](http://stable.melpa.org/packages/buttercup-badge.svg)](http://stable.melpa.org/#/buttercup) ![Ranculus repens, photo by sannse](docs/images/buttercup.jpg) Buttercup is a behavior-driven development framework for testing Emacs Lisp code. It allows to group related tests so they can share common set-up and tear-down code, and allows the programmer to “spy” on functions to ensure they are called with the right arguments during testing. The framework is heavily inspired by [Jasmine](https://jasmine.github.io/edge/introduction.html). ## Example *Full article: [Writing Tests](docs/writing-tests.md)* A simple test looks like this. Note that `lexical-binding: t` is **required** in files defining buttercup tests. ```Lisp ;;; lexical-binding is required -*- lexical-binding: t; -*- (describe "A suite" (it "contains a spec with an expectation" (expect t :to-be t))) ``` ## Installation and Usage *Full article: [Running Tests](docs/running-tests.md)* You can install buttercup from [NonGNU ELPA](https://elpa.nongnu.org/) or [MELPA Stable](http://stable.melpa.org/). Add the following to your `init.el` or `.emacs` file: ``` (require 'package) ;; Available as a default in GNU Emacs from version 28.1 (add-to-list 'package-archives ("nongnu" . "https://elpa.nongnu.org/nongnu/") t) (add-to-list 'package-archives '("melpa-stable" . "http://stable.melpa.org/packages/") t) ``` This should allow you to `M-x package-install RET buttercup RET`. Alternatively, users of Debian 9 or later or Ubuntu 16.10 or later may simply `apt-get install elpa-buttercup`. Now create a file called `test-feature.el` with these contents: ```Lisp ;;; -*- lexical-binding: t; -*- (describe "A suite" (it "contains a spec with an expectation" (expect t :to-be t))) ``` You can now use buttercup to run this test: ``` $ emacs -batch -f package-initialize -L . -f buttercup-run-discover Running 1 specs. A suite contains a spec with an expectation Ran 1 specs, 0 failed, in 0.0 seconds. ``` Congratulations, you ran your first test! ## Feature List - Shared set-up and tear-down sections to reduce code repetition and share a common environment among tests. - Easy to read and extensible `expect` macro to describe expected behavior. - Powerful mocking framework, called “spies,” to both cause them to return expected values or throw errors as needed by the test, as well as to ensure functions are called with expected arguments during tests. - Built to be run within a Continuous Integration environment, including test runners to discover and execute tests in a directory tree. ### Why not ERT? Emacs comes with a testing framework, [ERT](https://www.gnu.org/software/emacs/manual/html_mono/ert.html). Buttercup was written to address some shortcomings of that framework. - ERT [deliberately leaves it up to the programmer to define set-up and tear-down code](https://www.gnu.org/software/emacs/manual/html_mono/ert.html#Fixtures-and-Test-Suites), which requires a lot of boiler-plate code for every set-up function. Buttercup makes this easy and seamless. - ERT has no good way of being run in a continuous integration environment. There are [external projects to make this less of a pain](https://github.com/rejeep/ert-runner.el) instead. Once all is said and done, you installed six external packages your project does not need just to run your own tests. And that does not include a mocking library. - ERT has no way of grouping related tests, requiring every test name to share the same prefix, making names long and hard to read. Nonetheless, ERT is a great project. It introduced testing to Emacs, and Buttercup learned a lot from its code to record a stack trace for error display. Even though Buttercup tries to be a better testing framework than ERT, we do wish ERT and the ERT maintainers all the best and hope both frameworks can continue to benefit from each other. emacs-buttercup-1.37/bin/000077500000000000000000000000001475447057000153345ustar00rootroot00000000000000emacs-buttercup-1.37/bin/buttercup000077500000000000000000000074371475447057000173120ustar00rootroot00000000000000#!/usr/bin/env bash if [ -n "$INSIDE_EMACS" ] then EMACS_BIN="emacs" else EMACS_BIN="${EMACS:-emacs}" fi usage () { cat < ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License ;; as published by the Free Software Foundation; either version 3 ;; of the License, or (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; This file provides compatibility definitions for buttercup. These ;; are primarily backported features of later versions of Emacs that ;; are not available in earlier ones. ;; Most parts of this file are taken from the Emacs source code to ;; provide the same functionality. ;;; Code: ;;;;;;;;;;;;;;;;;;;;; ;;; Introduced in 25.1 (when (not (fboundp 'directory-files-recursively)) (defun directory-files-recursively (dir match &optional include-directories) "Return all files under DIR that have file names matching MATCH (a regexp). This function works recursively. Files are returned in \"depth first\" and alphabetical order. If INCLUDE-DIRECTORIES, also include directories that have matching names." (let ((result nil) (files nil) ;; When DIR is "/", remote file names like "/method:" could ;; also be offered. We shall suppress them. (tramp-mode (and tramp-mode (file-remote-p dir)))) (dolist (file (sort (file-name-all-completions "" dir) #'string<)) (unless (member file '("./" "../")) (if (directory-name-p file) (let* ((leaf (substring file 0 (1- (length file)))) (full-file (expand-file-name leaf dir))) ;; Don't follow symlinks to other directories. (unless (file-symlink-p full-file) (setq result (nconc result (directory-files-recursively full-file match include-directories)))) (when (and include-directories (string-match match leaf)) (setq result (nconc result (list full-file))))) (when (string-match match file) (push (expand-file-name file dir) files))))) (nconc result (nreverse files))))) (when (not (fboundp 'directory-name-p)) (defsubst directory-name-p (name) "Return non-nil if NAME ends with a slash character." (and (> (length name) 0) (char-equal (aref name (1- (length name))) ?/)))) (when (not (fboundp 'seconds-to-string)) (defvar seconds-to-string (list (list 1 "ms" 0.001) (list 100 "s" 1) (list (* 60 100) "m" 60.0) (list (* 3600 30) "h" 3600.0) (list (* 3600 24 400) "d" (* 3600.0 24.0)) (list nil "y" (* 365.25 24 3600))) "Formatting used by the function `seconds-to-string'.") (defun seconds-to-string (delay) "Convert the time interval in seconds to a short string." (cond ((> 0 delay) (concat "-" (seconds-to-string (- delay)))) ((= 0 delay) "0s") (t (let ((sts seconds-to-string) here) (while (and (car (setq here (pop sts))) (<= (car here) delay))) (concat (format "%.2f" (/ delay (car (cddr here)))) (cadr here))))))) ;;;;;;;;;;;;;;;;;;;;;; ;;; Introduced in 26.1 (unless (fboundp 'file-attribute-modification-time) (defsubst file-attribute-modification-time (attributes) "The modification time in ATTRIBUTES returned by `file-attributes'. This is the time of the last change to the file's contents, and is a Lisp timestamp in the style of `current-time'." (nth 5 attributes))) ;;;;;;;;;;;;;;;;;;;;;; ;;; Introduced in 28.1 (unless (fboundp 'with-environment-variables) (defmacro with-environment-variables (variables &rest body) "Set VARIABLES in the environment and execute BODY. VARIABLES is a list of variable settings of the form (VAR VALUE), where VAR is the name of the variable (a string) and VALUE is its value (also a string). The previous values will be restored upon exit." (declare (indent 1) (debug (sexp body))) (unless (consp variables) (error "Invalid VARIABLES: %s" variables)) `(let ((process-environment (copy-sequence process-environment))) ,@(mapcar (lambda (elem) `(setenv ,(car elem) ,(cadr elem))) variables) ,@body))) ;;;;;;;;;;;;;;;;;;;;;; ;;; Introduced in 29.1 (unless (boundp 'backtrace-on-error-noninteractive) (defvar backtrace-on-error-noninteractive nil "Control early backtrace starting in Emacs 29.")) (provide 'buttercup-compat) ;; Local Variables: ;; indent-tabs-mode: nil ;; tab-width: 8 ;; sentence-end-double-space: nil ;; End: ;;; buttercup-compat.el ends here emacs-buttercup-1.37/buttercup.el000066400000000000000000002712531475447057000171350ustar00rootroot00000000000000;;; buttercup.el --- Behavior-Driven Emacs Lisp Testing -*-lexical-binding:t-*- ;; Copyright (C) 2015-2017 Jorgen Schaefer ;; Copyright (C) 2018-2024 Ola Nilsson ;; Version: 1.37 ;; Author: Jorgen Schaefer ;; Maintainer: Ola Nilsson ;; Package-Requires: ((emacs "24.4")) ;; URL: https://github.com/jorgenschaefer/emacs-buttercup ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License ;; as published by the Free Software Foundation; either version 3 ;; of the License, or (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; Buttercup is a behavior-driven development framework for testing ;; Emacs Lisp code. It is heavily inspired by the Jasmine test ;; framework for JavaScript. ;; A test suite begins with a call to the Buttercup macro `describe` with ;; the first parameter describing the suite and the rest being the body ;; of code that implements the suite. ;; ;;; lexical binding is required -*- lexical-binding: t; -*- ;; (describe "A suite" ;; (it "contains a spec with an expectation" ;; (expect t :to-be t))) ;; The ideas for project were shamelessly taken from Jasmine ;; . ;; All the good ideas are theirs. All the problems are mine. ;;; Code: (require 'cl-lib) (require 'buttercup-compat) (require 'format-spec) (require 'ert nil t) (require 'warnings) ;; A base error for all errors raised by buttercup. (define-error 'buttercup-error-base "error") ;; Buttercup internals error, raised on internal implementation ;; inconsistencies. (define-error 'buttercup-internals-error "Internal buttercup error" 'buttercup-error-base) ;; Raised when expanding `describe` macros whithout lexical-binding: t (define-error 'buttercup-dynamic-binding-error "Lexical binding is not enabled" 'buttercup-error-base) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; wrapper function manipulation ;; Error for buttercup--enclosed-expr (define-error 'buttercup-enclosed-expression-error "Bad test expression" 'buttercup-internals-error) (eval-and-compile (if (fboundp 'oclosure-define) ;Emacs≥29 (oclosure-define (buttercup--thunk (:predicate buttercup--thunk-p)) "An elisp expression as a function and original code." expr) (defalias 'buttercup--thunk-p #'ignore "Always return nil when Oclosures are not available."))) (defun buttercup--enclosed-expr (fun) "Given a FUN `buttercup-thunk', return its unevaluated expression. For Emacs < 29: The function MUST be byte-compiled or have one of the following forms: \(closure (ENVLIST) () (quote EXPR) EXPANDED) \(lambda () (quote EXPR) EXPR) and the return value will be EXPR, unevaluated. The quoted EXPR is useful if EXPR is a macro call, in which case the `quote' ensures access to the un-expanded form." (if (buttercup--thunk-p fun) (buttercup--thunk--expr fun) (pcase fun ;; This should be the normal case, a closure with unknown enclosed ;; variables, empty arglist and a body containing ;; * the quoted original expression ;; * the stackframe marker ;; * the macroexpanded original expression (`(closure ,(pred listp) nil (quote ,expr) ,_expanded) expr) ;; This a when FUN has not been evaluated. ;; Why does that happen? ;; A lambda with an empty arglist and a body containing ;; * the quoted original expression ;; * the stackframe marker ;; * the expanded expression (`(lambda nil (quote ,expr) ,_expanded) expr) ;; This is when FUN has been byte compiled, as when the entire ;; test file has been byte compiled. Check that it has an empty ;; arglist, that is all that is possible at this point. The ;; return value is byte compiled code, not the original ;; expressions. Also what is possible at this point. ((and (pred byte-code-function-p) (guard (member (aref fun 0) '(nil 0)))) (aref fun 1)) ;; Error (_ (signal 'buttercup-enclosed-expression-error (format "Not a zero-arg one-expression closure: %S" fun)))))) (defun buttercup--expr-and-value (fun) "Given a function, return its quoted expression and value. FUN must be a zero-argument one-expression function, i.e. something that satisfies `buttercup--wrapper-fun-p'. The return value is `(cons EXPR VALUE)', where EXPR is the unevaluated expression in the function, and VALUE is the result of calling the function (thus evaluating EXPR in the proper lexical environment)." (cons (buttercup--enclosed-expr fun) (funcall fun))) (defun buttercup--wrapper-fun-p (fun) "Return non-nil if FUN is a zero-arg one-expression function." (condition-case nil (prog1 t (buttercup--enclosed-expr fun)) (error nil))) ;;;;;;;;;;;;;;;;;;;; ;;; Helper functions (defun buttercup-format-spec (format specification) "Return a string based on FORMAT and SPECIFICATION. This is a wrapper around `format-spec', which see. This also adds a call to `save-match-data', as `format-spec' modifies that." (save-match-data (format-spec format specification))) (defun buttercup--simple-format (specification &rest format) "Return a string based on SPECIFICATION and FORMAT. A simpler version of `format-spec', which see. If more than one FORMAT string is given they will be combined before formatting replacements occur. Does not support flags, width or precision. The substitution for a specification character can be a function, which is only supported in `format-spec' from Emacs 29. Does not have the IGNORE-MISSING and SPLIT parameters." (save-match-data (with-temp-buffer (apply #'insert format) (goto-char 1) (while (search-forward "%" nil t) (cond ((= (following-char) ?%) (delete-char 1)) ((looking-at-p (rx alpha)) (let* ((char (following-char)) (begin (point)) (replacement (cdr (assq char specification))) (text (if (functionp replacement) (funcall replacement) replacement))) (insert-and-inherit text) (delete-char 1) (delete-region (1- begin) begin))))) (buffer-string)))) ;;;;;;;;;; ;;; expect (define-error 'buttercup-failed "Buttercup test failed" 'buttercup-error-base) (define-error 'buttercup-pending "Buttercup test is pending" 'buttercup-error-base) (defun buttercup--wrap-expr (expr) "Wrap EXPR in a `buttercup--thunk' to be used by `buttercup-expect'. This function is only usable from within the buttercup `expect' macro." (if (fboundp 'oclosure-lambda) ;Emacs≥29 `(oclosure-lambda (buttercup--thunk (expr ',expr)) () ,expr) `(lambda () (quote ,expr) ,expr))) (defmacro expect (arg &optional matcher &rest args) "Expect a condition to be true. This macro knows two forms: \(expect ARG :MATCHER [ARGS...]) Fail the current test if the MATCHER does not match these arguments. The correct number of arguments depend on the MATCHER. See `buttercup-define-matcher' for more information on matchers. \(expect ARG) Fail the current test if ARG is not true. This is the same as (expect ARG :to-be-truthy). All arguments can be a value or a single Lisp form. The evaluation of the arguments is delayed until the containing spec is executed." `(buttercup-expect ,(buttercup--wrap-expr arg) ,(or matcher :to-be-truthy) ,@(mapcar #'buttercup--wrap-expr args))) (defun buttercup-expect (arg &optional matcher &rest args) "The function for the `expect' macro. See the macro documentation for details and the definition of ARG, MATCHER and ARGS." (cl-assert (cl-every #'buttercup--wrapper-fun-p (cons arg args)) t) (pcase (buttercup--apply-matcher (or matcher :to-be-truthy) (cons arg args)) (`(,result . ,message) (unless result (buttercup-fail message))) (result (unless result (buttercup-fail "Expected %S %S %s" (buttercup--enclosed-expr arg) matcher (mapconcat (lambda (obj) (format "%S" (funcall obj))) args " ")))))) (defun buttercup-fail (format &rest args) "Fail the current test with the given description. This is the mechanism underlying `expect'. You can use it directly if you want to write your own testing functionality. FORMAT and ARGS are passed to `format'." (signal 'buttercup-failed (apply #'format format args))) (defun buttercup-skip (format &rest args) "Skip the current test with the given description. FORMAT and ARGS are passed to `format'." (signal 'buttercup-pending (apply #'format format args))) (defmacro assume (condition &optional message) "Assume CONDITION for the current test. Assume that CONDITION evaluates to non-nil in the current test. If it evaluates to nil cancel the current test with MESSAGE. If MESSAGE is omitted or nil show the condition form instead." (let ((message (or message (format "%S => nil" condition)))) `(unless ,condition (buttercup-skip "!! CANCELLED !! %s" ,message)))) (defmacro buttercup-define-matcher (matcher args &rest body) "Define a matcher named MATCHER to be used in `expect'. MATCHER is a keyword, for instance `:to-be'. ARGS is a list of the elements to match together. The BODY will receive ARGS as functions that can be called (using `funcall') to get their values. BODY should return either a simple boolean, or a cons cell of the form (RESULT . MESSAGE). If RESULT is nil, MESSAGE should describe why the matcher failed. If RESULT is non-nil, MESSAGE should describe why a negated matcher failed. \(fn MATCHER ARGS [DOCSTRING] BODY...)" (declare (indent defun)) `(put ,matcher 'buttercup-matcher (lambda ,args ,@body))) (defun buttercup--function-as-matcher (fun) "Wrap FUN in code to unpack function-wrapped arguments." (cl-assert (functionp fun) t) (lambda (&rest args) (apply fun (mapcar #'funcall args)))) (defun buttercup--find-matcher-function (matcher) "Return the matcher function for MATCHER." (let ((matcher-prop (when (symbolp matcher) (get matcher 'buttercup-matcher)))) (cond ;; Use `buttercup-matcher' property if it's a function ((functionp matcher-prop) matcher-prop) (matcher-prop (error "%S %S has a `buttercup-matcher' property that is not a function. Buttercup has been misconfigured" (if (keywordp matcher) "Keyword" "Symbol") matcher)) ;; Otherwise just use `matcher' as a function, wrapping it in ;; code to unpack function-wrapped arguments. ((functionp matcher) (buttercup--function-as-matcher matcher)) (matcher (error "Not a test: `%S'" matcher)) ;; If `matcher' is nil, then we just want a basic truth test ((null matcher) (buttercup--find-matcher-function :to-be-truthy)) (t (error "This line should never run"))))) (defun buttercup--apply-matcher (matcher args) "Apply MATCHER to ARGS. ARGS is a list of functions that must be `funcall'ed to get their values. MATCHER is either a matcher keyword defined with `buttercup-define-matcher', or a function." (cl-assert (cl-every #'buttercup--wrapper-fun-p args) t) (let ((function (buttercup--find-matcher-function matcher))) (apply function args))) (cl-defmacro buttercup--test-expectation (expression &key expect-match-phrase expect-mismatch-phrase) "Wrapper for the common matcher case of two possible messages. The logic for the return values of buttercup matchers can be unintuitive, since the return value is a cons cell whose first element is t for a mismatch and nil for a match. In the simple case where there are only two possible messages (EXPECT-MATCH-PHRASE for a match and EXPECT-MISMATCH-PHRASE for a mismatch), this macro allows you to simply specify those two phrases and the EXPRESSION to test." (declare (indent 1)) (cl-assert expect-match-phrase) (cl-assert expect-mismatch-phrase) `(let ((value ,expression)) (if value (cons t ,expect-mismatch-phrase) (cons nil ,expect-match-phrase)))) (cl-defmacro buttercup-define-matcher-for-unary-function (matcher function &key expect-match-phrase expect-mismatch-phrase function-name) "Shortcut to define a MATCHER for a 1-argument FUNCTION. When the matcher is used, keyword arguments EXPECT-MATCH-PHRASE and EXPECT-MISMATCH-PHRASE are used to construct the return message. It may contain `%f', `%A', and `%a', which will be replaced with the function name, the expression of the argument the matcher was called on, and the value of that argument, respectively. If not provided, the default EXPECT-MATCH-PHRASE is: Expected `%A' to match `%f', but instead it was `%a'. Similarly, the default EXPECT-MISMATCH-PHRASE is: Expected `%A' not to match `%f', but it was `%a'. To include a literal `%' in either message, use `%%'. If FUNCTION is passed as a lambda expression or other non-symbol, then you must provide a keyword argument FUNCTION-NAME to be used in the match/mismatch messages. Otherwise, FUNCTION-NAME will be used instead of FUNCTION if both are non-nil SYMBOLS. If FUNCTION (or FUNCTION-NAME) has an `ert-explainer' property, this will be used to generate the default EXPECT-MATCH-PHRASE. See also `buttercup-define-matcher'." (declare (indent 2)) ;; Use the ERT explainer for FUNCTION if available to generate the ;; default expect-match phrase. (let ((explainer (or (when function-name (get function-name 'ert-explainer)) (when (symbolp function) (get function 'ert-explainer))))) (cl-assert (symbolp function-name) t) (cl-assert (functionp function) t) (unless expect-match-phrase (setq expect-match-phrase (if explainer ;; %x is the undocumented substitution for the ;; explainer's output "Expected `%A' to match `%f', but instead it was `%a' which did not match because: %x." "Expected `%A' to match `%f', but instead it was `%a'."))) (unless expect-mismatch-phrase (setq expect-mismatch-phrase "Expected `%A' not to match `%f', but it was `%a'.")) (when (and (null function-name) ;; Only need a function name if either phrase contains ;; an unescaped `%f'. (string-match-p "%f" (replace-regexp-in-string "%%" "" (concat expect-match-phrase " " expect-mismatch-phrase)))) (if (symbolp function) (setq function-name (symbol-name function)) (error "The `:function-name' keyword is required if FUNCTION is not a symbol"))) `(buttercup-define-matcher ,matcher (arg) (let* ((expr (buttercup--enclosed-expr arg)) (value (funcall arg)) (explanation (and ',explainer (funcall ',explainer arg))) (spec (format-spec-make ?f ',function-name ?A (format "%S" expr) ?a (format "%S" value) ?x (format "%S" explanation)))) (buttercup--test-expectation (funcall ',function value) :expect-match-phrase (buttercup-format-spec ,expect-match-phrase spec) :expect-mismatch-phrase (buttercup-format-spec ,expect-mismatch-phrase spec)))))) (cl-defmacro buttercup-define-matcher-for-binary-function (matcher function &key expect-match-phrase expect-mismatch-phrase function-name) "Shortcut to define a MATCHER for a 2-argument FUNCTION. When the matcher is used, keyword arguments EXPECT-MATCH-PHRASE and EXPECT-MISMATCH-PHRASE are used to construct the return message. It may contain `%f', `%A', `%a', `%B', and `%b'. The token `%f' will be replaced with the function name. `%A' and `%B' will be replaced with the unevaluted expressions of the two arguments passed to the function, while `%a' and `%b' will be replaced with their values. not provided, the default EXPECT-MATCH-PHRASE is: Expected `%A' to be `%f' to `%b', but instead it was `%a'. Similarly, the default EXPECT-MISMATCH-PHRASE is: Expected `%A' not to be `%f' to `%b', but it was. To include a literal `%' in either message, use `%%'. If FUNCTION is passed as a lambda expression or other non-symbol, then you must provide a keyword argument FUNCTION-NAME to be used in the match/mismatch messages (unless neither one contains `%f'). If both are non-nil symbols, FUNCTION-NAME will be used instead of FUNCTION in messages. If FUNCTION (or FUNCTION-NAME) has an `ert-explainer' property, this will be used to generate the default EXPECT-MATCH-PHRASE. See also `buttercup-define-matcher'." (declare (indent 2)) ;; Use the ERT explainer for FUNCTION if available to generate the ;; default expect-match phrase. (let ((explainer (or (when function-name (get function-name 'ert-explainer)) (when (symbolp function) (get function 'ert-explainer))))) (cl-assert (symbolp function-name) t) (cl-assert (functionp function) t) (unless expect-match-phrase (setq expect-match-phrase (if explainer ;; %x is the undocumented substitution for the ;; explainer's output "Expected `%A' to be `%f' to `%b', but instead it was `%a' which does not match because: %x." "Expected `%A' to be `%f' to `%b', but instead it was `%a'."))) (unless expect-mismatch-phrase (setq expect-mismatch-phrase "Expected `%A' not to be `%f' to `%b', but it was.")) (when (and (null function-name) ;; Only need a function name if either phrase contains ;; an unescaped `%f'. (string-match-p "%f" (replace-regexp-in-string "%%" "" (concat expect-match-phrase " " expect-mismatch-phrase)))) (if (symbolp function) (setq function-name (symbol-name function)) (error "The `:function-name' keyword is required if FUNCTION is not a symbol"))) `(buttercup-define-matcher ,matcher (a b) (cl-destructuring-bind ((a-expr . a) (b-expr . b)) (mapcar #'buttercup--expr-and-value (list a b)) (let* ((explanation (and ',explainer (funcall ',explainer a b))) (spec (format-spec-make ?f ',function-name ?A (format "%S" a-expr) ?a (format "%S" a) ?B (format "%S" b-expr) ?b (format "%S" b) ?x (format "%S" explanation)))) (buttercup--test-expectation (funcall #',function a b) :expect-match-phrase (buttercup-format-spec ,expect-match-phrase spec) :expect-mismatch-phrase (buttercup-format-spec ,expect-mismatch-phrase spec))))))) ;;;;;;;;;;;;;;;;;;;;; ;;; Built-in matchers (buttercup-define-matcher-for-unary-function :to-be-truthy identity :expect-match-phrase "Expected `%A' to be non-nil, but instead it was nil." :expect-mismatch-phrase "Expected `%A' to be nil, but instead it was `%a'.") (buttercup-define-matcher-for-binary-function :to-be eq) (buttercup-define-matcher-for-binary-function :to-equal equal) (buttercup-define-matcher :not (obj matcher &rest args) (let* ((matcher (funcall matcher)) (result (buttercup--apply-matcher matcher (cons obj args)))) (if (consp result) (cons (not (car result)) (cdr result)) (not result)))) (buttercup-define-matcher :to-have-same-items-as (a b) (cl-destructuring-bind ((a-expr . a) (b-expr . b)) (mapcar #'buttercup--expr-and-value (list a b)) (let* ((a-uniques (cl-set-difference a b :test #'equal)) (b-uniques (cl-set-difference b a :test #'equal)) (spec (format-spec-make ?A (format "%S" a-expr) ?a (format "%S" a) ?B (format "%S" b-expr) ?b (format "%S" b) ?m (format "%S" b-uniques) ?p (format "%S" a-uniques)))) (cond ((and a-uniques b-uniques) (cons nil (buttercup-format-spec "Expected `%A' to contain the same items as `%b', but `%m' are missing and `%p' are present unexpectedly." spec))) (a-uniques (cons nil (buttercup-format-spec "Expected `%A' to contain the same items as `%b', but `%p' are present unexpectedly." spec))) (b-uniques (cons nil (buttercup-format-spec "Expected `%A' to contain the same items as `%b', but `%m' are missing." spec))) (t (cons t (buttercup-format-spec "Expected `%A' not to have same items as `%b'" spec))))))) (buttercup-define-matcher :to-match (text regexp) (cl-destructuring-bind ((text-expr . text) (regexp-expr . regexp)) (mapcar #'buttercup--expr-and-value (list text regexp)) (save-match-data (let* (;; For string literals, just use them normally, but for ;; expressions, show both the expr and its string value (text-is-literal (equal text-expr text)) (regexp-is-literal (equal regexp-expr regexp)) (text-desc (if text-is-literal text-expr (format "`%S' with value %S" text-expr text))) (regexp-desc (if regexp-is-literal regexp-expr (format "`%S' with value %S" regexp-expr regexp))) (match-p (string-match regexp text)) ;; Get some more details about the match (start (when match-p (match-beginning 0))) (end (when match-p (match-end 0))) (matched-substring (when match-p (substring text start end))) (spec (format-spec-make ?T text-desc ?t (format "%S" text) ?R regexp-desc ?r (format "%S" regexp) ?m (format "%S" matched-substring) ?a start ?z end))) (buttercup--test-expectation match-p :expect-match-phrase (buttercup-format-spec "Expected %T to match the regexp %r, but instead it was %t." spec) :expect-mismatch-phrase (buttercup-format-spec "Expected %T not to match the regexp %r, but it matched the substring %m from position %a to %z." spec)))))) (buttercup-define-matcher-for-binary-function :to-be-in member :expect-match-phrase "Expected `%A' to be an element of `%b', but it was `%a'." :expect-mismatch-phrase "Expected `%A' not to be an element of `%b', but it was `%a'.") (buttercup-define-matcher-for-binary-function ;; Reverse the args :to-contain (lambda (a b) (member b a)) :expect-match-phrase "Expected `%A' to be a list containing `%b', but instead it was `%a'." :expect-mismatch-phrase "Expected `%A' to be a list not containing `%b', but instead it was `%a'.") (buttercup-define-matcher-for-binary-function :to-be-less-than < :expect-match-phrase "Expected `%A' < %b, but `%A' was %a." :expect-mismatch-phrase "Expected `%A' >= %b, but `%A' was %a.") (buttercup-define-matcher-for-binary-function :to-be-greater-than > :expect-match-phrase "Expected `%A' > %b, but `%A' was %a." :expect-mismatch-phrase "Expected `%A' <= %b, but `%A' was %a.") (buttercup-define-matcher-for-binary-function :to-be-weakly-less-than <= :expect-match-phrase "Expected `%A' <= %b, but `%A' was %a." :expect-mismatch-phrase "Expected `%A' > %b, but `%A' was %a.") (buttercup-define-matcher-for-binary-function :to-be-weakly-greater-than >= :expect-match-phrase "Expected `%A' >= %b, but `%A' was %a." :expect-mismatch-phrase "Expected `%A' < %b, but `%A' was %a.") (buttercup-define-matcher :to-be-close-to (a b precision) "Verify that |A-B| < 10^-PRECISION. \(expect A :to-be-close-to B PRECISION)" (cl-destructuring-bind (precision (a-expr . a) (_b-expr . b)) (cons (funcall precision) (mapcar #'buttercup--expr-and-value (list a b))) (let ((tolerance (expt 10.0 (- precision)))) (buttercup--test-expectation (< (abs (- a b)) tolerance) :expect-match-phrase (format "Expected `%S' to be within %s of %s, but instead it was %s, with a difference of %s" a-expr tolerance b a (abs (- a b))) :expect-mismatch-phrase (format "Expected `%S' to differ from %s by more than %s, but instead it was %s, with a difference of %s" a-expr b tolerance a (abs (- a b))))))) (buttercup-define-matcher :to-throw (expr &optional signal signal-args) "Check that EXPR raises SIGNAL with SIGNAL-ARGS. EXPR, SIGNAL, and SIGNAL-ARGS should all be buttercup-wrapped objects. EXPR is the test code that will be evaluated. The signal raised by EXPR must be SIGNAL or an error signal derived from SIGNAL. If SIGNAL is nil match any error signal. If SIGNAL-ARGS are given they must be `equal' to the arguments of the caught signal. Do not consider the signal arguments if SIGNAL-ARGS is nil." (let ((expected-signal-symbol (and signal (funcall signal))) (expected-signal-args (and signal-args (funcall signal-args))) (unevaluated-expr (buttercup--enclosed-expr expr)) expr-value thrown-signal) (when (and (functionp unevaluated-expr) (member (car unevaluated-expr) '(lambda closure))) (display-warning 'buttercup (buttercup-colorize (format "Probable incorrect use of `:to-throw' matcher: pass an expression instead of a function: `%S'" unevaluated-expr) 'yellow))) ;; Set the above variables (condition-case err (setq expr-value (funcall expr)) (error (setq thrown-signal err) nil)) (buttercup--handle-to-throw thrown-signal (cons expected-signal-symbol expected-signal-args) unevaluated-expr expr-value))) (defun buttercup--handle-to-throw (thrown-signal expected-signal unevaluated-expr expr-value) "Handle the results of the :to-throw matcher. This is a separate function for testability purposes. THROWN-SIGNAL is the signal - a `cons' of symbol and arguments - caught by `condition-case', or nil if no signal was raised. EXPECTED-SIGNAL is a `cons' of the expected signal symbol and arguments. The `cdr' can be nil if the `expect' statement did not specify any expected arguments. UNEVALUATED-EXPR is the Lisp sexp used before the :to-throw matcher keyword in the `expect' statement. EXPR-VALUE is the return value from the evaluation of UNEVALUATED-EXPR if it did not raise any signal." (let* ((thrown-signal-symbol (car thrown-signal)) (thrown-signal-args (cdr thrown-signal)) (expected-signal-symbol (car expected-signal)) (expected-signal-args (cdr expected-signal)) (matching-signal-symbol (or (null expected-signal-symbol) (memq expected-signal-symbol (get thrown-signal-symbol 'error-conditions)))) (explained-signal-args ; nil for matched, explained or t for mismatched (when expected-signal-args ;; The ert-explainer for equal does an equal internally, ;; so avoid calling equal twice by calling the explainer ;; directly. (funcall (or (get 'equal 'ert-explainer) (lambda (a b) (not (equal a b)))) thrown-signal-args expected-signal-args)))) (let* ((matched (and thrown-signal matching-signal-symbol (not explained-signal-args))) ;; Some of these replacement are always used, there is no ;; reason not to format them immediately. But e and t are not ;; always used and should be delayed. Use ;; buttercup--simple-format for formatting as format-spec ;; does not support functions until Emacs 29 (spec (format-spec-make ?E (format "`%S'" unevaluated-expr) ?e (lambda () (format "`%S'" expr-value)) ?t (lambda () (format "%S" thrown-signal)) ?S (lambda () (format "`%S'" thrown-signal-symbol)) ?A (lambda () (if expected-signal-args (format " with args `%S'" thrown-signal-args) "")) ?s (if expected-signal-symbol (format "a child signal of `%S'" expected-signal-symbol) "a signal") ?a (if expected-signal-args (format " with args `%S'" expected-signal-args) "") ?q (lambda () (format "%S" explained-signal-args)) ))) (cond (matched ;; should be the most likely result `(t . ,(buttercup--simple-format spec "Expected %E not to throw %s%a, but it threw %S%A"))) ((null thrown-signal) ; no signal raised `(nil . ,(buttercup--simple-format spec "Expected %E to throw %s%a, but instead it returned %e"))) ((and explained-signal-args (not matching-signal-symbol)) ; neither symbol nor args matched `(nil . ,(buttercup--simple-format spec "Expected %E to throw %s%a, but instead it threw %S%A"))) (explained-signal-args ; symbol matched `(nil . ,(buttercup--simple-format spec "Expected %E to signal %s%a, but instead signalled%A which does not match because %q."))) ((not matching-signal-symbol) ; args matched `(nil . ,(buttercup--simple-format spec "Expected %E to throw %s%a, but instead it threw %S%A"))) (t (error "`buttercup--handle-to-throw' could not handle args %S %S" thrown-signal expected-signal)))))) (buttercup-define-matcher :to-have-been-called (spy) "Check that SPY have been called at least once." (cl-assert (symbolp (funcall spy))) (if (spy-calls-all (funcall spy)) t nil)) (buttercup-define-matcher :to-have-been-called-with (spy &rest args) "Check that SPY has been called at least once with arguments ARGS." (setq spy (funcall spy)) (cl-assert (symbolp spy)) (setq args (mapcar #'funcall args)) (let* ((calls (mapcar #'spy-context-args (spy-calls-all spy)))) (cond ((not calls) (cons nil (format "Expected `%s' to have been called with %S, but it was not called at all" spy args))) ((not (member args calls)) (cons nil (format "Expected `%s' to have been called with %S, but it was called with %s" spy args (mapconcat (lambda (args) (format "%S" args)) calls ", ")))) (t t)))) (buttercup-define-matcher :to-have-been-called-times (spy number) "Check that SPY has been called exactly NUMBER times." (setq spy (funcall spy) number (funcall number)) (cl-assert (symbolp spy)) (let* ((call-count (spy-calls-count spy))) (cond ((= number call-count) (cons t (format "Expected `%s' to not have been called exactly %s %s, but it was." spy number (if (= number 1) "time" "times")))) (t (cons nil (format "Expected `%s' to have been called %s %s, but it was called %s %s" spy number (if (= number 1) "time" "times") call-count (if (= call-count 1) "time" "times"))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Suite and spec data structures (cl-defstruct buttercup-suite-or-spec ;; The name of this specific suite description ;; The parent of this suite, another suite parent ;; One of: passed failed pending (status 'passed) failure-description failure-stack time-started time-ended) (cl-defstruct (buttercup-suite (:include buttercup-suite-or-spec)) ;; Any children of this suite, both suites and specs children ;; Closure to run before and after each spec in this suite and its ;; children before-each after-each ;; Likewise, but before and after all specs. before-all after-all) (cl-defstruct (buttercup-spec (:include buttercup-suite-or-spec)) ;; The closure to run for this spec function) (defun buttercup-suite-add-child (parent child) "Add a CHILD suite to a PARENT suite. Return CHILD." (setf (buttercup-suite-children parent) (append (buttercup-suite-children parent) (list child))) (setf (buttercup-suite-or-spec-parent child) parent) child) (defun buttercup-suite-or-spec-parents (suite-or-spec) "Return a list of parents of SUITE-OR-SPEC." (when (buttercup-suite-or-spec-parent suite-or-spec) (cons (buttercup-suite-or-spec-parent suite-or-spec) (buttercup-suite-or-spec-parents (buttercup-suite-or-spec-parent suite-or-spec))))) (define-obsolete-function-alias 'buttercup-suite-parents #'buttercup-suite-or-spec-parents "emacs-buttercup 1.10") (define-obsolete-function-alias 'buttercup-spec-parents #'buttercup-suite-or-spec-parents "emacs-buttercup 1.10") (defun buttercup-suites-total-specs-defined (suite-list) "Return the number of specs defined in all suites in SUITE-LIST." (length (buttercup--specs suite-list))) (defun buttercup-suites-total-specs-status (suite-list status) "Return the number of specs in SUITE-LIST marked with STATUS." (cl-count status (buttercup--specs suite-list) :key #'buttercup-spec-status)) (defun buttercup-suites-total-specs-pending (suite-list) "Return the number of specs marked as pending in all suites in SUITE-LIST." (buttercup-suites-total-specs-status suite-list 'pending)) (defun buttercup-suites-total-specs-failed (suite-list) "Return the number of failed specs in all suites in SUITE-LIST." (buttercup-suites-total-specs-status suite-list 'failed)) (defun buttercup--specs (spec-or-suite-list) "Return a flat list of all specs in SPEC-OR-SUITE-LIST." (let (specs) (dolist (spec-or-suite spec-or-suite-list specs) (if (buttercup-spec-p spec-or-suite) (setq specs (append specs (list spec-or-suite))) (setq specs (append specs (buttercup--specs (buttercup-suite-children spec-or-suite)))))))) (defun buttercup--specs-and-suites (spec-or-suite-list) "Return a flat list of all specs and suites in SPEC-OR-SUITE-LIST." (let ((specs-and-suites nil)) (dolist (spec-or-suite spec-or-suite-list specs-and-suites) (setq specs-and-suites (append specs-and-suites (list spec-or-suite))) (when (buttercup-suite-p spec-or-suite) (setq specs-and-suites (append specs-and-suites (buttercup--specs-and-suites (buttercup-suite-children spec-or-suite)))))))) (defun buttercup-suite-full-name (suite) "Return the full name of SUITE, which includes the names of the parents." (mapconcat #'buttercup-suite-description (nreverse (cons suite (buttercup-suite-or-spec-parents suite))) " ")) (defun buttercup-spec-full-name (spec) "Return the full name of SPEC, which includes the full name of its suite." (let ((parent (buttercup-spec-parent spec))) (if parent (concat (buttercup-suite-full-name parent) " " (buttercup-spec-description spec)) (buttercup-spec-description spec)))) (defun buttercup--full-spec-names (spec-or-suite-list) "Return full names of all specs in SPEC-OR-SUITE-LIST." (cl-loop for x in (buttercup--specs spec-or-suite-list) collect (buttercup-spec-full-name x))) (defun buttercup--find-duplicate-spec-names (spec-or-suite-list) "Return duplicate full spec names among SPEC-OR-SUITE-LIST." (let ((seen '()) (duplicates '())) (dolist (name (buttercup--full-spec-names spec-or-suite-list) (nreverse duplicates)) (if (member name seen) (push name duplicates) (push name seen))))) (defun buttercup--set-start-time (suite-or-spec) "Set time-started of SUITE-OR-SPEC to `current-time'." (setf (buttercup-suite-or-spec-time-started suite-or-spec) (current-time))) (defun buttercup--set-end-time (suite-or-spec) "Set time-ended of SUITE-OR-SPEC to `current-time'." (setf (buttercup-suite-or-spec-time-ended suite-or-spec) (current-time))) (defun buttercup-elapsed-time (suite-or-spec) "Get elapsed time of SUITE-OR-SPEC." ;; time-subtract does not handle nil arguments until Emacs 25.1 (time-subtract (or (buttercup-suite-or-spec-time-ended suite-or-spec) (current-time)) (or (buttercup-suite-or-spec-time-started suite-or-spec) (current-time)))) (defun buttercup-elapsed-time-string (suite-or-spec) "Convert the elapsed time for SUITE-OR-SPEC to a short string." (seconds-to-string (float-time (buttercup-elapsed-time suite-or-spec)))) (defun buttercup--indented-description (suite-or-spec) "Return the description of SUITE-OR-SPEC indented according to level. The indentaion is two spaces per parent." (let ((level (length (buttercup-suite-or-spec-parents suite-or-spec)))) (concat (make-string (* 2 level) ?\s) (buttercup-suite-or-spec-description suite-or-spec)))) (defun buttercup--spec-mark-pending (spec description &optional description-for-now) "Mark SPEC as pending with DESCRIPTION. If DESCRIPTION-FOR-NOW is non-nil, set the spec `pending-description' to that value for now, it will be reset to DESCRIPTION when the spec is run. Return SPEC." (setf (buttercup-spec-function spec) (lambda () (signal 'buttercup-pending description)) (buttercup-spec-status spec) 'pending) (when description-for-now (setf (buttercup-spec-failure-description spec) description-for-now)) spec) ;;;;;;;;;;;;;;;;;;;; ;;; Suites: describe (defvar buttercup-suites nil "The list of all currently defined Buttercup suites.") (defvar buttercup--current-suite nil "The suite currently being defined. Do not set this globally. It is let-bound by the `describe' form.") (defmacro describe (description &rest body) "Describe a test suite. DESCRIPTION is a string. BODY is a sequence of instructions, mainly calls to `describe', `it' and `before-each'." (declare (indent 1) (debug (&define sexp def-body))) (unless lexical-binding (signal 'buttercup-dynamic-binding-error "buttercup requires `lexical-binding' to be t")) (let ((new-body (cond ((eq (elt body 0) :var) `((let ,(elt body 1) ,@(cddr body)))) ((eq (elt body 0) :var*) `((let* ,(elt body 1) ,@(cddr body)))) (t body)))) (if (or (memq :var new-body) (memq :var* new-body)) `(error "buttercup: :var(*) found in invalid position of describe form \"%s\"" ,description) `(buttercup-describe ,description (lambda () ,@new-body))))) (defun buttercup-describe (description body-function) "Function to handle a `describe' form. DESCRIPTION has the same meaning as in `describe'. BODY-FUNCTION is a function containing the body instructions passed to `describe'." (let* ((enclosing-suite buttercup--current-suite) (buttercup--current-suite (make-buttercup-suite :description description))) (condition-case nil (funcall body-function) (buttercup-pending (setf (buttercup-suite-status buttercup--current-suite) 'pending))) (if enclosing-suite (buttercup-suite-add-child enclosing-suite buttercup--current-suite) ;; At top level, warn about duplicate spec names (let ((dups (buttercup--find-duplicate-spec-names (list buttercup--current-suite)))) (when dups ;; TODO: Use `buttercup--warn' (display-warning 'buttercup (format "Found duplicate spec names in suite: %S" (delete-dups dups))))) (setq buttercup-suites (append buttercup-suites (list buttercup--current-suite))) buttercup--current-suite))) ;;;;;;;;;;;;; ;;; Specs: it (defmacro it (description &rest body) "Define a spec. DESCRIPTION is a string. BODY is a sequence of instructions, most probably including one or more calls to `expect'." (declare (indent 1) (debug (&define sexp def-body))) (if body `(buttercup-it ,description (lambda () (buttercup-with-converted-ert-signals ,@body))) `(buttercup-xit ,description))) (defun buttercup-it (description body-function) "Function to handle an `it' form. DESCRIPTION has the same meaning as in `it'. BODY-FUNCTION is a function containing the body instructions passed to `it'. Return the created spec object." (declare (indent 1)) (when (not buttercup--current-suite) (error "`it' has to be called from within a `describe' form")) (buttercup-suite-add-child buttercup--current-suite (make-buttercup-spec :description description :function body-function))) ;;;;;;;;;;;;;;;;;;;;;; ;;; Setup and Teardown (defmacro before-each (&rest body) "Run BODY before each spec in the current suite." (declare (indent 0) (debug (&define def-body))) `(buttercup-before-each (lambda () ,@body))) (defun buttercup-before-each (function) "The function to handle a `before-each' form. FUNCTION is a function containing the body instructions passed to `before-each'." (setf (buttercup-suite-before-each buttercup--current-suite) (append (buttercup-suite-before-each buttercup--current-suite) (list function)))) (defmacro after-each (&rest body) "Run BODY after each spec in the current suite." (declare (indent 0) (debug (&define def-body))) `(buttercup-after-each (lambda () ,@body))) (defun buttercup-after-each (function) "The function to handle an `after-each' form. FUNCTION is a function containing the body instructions passed to `after-each'." (setf (buttercup-suite-after-each buttercup--current-suite) (append (buttercup-suite-after-each buttercup--current-suite) (list function)))) (defmacro before-all (&rest body) "Run BODY before every spec in the current suite." (declare (indent 0) (debug (&define def-body))) `(buttercup-before-all (lambda () ,@body))) (defun buttercup-before-all (function) "The function to handle a `before-all' form. FUNCTION is a function containing the body instructions passed to `before-all'." (setf (buttercup-suite-before-all buttercup--current-suite) (append (buttercup-suite-before-all buttercup--current-suite) (list function)))) (defmacro after-all (&rest body) "Run BODY after every spec in the current suite." (declare (indent 0) (debug (&define def-body))) `(buttercup-after-all (lambda () ,@body))) (defun buttercup-after-all (function) "The function to handle an `after-all' form. FUNCTION is a function containing the body instructions passed to `after-all'." (setf (buttercup-suite-after-all buttercup--current-suite) (append (buttercup-suite-after-all buttercup--current-suite) (list function)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Disabled Suites: xdescribe (defun buttercup--disable-specs (forms) "Process FORMS to make any suites or specs pending." (when (eq (car forms) :var) (setq forms (cddr forms))) (let (retained) (dolist (form forms (nreverse retained)) (pcase form ;; Make it pending by just keeping the description (`(it ,description . ,_) (push (list 'it description) retained)) (`(xit ,description . ,_) (push (list 'it description) retained)) ;; Just make nested describes into xdescribes and handle them ;; in another macro invocation (`(describe . ,tail) (push (cons 'xdescribe tail) retained)) (`(xdescribe . ,tail) (push (cons 'xdescribe tail) retained)) ;; Special case to ignore before-* and after-* forms (`(before-each . ,_)) ; nop (`(after-each . ,_)) ; nop (`(before-all . ,_)) ; nop (`(after-all . ,_)) ; nop ;; Any list starting with a list, like a let varlist. ((and (pred consp) ls (guard (consp (car ls)))) (dolist (elt (buttercup--disable-specs ls)) (push elt retained))) ;; Any function call list (`(,_ . ,tail) (dolist (elt (buttercup--disable-specs tail)) (push elt retained))) ;; non-cons items ((and elt (guard (not (consp elt))))) ; nop (_ (error "Unrecognized form in `xdescribe': `%s'" (pp-to-string form))) )))) (defmacro xdescribe (description &rest body) "Like `describe', but mark any specs as disabled. DESCRIPTION is a string. BODY is a sequence of instructions, mainly calls to `describe', `it' and `before-each'." (declare (indent 1)) `(describe ,description ,@(buttercup--disable-specs body) ;; make sure the suite is marked as pending (signal 'buttercup-pending "PENDING"))) ;;;;;;;;;;;;;;;;;;;;;; ;;; Pending Specs: xit (defmacro xit (description &rest body) "Like `it', but mark the spec as disabled. A disabled spec is not run. DESCRIPTION is a string. BODY is ignored." (declare (indent 1)) (ignore body) `(buttercup-xit ,description)) (defun buttercup-xit (description &optional function) "Like `buttercup-it', but mark the spec as disabled. A disabled spec is not run. DESCRIPTION has the same meaning as in `xit'. FUNCTION is ignored. Return the created spec object." (declare (indent 1)) (let ((spec (buttercup-it description (or function #'ignore)))) (buttercup--spec-mark-pending spec "PENDING" ""))) ;;;;;;;;; ;;; Spies (defvar buttercup--spy-contexts (make-hash-table :test 'eq :weakness 'key) "A mapping of currently-defined spies to their contexts.") ;; The base struct has no constructor so a factory function ;; `make-spy-context' masquerading as a constructor can be defined ;; later. (cl-defstruct (spy-context (:constructor nil)) args current-buffer) (cl-defstruct (spy-context-return (:include spy-context) (:conc-name spy-context--return-)) value) (cl-defstruct (spy-context-thrown (:include spy-context) (:conc-name spy-context--thrown-)) signal) (cl-defun make-spy-context (&key args current-buffer (return-value nil has-return-value) (thrown-signal nil has-thrown-signal)) "Constructor for objects of type spy-context. ARGS is the argument list of the called function. CURRENT-BUFFER is the buffer that was current when the spy was called. RETURN-VALUE is the returned value, if any. THROWN-SIGNAL is the signal raised by the function, if any. Only one of RETURN-VALUE and THROWN-SIGNAL may be given. Giving none of them is equivalent to `:return-value nil'. \(fn &key ARGS CURRENT-BUFFER RETURN-VALUE THROWN-SIGNAL)" (cond ((and has-return-value has-thrown-signal) (error "Only one of :return-value and :thrown-signal may be given")) (has-thrown-signal (make-spy-context-thrown :args args :current-buffer current-buffer :signal thrown-signal)) (t (make-spy-context-return :args args :current-buffer current-buffer :value return-value)))) (defun spy-context-return-value (context) "Access slot \"return-value\" of `spy-context' struct CONTEXT." (unless (spy-context-return-p context) (error "Not a returning context")) (spy-context--return-value context)) (defun spy-context-thrown-signal (context) "Access slot \"thrown-signal\" of `spy-context' struct CONTEXT." (unless (spy-context-thrown-p context) (error "Not a signal-raising context")) (spy-context--thrown-signal context)) (defun spy-on (symbol &optional keyword arg) "Create a spy (mock) for the function SYMBOL. The spy will track call information that can be queried with the :to-have-been-called matchers. The default spy will always return nil, but that can be changed by setting KEYWORD to one of: :and-call-through -- call the original function. :and-return-value -- return ARG. :and-call-fake -- call ARG, a function that matches SYMBOL. :and-throw-error -- Signal ARG without arguments. If the original function was a command, the generated spy will also be a command with the same interactive form, unless `:and-call-fake' is used, in which case it is the caller's responsibility to ensure ARG is a command." ;; We need to load an autoloaded function before spying on it (when (autoloadp (and (fboundp symbol) (symbol-function symbol))) (autoload-do-load (symbol-function symbol) symbol)) (cl-assert (not (autoloadp (and (fboundp symbol) (symbol-function symbol))))) (let* ((orig (and (fboundp symbol) (symbol-function symbol))) (orig-intform (interactive-form orig)) (replacement (pcase keyword (:and-call-through (when arg (error "`spy-on' with `:and-call-through' does not take an ARG")) `(lambda (&rest args) ,orig-intform (apply ',orig args))) (:and-return-value `(lambda (&rest args) ,orig-intform ',arg)) (:and-call-fake (let ((replacement-intform (interactive-form arg))) (when (and replacement-intform (not (equal orig-intform replacement-intform))) (display-warning 'buttercup (format "While spying on `%S': replacement does not have the same interactive form" symbol))) `(lambda (&rest args) ,(or replacement-intform orig-intform) (apply (function ,arg) args)))) (:and-throw-error `(lambda (&rest args) ,orig-intform (signal ',(or arg 'error) "Stubbed error"))) ;; No keyword: just spy (`nil (when arg (error "`spy-on' with no KEYWORD does not take an ARG")) `(lambda (&rest args) ,orig-intform nil)) (_ (error "Invalid `spy-on' keyword: `%S'" keyword))))) (unless (buttercup--spy-on-and-call-replacement symbol replacement) (error "Spies can only be created in `before-each' or `it'")))) (defun buttercup--spy-on-and-call-replacement (spy fun) "Replace the function in symbol SPY with a spy calling FUN." (let ((orig-function (and (fboundp spy) (symbol-function spy)))) (when (buttercup--add-cleanup (lambda () (fset spy orig-function))) (fset spy (buttercup--make-spy fun))))) (defun buttercup--make-spy (fun) "Create a new spy function wrapping FUN and tracking every call to itself." (let (this-spy-function) (setq this-spy-function (lambda (&rest args) (let ((returned nil) (return-value nil)) (condition-case err (progn (setq return-value (apply fun args) returned t) (buttercup--spy-calls-add this-spy-function (make-spy-context :args args :return-value return-value :current-buffer (current-buffer))) return-value) (error ;; If returned is non-nil, then the error we caught ;; didn't come from FUN, so we shouldn't record it. (unless returned (buttercup--spy-calls-add this-spy-function (make-spy-context :args args :thrown-signal err :current-buffer (current-buffer)))) ;; Regardless, we only caught this error in order to ;; record it, so we need to re-throw it. (signal (car err) (cdr err))))))) ;; Add the interactive form from `fun', if any (when (interactive-form fun) (setq this-spy-function `(lambda (&rest args) ,(interactive-form fun) (apply ',this-spy-function args)))) this-spy-function)) (defvar buttercup--cleanup-functions :inactive "Stack of cleanup operations. Should always be set to a value that is not `listp', except while in a `buttercup-with-cleanup' environment.") (defvar native-comp-enable-subr-trampolines) (defvar comp-enable-subr-trampolines) (defmacro buttercup-with-cleanup (&rest body) "Execute BODY, cleaning spys and the rest afterwards." `(,@(if (fboundp 'with-suppressed-warnings) '(with-suppressed-warnings ((obsolete comp-enable-subr-trampolines))) '(progn)) (let ((buttercup--cleanup-functions nil) ;; Redefining certain primitive's trampolines will cause problems, ;; see https://github.com/jorgenschaefer/emacs-buttercup/issues/230 and ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=61880 (comp-enable-subr-trampolines nil) (native-comp-enable-subr-trampolines nil)) (unwind-protect (progn ,@body) (dolist (fun buttercup--cleanup-functions) (ignore-errors (funcall fun))))))) (defun buttercup--add-cleanup (function) "Register FUNCTION for cleanup in `buttercup-with-cleanup'." (when (listp buttercup--cleanup-functions) (setq buttercup--cleanup-functions (cons function buttercup--cleanup-functions)))) (defun spy-calls-all (spy) "Return all call contexts for SPY." (gethash (symbol-function spy) buttercup--spy-contexts)) (defun buttercup--spy-calls-add (spy-function context) "Add CONTEXT to the call records for SPY-FUNCTION." (puthash spy-function (append (gethash spy-function buttercup--spy-contexts) (list context)) buttercup--spy-contexts)) (defun spy-calls-reset (spy) "Reset SPY, removing all stored contexts." (puthash (symbol-function spy) nil buttercup--spy-contexts)) (defun spy-calls-any (spy) "Return t iff SPY has been called at all, nil otherwise." (if (spy-calls-all spy) t nil)) (defun spy-calls-count (spy) "Return the number of times SPY has been called so far." (length (spy-calls-all spy))) (defun spy-calls-count-returned (spy) "Return the number of times SPY has been called successfully so far." (cl-count-if #'spy-context-return-p (spy-calls-all spy))) (defun spy-calls-count-errors (spy) "Return the number of times SPY has been called and thrown errors so far." (cl-count-if #'spy-context-thrown-p (spy-calls-all spy))) (defun spy-calls-args-for (spy index) "Return the context of the INDEXth call to SPY." (let ((context (elt (spy-calls-all spy) index))) (if context (spy-context-args context) nil))) (defun spy-calls-all-args (spy) "Return the arguments for every recorded call to SPY." (mapcar #'spy-context-args (spy-calls-all spy))) (defun spy-calls-most-recent (spy) "Return the context of the most recent call to SPY." (car (last (spy-calls-all spy)))) (defun spy-calls-first (spy) "Return the context of the first call to SPY." (car (spy-calls-all spy))) ;;;;;;;;;;;;;;;; ;;; Test Runners ;; These variables are generally used in the test runners, but set ;; elsewhere. They must be defined here before their first use. (defvar buttercup-reporter #'buttercup-reporter-adaptive "The reporter function for buttercup test runs. During a run of buttercup, the value of this variable is called as a function with two arguments. The first argument is a symbol describing the event, the second depends on the event. The following events are known: buttercup-started -- The test run is starting. The argument is a list of suites this run will execute. suite-started -- A suite is starting. The argument is the suite. See `make-buttercup-suite' for details on this structure. spec-started -- A spec in is starting. The argument is the spec. See `make-buttercup-spec' for details on this structure. spec-done -- A spec has finished executing. The argument is the spec. suite-done -- A suite has finished. The argument is the suite. buttercup-done -- All suites have run, the test run is over. The argument is the list of executed suites.") (defvar buttercup-stack-frame-style (car '(crop full pretty)) "Style to use when printing stack traces of tests. `full' is roughly the same style as normal Emacs stack traces: print each stack frame in full with no line breaks. `crop' is like full, but truncates each line to 80 characters. `pretty' uses `pp' to generate a multi-line indented representation of each frame, and prefixes each stack frame with lambda or M to indicate whether it represents a normal evaluated function call or a macro/special form.") (defvar buttercup-color (let ((no-color (getenv "NO_COLOR"))) (or (not no-color) (string= no-color ""))) "Whether to use colors in output. Will be nil if the `NO_COLOR' environment variable is set to any value \(see URL https://no-color.org/).") (defconst buttercup-warning-buffer-name " *Buttercup-Warnings*" "Buffer name used to collect warnings issued while running a spec. A buffer with this name should only exist while running a test spec, and should be killed after running the spec.") ;; predeclaration (defvar buttercup-reporter-batch-quiet-statuses) ;;;###autoload (defun buttercup-run-at-point () "Run the buttercup suite at point." (interactive) (let ((buttercup-suites nil) (lexical-binding t)) (save-selected-window (eval-defun nil) (buttercup-run)) (message "Suite executed successfully"))) ;;;###autoload (defun buttercup-run-discover () "Discover and load test files, then run all defined suites. Takes directories as command line arguments, defaulting to the current directory." (setq backtrace-on-error-noninteractive nil) (let ((dirs nil) (patterns nil) (args command-line-args-left) failed-files-suite) (while args (cond ((equal (car args) "--") (setq args (cdr args))) ((member (car args) '("--traceback")) (when (not (cdr args)) (error "Option requires argument: %s" (car args))) ;; Make sure it's a valid style by trying to format a dummy ;; frame with it (buttercup--format-stack-frame '(t myfun 1 2) (intern (cadr args))) (setq buttercup-stack-frame-style (intern (cadr args))) (setq args (cddr args))) ((member (car args) '("-p" "--pattern")) (when (not (cdr args)) (error "Option requires argument: %s" (car args))) (push (cadr args) patterns) (setq args (cddr args))) ((member (car args) '("-c" "--no-color")) (setq buttercup-color nil) (setq args (cdr args))) ((equal (car args) "--no-skip") (push 'skipped buttercup-reporter-batch-quiet-statuses) (push 'disabled buttercup-reporter-batch-quiet-statuses) (setq args (cdr args))) ((equal (car args) "--only-error") (push 'pending buttercup-reporter-batch-quiet-statuses) (push 'passed buttercup-reporter-batch-quiet-statuses) (setq args (cdr args))) ((equal (car args) "--stale-file-error") (buttercup-error-on-stale-elc) (setq args (cdr args))) (t (push (car args) dirs) (setq args (cdr args))))) (setq command-line-args-left nil) (setq failed-files-suite (make-buttercup-suite :description "File failed to load correctly:")) (dolist (dir (or dirs '("."))) (dolist (file (directory-files-recursively dir "\\`test-.*\\.el\\'\\|-tests?\\.el\\'")) ;; Exclude any hidden directory, both immediate (^.) and nested (/.) subdirs (when (not (string-match "\\(^\\|/\\)\\." (file-relative-name file))) (buttercup--load-test-file file failed-files-suite)))) (when patterns (buttercup-mark-skipped patterns t)) (when (buttercup-suite-children failed-files-suite) ;; At least one file has failed to load, add the ;; failed-files-suite to the end(?) of the suite list (setq buttercup-suites (append buttercup-suites (list failed-files-suite))))) (buttercup-run)) (defun buttercup--load-test-file (file failure-suite) "Load FILE keeping track of failures. If an error is raised by `load', store the error information in a spec and add it to FAILURE-SUITE." (cl-destructuring-bind (status description stack) (buttercup--funcall #'load file nil t) (when (eq status 'failed) (if (memq (cl-caadr description) '(buttercup-dynamic-binding-error end-of-file)) (setq stack nil) ;; Skip all of stack until load is called (while (not (eq (nth 1 (car stack)) 'load)) (pop stack))) (buttercup-suite-add-child failure-suite (make-buttercup-spec :description file :status 'failed :failure-description (error-message-string (cadr description)) :failure-stack stack :function (lambda () (ignore))))))) (defun buttercup-mark-skipped (matcher &optional reverse) "Mark any spec that match MATCHER as skipped. MATCHER can be either a regex, a list of regexes, or a function taking a spec as the single argument. If REVERSE is non-nil, specs will be marked as pending when MATCHER does not match." (cl-etypecase matcher (string (buttercup--mark-skipped buttercup-suites (lambda (spec) (string-match matcher (buttercup-spec-full-name spec))) reverse)) (function (buttercup--mark-skipped buttercup-suites matcher reverse)) (list (cond ((cl-every #'stringp matcher) (buttercup-mark-skipped (mapconcat (lambda (re) (concat "\\(?:" re "\\)")) matcher "\\|") reverse)) (t (error "Bad matcher list: %s, should be list of strings" matcher)))))) (defun buttercup--mark-skipped (suites predicate &optional reverse-predicate) "Mark all specs in SUITES as skipped if PREDICATE(spec) is true. If REVERSE-PREDICATE is non-nil, mark spec where PREDICATE(spec) is false." (dolist (spec (buttercup--specs suites)) ;; cond implements (xor reverse-predicate (funcall predicate ;; spec)) as xor is introduced in Emacs 27 (when (cond ((not reverse-predicate) (funcall predicate spec)) ((not (funcall predicate spec)) reverse-predicate)) (buttercup--spec-mark-pending spec "SKIPPED")))) ;;;###autoload (defun buttercup-run-markdown-buffer (&rest markdown-buffers) "Run all test suites defined in MARKDOWN-BUFFERS. A suite must be defined within a Markdown \"lisp\" code block. If MARKDOWN-BUFFERS is empty (nil), use the current buffer." (interactive) (unless markdown-buffers (setq markdown-buffers (list (current-buffer)))) (let ((lisp-buffer (generate-new-buffer "elisp")) (case-fold-search t) code buttercup-suites) (dolist (markdown-buffer markdown-buffers) (with-current-buffer markdown-buffer (save-excursion (save-match-data (goto-char (point-min)) (while (re-search-forward "```\\(?:emacs-\\|e\\)?lisp\n\\(\\(?:.\\|\n\\)*?\\)```" nil t) (setq code (match-string 1)) (with-current-buffer lisp-buffer (insert code))))))) (with-current-buffer lisp-buffer (setq lexical-binding t) (eval-region (point-min) (point-max))) (buttercup-run))) ;;;###autoload (defun buttercup-run-markdown () "Run all test suites defined in Markdown files passed as arguments. A suite must be defined within a Markdown \"lisp\" code block." (setq backtrace-on-error-noninteractive nil) (apply #'buttercup-run-markdown-buffer (mapcar #'find-file-noselect command-line-args-left))) ;;;###autoload (defun buttercup-run-markdown-file (file) "Run all test suites defined in Markdown FILE. A suite must be defined within a Markdown \"lisp\" code block." (interactive "fMarkdown file: ") (buttercup-run-markdown-buffer (find-file-noselect file))) (eval-when-compile ;; Defined below in a dedicated section (defvar buttercup-reporter)) (defun buttercup-run (&optional noerror) "Run all described suites. Signal an error if any spec fail or if no suites have been defined. Signal no errors if NOERROR is non-nil. Return t if all specs pass, nil if at least one spec fail, and :no-suites if no suites have been defined." (if buttercup-suites (buttercup--run-suites buttercup-suites noerror) (or (and noerror :no-suites) (error "No suites defined")))) (define-error 'buttercup-run-specs-failed "buttercup-run failed" 'buttercup-error-base) (defun buttercup--run-suites (suites &optional noerror) "Run a list of SUITES. Signal a `buttercup-run-specs-failed` error if any spec fail, unless NOERROR is non-nil. Return t if all specs pass, nil if at least one spec fail." (funcall buttercup-reporter 'buttercup-started suites) (mapc #'buttercup--run-suite suites) (funcall buttercup-reporter 'buttercup-done suites) (or (zerop (buttercup-suites-total-specs-failed suites)) (not (or noerror (signal 'buttercup-run-specs-failed '("")))))) (defvar buttercup--before-each nil "A list of functions to call before each spec. Do not change the global value.") (defvar buttercup--after-each nil "A list of functions to call after each spec. Do not change the global value.") (defun buttercup--run-suite (suite) "Run SUITE. A suite is a sequence of suites and specs." (buttercup--set-start-time suite) (let* ((buttercup--before-each (append buttercup--before-each (buttercup-suite-before-each suite))) (buttercup--after-each (append (buttercup-suite-after-each suite) buttercup--after-each))) (funcall buttercup-reporter 'suite-started suite) (dolist (f (buttercup-suite-before-all suite)) (buttercup--update-with-funcall suite f)) (dolist (sub (buttercup-suite-children suite)) (cond ((buttercup-suite-p sub) (buttercup--run-suite sub)) ((buttercup-spec-p sub) (buttercup--run-spec sub)))) (dolist (f (buttercup-suite-after-all suite)) (buttercup--update-with-funcall suite f)) (buttercup--set-end-time suite) (funcall buttercup-reporter 'suite-done suite))) (defun buttercup--run-spec (spec) "Run SPEC." (buttercup--set-start-time spec) (unwind-protect (progn ;; Kill any previous warning buffer, just in case (when (get-buffer buttercup-warning-buffer-name) (kill-buffer buttercup-warning-buffer-name)) (get-buffer-create buttercup-warning-buffer-name) (funcall buttercup-reporter 'spec-started spec) (buttercup-with-cleanup (dolist (f buttercup--before-each) (buttercup--update-with-funcall spec f)) (buttercup--update-with-funcall spec (buttercup-spec-function spec)) (dolist (f buttercup--after-each) (buttercup--update-with-funcall spec f))) (funcall buttercup-reporter 'spec-done spec) ;; Display warnings that were issued while running the the ;; spec, if any (with-current-buffer buttercup-warning-buffer-name (when (string-match-p "[^[:space:]\n\r]" (buffer-string)) (buttercup--print "%s\n" (buttercup-colorize ;; Any terminating newline in the buffer should not be ;; colorized. It would mess up color handling in Emacs ;; compilation buffers using ;; `ansi-color-apply-on-region' in ;; `compilation-filter-hook'. (buffer-substring (point-min) (save-excursion (goto-char (1- (point-max))) (if (looking-at-p "\n") (point) (point-max)))) 'yellow))))) (when (get-buffer buttercup-warning-buffer-name) (kill-buffer buttercup-warning-buffer-name)) (buttercup--set-end-time spec))) (defun buttercup--update-with-funcall (suite-or-spec function &rest args) "Update SUITE-OR-SPEC with the result of calling FUNCTION with ARGS. Sets the `status', `failure-description', and `failure-stack' for failed and pending specs." (let* ((result (apply #'buttercup--funcall function args)) (status (elt result 0)) (description (elt result 1)) (stack (elt result 2))) (when (eq status 'failed) (pcase description (`(error (buttercup-failed . ,failure-description)) (setq description failure-description)) (`(error (buttercup-pending . ,pending-description)) (setq status 'pending description pending-description)))) ;; Only change state when the new state is 'worse' than or same as ;; the current state. The constant list is the prioritized list of ;; states. The new state is worse if it is in the tail of the ;; current state. (when (memq status (memq (buttercup-suite-or-spec-status suite-or-spec) '(passed pending failed))) (setf (buttercup-suite-or-spec-status suite-or-spec) status (buttercup-suite-or-spec-failure-description suite-or-spec) description (buttercup-suite-or-spec-failure-stack suite-or-spec) stack)))) ;;;;;;;;;;;;; ;;; Reporters (defun buttercup-reporter-adaptive (event arg) "A reporter that handles both interactive and noninteractive sessions. Calls either `buttercup-reporter-batch' or `buttercup-reporter-interactive', depending. EVENT and ARG are described in `buttercup-reporter'." (if noninteractive (buttercup-reporter-batch event arg) (buttercup-reporter-interactive event arg))) (defvar buttercup-reporter-batch--start-time nil "The time the last batch report started.") (defvar buttercup-reporter-batch--failures nil "List of failed specs of the current batch report.") (defvar buttercup-reporter-batch-quiet-statuses nil "Do not print results for any spec with any of the listed statuses.") (defvar buttercup-reporter-batch--suite-stack nil "Stack of unprinted suites.") (defun buttercup-reporter-batch--quiet-spec-p (spec) "Return non-nil if the status of SPEC is any of the quiet statuses. SPEC is considered quiet if its status is listed in `buttercup-reporter-batch-quiet-statuses'. Two special statuses can be listed in `buttercup-reporter-batch-quiet-statuses'; `skipped': Real spec status `pending' and failure description \"SKIPPED\". This matches specs filtered out with `buttercup-mark-skipped'. `disabled': Real spec status `pending' and failure description \"PENDING\". This matches specs disabled with `xit' or equivalent." (or (memq (buttercup-spec-status spec) buttercup-reporter-batch-quiet-statuses) ;; check for the virtual status `skipped' (and (memq 'skipped buttercup-reporter-batch-quiet-statuses) (eq (buttercup-spec-status spec) 'pending) (string= (buttercup-spec-failure-description spec) "SKIPPED")) ;; check for the virtual status `disabled' (and (memq 'disabled buttercup-reporter-batch-quiet-statuses) (eq (buttercup-spec-status spec) 'pending) (string= (buttercup-spec-failure-description spec) "PENDING")) )) (defun buttercup--reporter-batch-preprint-spec-p (spec) "Return non-nil if the SPEC description should be printed at `spec-started'." (not (or buttercup-reporter-batch-quiet-statuses ;; Do not 'pre-print' in github actions unless color is ;; disabled. See #181. (and (getenv "GITHUB_ACTION") buttercup-color) (and buttercup-color (string-match-p "[\n\v\f]" (buttercup-spec-description spec)))))) (defun buttercup-reporter-batch (event arg) "A reporter that handles batch sessions. EVENT and ARG are described in `buttercup-reporter'." (let ((print-escape-newlines t) (print-escape-nonascii t)) (pcase event (`buttercup-started (setq buttercup-reporter-batch--start-time (current-time) buttercup-reporter-batch--failures nil buttercup-reporter-batch--suite-stack nil) (let ((defined (buttercup-suites-total-specs-defined arg)) (pending (buttercup-suites-total-specs-pending arg))) (if (> pending 0) (buttercup--print "Running %s out of %s specs.\n\n" (- defined pending) defined) (buttercup--print "Running %s specs.\n\n" defined)))) (`suite-started (if buttercup-reporter-batch-quiet-statuses (push arg buttercup-reporter-batch--suite-stack) (buttercup--print "%s\n" (buttercup--indented-description arg)))) (`spec-started (when (buttercup--reporter-batch-preprint-spec-p arg) (buttercup--print "%s" (buttercup--indented-description arg)))) (`spec-done ;; When printing has been held back but we will print the ;; result of this spec, print the all of the containing suite ;; descriptions that have been held back (when (and buttercup-reporter-batch-quiet-statuses (not (buttercup-reporter-batch--quiet-spec-p arg))) (dolist (suite (nreverse buttercup-reporter-batch--suite-stack)) (buttercup--print "%s\n" (buttercup--indented-description suite))) (setq buttercup-reporter-batch--suite-stack nil) ;; Also print the spec description unless it should not be preprinted (unless (buttercup--reporter-batch-preprint-spec-p arg) (buttercup--print "%s" (buttercup--indented-description arg)))) ;; print the result of the spec. This should erase any ;; non-colored spec text. (unless (buttercup-reporter-batch--quiet-spec-p arg) (buttercup-reporter-batch--print-spec-done-line arg buttercup-color)) (when (eq (buttercup-spec-status arg) 'failed) (setq buttercup-reporter-batch--failures (append buttercup-reporter-batch--failures (list arg))))) (`suite-done (when (= 0 (length (buttercup-suite-or-spec-parents arg))) (if buttercup-reporter-batch-quiet-statuses (unless buttercup-reporter-batch--suite-stack (buttercup--print "\n")) (buttercup--print "\n"))) (pop buttercup-reporter-batch--suite-stack)) (`buttercup-done (dolist (failed buttercup-reporter-batch--failures) (buttercup-reporter-batch--print-failed-spec-report failed buttercup-color)) (buttercup-reporter-batch--print-summary arg buttercup-color)) (_ (error "Unknown event %s" event))))) (defun buttercup-reporter-batch--print-spec-done-line (spec color) "Print the remainder of the SPEC report line for `spec-done'. If COLOR is non-nil, erase the text so far on the current line using '\\r' and replace it with the same text colored according to the SPEC status. Do not erase and replace if the text would have been reprinted with the default color. Then print the SPEC failure description except if the status is `passed'. If COLOR is non-nil, print it in the aproprate color for the spec status. Finally print the elapsed time for SPEC." (let* ((status (buttercup-spec-status spec)) (failure (buttercup-spec-failure-description spec))) ;; Failed specs do typically not have string filure-descriptions. ;; In this typical case, use the string "FAILED" for the output. (and (eq status 'failed) (not (stringp failure)) (setq failure "FAILED")) (unless (memq status '(passed pending failed)) (error "Unknown spec status %s" status)) ;; Special status in this function; ;; skipped - a pending spec with failure description "SKIPPED". (and (eq status 'pending) (equal failure "SKIPPED") (setq status 'skipped)) ;; Use color both as a boolean for erase-and-reprint and the color ;; to use. nil means the default color. (setq color (and color (pcase status (`passed 'green) (`pending 'yellow) (`failed 'red) (`skipped nil)))) (when color ;; Clear the line if (when (or buttercup-reporter-batch-quiet-statuses (buttercup--reporter-batch-preprint-spec-p spec)) ;; Carriage returns (\r) should not be colorized. It would mess ;; up color handling in Emacs compilation buffers using ;; `ansi-color-apply-on-region' in `compilation-filter-hook'. (buttercup--print "\r")) (buttercup--print "%s" (buttercup-colorize (buttercup--indented-description spec) color))) (unless (eq 'passed status) (buttercup--print "%s" (buttercup-colorize (concat " " failure) color))) (buttercup--print " (%s)\n" (buttercup-elapsed-time-string spec)))) (cl-defun buttercup-reporter-batch--print-failed-spec-report (failed-spec color) "Print a failure report for FAILED-SPEC. Colorize parts of the output if COLOR is non-nil." (when (eq buttercup-stack-frame-style 'omit) (cl-return-from buttercup-reporter-batch--print-failed-spec-report)) (let ((description (buttercup-spec-failure-description failed-spec)) (stack (buttercup-spec-failure-stack failed-spec)) (full-name (buttercup-spec-full-name failed-spec))) (if color (setq full-name (buttercup-colorize full-name 'red))) (buttercup--print "%s\n" (make-string 40 ?=)) (buttercup--print "%s\n" full-name) (when stack (buttercup--print "\nTraceback (most recent call last):\n") (dolist (frame stack) (let ((frame-text (buttercup--format-stack-frame frame))) (buttercup--print "%s\n" frame-text)))) (cond ((stringp description) (buttercup--print "%s: %s\n" (if color (buttercup-colorize "FAILED" 'red) "FAILED") description)) ((and (consp description) (eq (car description) 'error)) (buttercup--print "%S: %S\n" (car description) (cadr description))) (t (buttercup--print "FAILED: %S\n" description))) (buttercup--print "\n"))) (defun buttercup-reporter-batch--print-summary (suites color) "Print a summary of the reults of SUITES. Colorize parts of the output if COLOR is non-nil." (let* ((defined (buttercup-suites-total-specs-defined suites)) (pending (buttercup-suites-total-specs-pending suites)) (failed (buttercup-suites-total-specs-failed suites)) (duration (seconds-to-string (float-time (time-subtract (current-time) buttercup-reporter-batch--start-time)))) (out-of (if (zerop pending) "" (format " out of %d" defined))) (failed-str (format "%d failed" failed))) (if color (setq failed-str (buttercup-colorize failed-str (if (zerop failed) 'green 'red)))) (buttercup--print "Ran %d%s specs, %s, in %s.\n" (- defined pending) out-of failed-str duration))) (defun buttercup--print (fmt &rest args) "Format a string and send it to terminal without alteration. FMT and ARGS are passed to `format'." (send-string-to-terminal (apply #'format fmt args))) (defun buttercup--display-warning (fn type message &optional level buffer-name &rest args) "Log all warnings to a special buffer while running buttercup specs. Emacs' normal display logic for warnings doesn't mix well with buttercup, for several reasons. So instead, while a buttercup test is running, BUFFER-NAME defaults to a special buffer that exists only during the test (see `buttercup-warning-buffer-name'). When logging to this buffer, `warning-minimum-level' is set to `:emergency' and the `message' function is disabled to suppress display of all warning messages. The contents of this buffer are then displayed after the test finishes." (when (and (null buffer-name) buttercup-warning-buffer-name (get-buffer buttercup-warning-buffer-name)) (setq buffer-name buttercup-warning-buffer-name)) (if (equal buffer-name buttercup-warning-buffer-name) (cl-letf ((warning-minimum-level :emergency) ((symbol-function 'message) 'ignore)) (apply fn type message level buffer-name args)) (apply fn type message level buffer-name args))) (advice-add 'display-warning :around #'buttercup--display-warning) (defconst buttercup-colors '((black . 30) (red . 31) (green . 32) (yellow . 33) (blue . 34) (magenta . 35) (cyan . 36) (white . 37)) "List of text colors.") (defmacro buttercup-suppress-warning-capture (&rest body) "Suppress Buttercup's warning capturing within BODY. Buttercup normally captures all warnings while a test is running so it can defer displaying them until after the test is complete. However, if you want to catch any warnings yourself as part of the test, you need to wrap your code in this macro to suppress the capturing behavior." (declare (indent 0)) `(let ((buttercup-warning-buffer-name nil)) ,@body)) (defun buttercup-colorize (string color) "Format STRING with COLOR. Return STRING unmodified if COLOR is nil." (if (and color buttercup-color) (let ((color-code (cdr (assq color buttercup-colors)))) (format "\e[%sm%s\e[0m" color-code string)) string)) (defun buttercup-reporter-interactive (event arg) "Reporter for interactive sessions. EVENT and ARG are described in `buttercup-reporter'." ;; This is a bit rudimentary ... (with-current-buffer (get-buffer-create "*Buttercup*") (let ((old-print (symbol-function 'buttercup--print)) (buf (current-buffer)) (inhibit-read-only t)) (when (eq event 'buttercup-started) (erase-buffer) (special-mode) (display-buffer (current-buffer))) (fset 'buttercup--print (lambda (fmt &rest args) (with-current-buffer buf (let ((inhibit-read-only t)) (goto-char (point-max)) (insert (apply #'format fmt args)))))) (unwind-protect (let ((buttercup-color)) (buttercup-reporter-batch event arg)) (fset 'buttercup--print old-print))) (let ((w (get-buffer-window (current-buffer)))) (when w (with-selected-window w (goto-char (point-max))))))) ;;;;;;;;;;;;; ;;; Utilities (defun buttercup--funcall (function &rest arguments) "Call FUNCTION with ARGUMENTS. Returns a list of three values. The first is the state: passed -- The second value is the return value of the function call, the third is nil. failed -- The second value is the description of the expectation which failed or the error, the third is the backtrace or nil." (catch 'buttercup-debugger-continue (let ((debugger #'buttercup--debugger) (debug-on-error t) (debug-ignored-errors nil)) (list 'passed (apply function arguments) nil)))) (defun buttercup--debugger (&rest args) "Debugger function that return error context with an exception. ARGS according to `debugger'." ;; If we do not do this, Emacs will not run this handler on ;; subsequent calls. Thanks to ert for this. (setq num-nonmacro-input-events (1+ num-nonmacro-input-events)) (throw 'buttercup-debugger-continue (list 'failed args ;; args is (error (signal . data) ....) where the tail ;; may be empty (cl-destructuring-bind (signal-type . data) (cl-second args) (cl-case signal-type ((buttercup-pending buttercup-failed)) (otherwise (buttercup--backtrace))))))) (defun buttercup--backtrace () "Create a backtrace, a list of frames returned from `backtrace-frame'." ;; Read the backtrace frames from `buttercup--debugger' + 1 upward. (cl-do* ((n 1 (1+ n)) (frame (backtrace-frame n #'buttercup--debugger) (backtrace-frame n #'buttercup--debugger)) (frame-list nil)) ((not frame) frame-list) ;; Keep frames until one if the end conditions is met. After ;; this is just the buttercup framework and not interesting for ;; users - except for testing buttercup. (when (or ;; When the error occurs in the calling of one of the ;; wrapped expressions of an expect. (buttercup--wrapper-fun-p (cadr frame)) ;; When an error happens in spec code but outside an expect ;; statement ;; buttercup--update-with-funcall ;; apply buttercup--funcall ;; buttercup--funcall - sets debugger ;; apply FUNCTION ;; FUNCTION -- spec body function ;; condition-case -- from buttercup-with-converted-ert-signals ;; (let ((buttercup--stackframe-marker 1)) -- the same ;; ACTUAL CODE (and (null (car frame)) (eq 'let (cadr frame)) (equal '((buttercup--stackframe-marker 1)) (car (cddr frame))) ) ;; TODO: What about :to-throw? ;; buttercup--update-with-funcall (spec ... ;; apply buttercup--funcall ;; buttercup--funcall -- sets the debugger ;; apply FUNCTION ;; FUNCTION -- spec body function ;; condition-case -- from buttercup-with-converted-ert-signals ;; (let ((buttercup--stackframe-marker 1)) ;; (buttercup-expect ;; (buttercup--apply-matcher ;; (apply to-throw-matcher ;; (to-throw-matcher ;; We need a new debugger here, the ;; condition-case can not be used to collect ;; backtrace. ;; When the error happens in the matcher function ;; (buttercup-expect ;; (buttercup--apply-matcher ;; (apply some-kind-of-function ;; (matcher ;; ACTUAL CODE (and (eq 'buttercup--apply-matcher (cadr frame)) ;; The two preceeding frames are not of user interest (pop frame-list) (pop frame-list) ;; Add a fake frame for the matcher function (push (cons t (cons (car (cddr frame)) (mapcar (lambda (x) (if (buttercup--wrapper-fun-p x) (buttercup--enclosed-expr x) x)) (cadr (cddr frame))))) frame-list)) ;; TODO: What about signals in before and after blocks? ;; BEFORE-EACH: ;; buttercup--run-suite ;; (let* ... ;; (dolist (f (buttercup-suite-before-all ... ;; (buttercup--update-with-funcall suite f ;; (apply buttercup--funcall ;; (buttercup-funcall f ;; (f) ;; Currently, buttercup silently ignores error in ;; (before|after)-(all|each). As long as that is the case, ;; there is nothing we can do about stacktraces. ) (cl-return frame-list)) (push frame frame-list))) (defun buttercup--format-stack-frame (frame &optional style) "Format stack FRAME according to STYLE. STYLE can be one of `full', `crop', `pretty', or `omit'. If STYLE is nil, use `buttercup-stack-frame-style' or `crop'." (setq style (or style buttercup-stack-frame-style 'crop)) (pcase style (`omit) ; needed to verify valid styles (`full (if (car frame) (format " %S%s" (cadr frame) (if (cddr frame) (prin1-to-string (cddr frame)) "()")) (format " %S" (cdr frame)))) (`crop (let ((line (buttercup--format-stack-frame frame 'full))) ;; Note: this could be done sith `s-truncate' from the s ;; package (when (> (length line) 79) (setq line (concat (substring line 0 76) "..."))) line)) (`pretty (let ((text (pp-to-string (cdr frame)))) ;; Delete empty trailing line (setq text (replace-regexp-in-string "\n[[:space:]]*\\'" "" text)) ;; Indent 2 spaces (setq text (replace-regexp-in-string "^" " " text)) ;; Prefix first line with lambda for function call and M for ;; macro/special form (setq text (replace-regexp-in-string "\\` " (if (car frame) "λ" "M") text)))) (_ (error "Unknown stack trace style: %S" style)))) (defmacro buttercup-with-converted-ert-signals (&rest body) "Convert ERT signals to buttercup signals in BODY. Specifically, `ert-test-failed' is converted to `buttercup-failed' and `ert-test-skipped' is converted to `buttercup-pending'." (declare (indent 0)) `(condition-case err (let ((buttercup--stackframe-marker 1)) (ignore buttercup--stackframe-marker) ,@body) (ert-test-failed (buttercup-fail "%S" err)) (ert-test-skipped (buttercup-skip "Skipping: %S" err)))) ;;;###autoload (define-minor-mode buttercup-minor-mode "Activate buttercup minor mode. With buttercup minor mode active the following is activated: - `describe' and `it' forms are fontified with `font-lock-keyword-face'. - `describe' and `it' forms are available from `imenu' for quicker access." :lighter " ❀" :keymap (make-sparse-keymap) (let ((font-lock-form '(("(\\(describe\\|buttercup-define-matcher\\|it\\) " 1 'font-lock-keyword-face))) (imenu-forms '(("Test Suites" "\\((describe\\_> +\\)\"\\(\\_<.+\\_>\\)\"" 2) ("Spec" "\\((it\\_> +\\)\"\\(\\_<.+\\_>\\)\"" 2)))) (if buttercup-minor-mode (progn (font-lock-add-keywords nil font-lock-form) (cl-dolist (form imenu-forms) (add-to-list 'imenu-generic-expression form))) (font-lock-remove-keywords nil font-lock-form) (cl-dolist (form imenu-forms) (setq imenu-generic-expression (delete form imenu-generic-expression)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Signal errors when files have to be recompiled (defun buttercup-check-for-stale-elc (elc-file) "Raise an error when ELC-FILE is an elc-file and older than its el-file." (when (string= (file-name-extension elc-file) "elc") (let ((el-file (substring elc-file 0 -1))) (when (and (file-exists-p el-file) (time-less-p (file-attribute-modification-time (file-attributes elc-file)) (file-attribute-modification-time (file-attributes el-file)))) (error "%s is newer than %s" el-file elc-file))))) (defun buttercup-error-on-stale-elc (&optional arg) "Activate errors when an stale (older than .el) .elc-file is loaded. Enable the functionality if ARG is omitted or nil, toggle it if ARG is ‘toggle’; disable otherwise." (cond ((null arg) (add-hook 'after-load-functions #'buttercup-check-for-stale-elc)) ((eq arg 'toggle) (if (memq 'buttercup-check-for-stale-elc after-load-functions) (remove-hook 'after-load-functions #'buttercup-check-for-stale-elc) (add-hook 'after-load-functions #'buttercup-check-for-stale-elc))) (t (remove-hook 'after-load-functions #'buttercup-check-for-stale-elc)))) (provide 'buttercup) ;; Local Variables: ;; indent-tabs-mode: nil ;; sentence-end-double-space: nil ;; tab-width: 8 ;; End: ;;; buttercup.el ends here emacs-buttercup-1.37/docs/000077500000000000000000000000001475447057000155145ustar00rootroot00000000000000emacs-buttercup-1.37/docs/images/000077500000000000000000000000001475447057000167615ustar00rootroot00000000000000emacs-buttercup-1.37/docs/images/buttercup.jpg000066400000000000000000000517251475447057000215120ustar00rootroot00000000000000JFIFHHC     C    &j5$i-+8v#j(@R*ػCʽfo9mRDEo2w3]"d}nP6Txp/iڻ+^{m6@(T2$M>ufpM5Μ%i<'cKx^M,_pkGW3nY}S/̏Z,z(Qռ<[ZlG:V瞕7`)vfnS}yc*k]&h+X֦=s~ur]=6 s, S˚e?mTRS^UW9ʒ9>Cufu(Ƌ vn؜7'lKOV_c^PVߓZוи Gkspnꨛs7SLG?4z|Յk>7}gU+sgUuz7Uid9WGh߿k[ؑR>:`9pm~Q[ejQQSLknY i6YMVCΟGDw"8yϭ{+ށh`8ڞG#\T' ~G}=ZV'̤}E(s33%tvO}˯I|WɔV5#Fm< ~zrqZ=6gc:tvDR:$>G_]OKD6Dq\h@uIO,DriƷZVMwb&HhV,^eJhjv6 _!xcxNСufˈh/|s[$9)3Bfx̱[a&Hg ԯYcLi\؄[CPL}i;ԀJ^v\E&4L^.C_$vB uCjj>ֽ Ҫ<2_FZU^K(EJh ;@jȹ7# 2 L1.Uuvi}|&SsEYu"@ U׬-7r`D5)xa䳂dV$p F\.!" 0#12@APWd>+ؿZFX;|g׵#raW*.^r|NؕGu8KC},d&pfbm-S4MWq)rI6DǕ G12CPtcڢ:CtGk{K1" #ǐcAnù_q֫J:,lXW$7sdHqrCxZm/wDFA7cǟ/?np,{&s4NbCV"^+\OګmWwKa(bp1S϶*0^G*!QOEg X5E3;Td+ͯ/s^'T.ƱV]c݉^q.~*v_KWh $β|@re'9:9 kc^&!=hWdtDK:f|ILlHwb{}2a ^{܇U)&T" 7.)K:լoϑ8/K `'$ޤ(;ʱa>4ڟƌ2Y!ZqQ>tK p0m6D{Ai۬fOh\.YCB.+Vc$OXy`OG9Y'Ũ|ʷuУgj?(sm-\3ڌq&ۈFny {PՔda.ToczejI(݋^'z/e c Eg&j v҃%@#G8C|:@5^*Ìvuv-C,r1^؛K o~z#$Ė)#LN"r=YtbyXADVHVo9muq/SbT/d A0} flsLFvDLmD[W AaF%gi#++ _\SX .l5d앒/p~heSq-qrlMc^L,2Phcݑ!$Mn$wFZh,Glˮ ;޶i=*y)tQ+FڮL{c,\x,H)4]@}X2g&[2h N\r5 d_KtSO/$!?J[{q<FH>96j"4Jrڊk5~ٓ+F)=3SY}ㄩ1=>]S{Čj\ HniE,\C،>H`+.up;EiS[#Nozqt|~I9B6f|R0,&e 7,s~}=ӣlTO,r_%/ʿi18Ws{Kl̫z(~cA!fI٬Woj2#OCiE|x%%?c=ħ.Mg`fԵ|r2.W!߃ueܻ}^ R3y #ڕ neOϨϖ{vlƘ>=tp*F>LRK|@k5PS3N8q=GTnlH,hm&6.B*QǤ&m (Wh/[n]CGf[Nmtp4/\'d >SUeDl?:ޥM'܍2-4V]"K+#ؓ7eLH*R^=4c'.[ h}I2.DxFi~v6 6$YDEtؒJ<%{$v>|Ve) 8d]HRG LnwnrV}3fފd2I1%dm*!b#!2b2|dn#YE+~Wa&(ؠ(FFUfӱ/{D4vfb# EHe6H|@Տ4Qr1⮬qaism0M1B2揧]Z+(}FHKX_6!1"A2Q 0a#3@BqPR?,GU irԎK2rhriR z!_2O[,"wJfD4z{F8v@ˉ 3m')!.2rUf%ׂ8hۃܻX?Q'lf"1E_MOOlrx.G$My ڋf#..yGaC2σR+Ӗ}Om32&DB=%Kp9Dl߉{'˨oKd:dmcӒI 97 bE]c[=IFQ)c9SnQf$XMqP]v=4Hآe-O:ZT='m}LetݣGQ\DFdaw:ϋ]=QaêY''+:Y2v{rk'Ѫ+wq[w %36ǹdԗupcer;_3BY$ui4yOcxUԩs䜟bZ4P=?'5pkr]_rtZJ\7NxDiXr u\vȩ2p6'Ϋ^G6/e|)fK+yѫꔳ*4\31]n^Y4zEY9F=%'IO GT7s>mF_dj=[V*_ԪW<gE#>Q-OxҊ8x%}KlE׶2/%Bx"؟+5?H((MF]wͺu^ i7ڝ>.7,ynZet~c, 5cvSrrĹ+RO'uwݞ^ycnNе#R|הJ14Y=6F0r"嘓cx9ﺿwxH+?Z!rԇD_Dc`Vĝr䪼X^}Yؿ(^ /(v,I#y/ۓo%rڈbْ),&W$/)OEUgdsy4-"NRY 1. ׹䔰VerQdE'c[Tp^!Sg&q7)+,dGzydbOUidY#^vr{K!N"ꯃrܶ o 0sbB^Ly#b7& II "f2c c9~J*FLS~yGr,'g.J݉{OB;#ZDH$-"՗QU&X ֦:T #τzy#Lcܮ0&8n="TeQHYSF ?%er$vMؙ2`P6W=8J<DJ)hcX?@!1A"Q#2aq 0BR3b$C%4@PSr?sJ珪}W 갘}W+zK)~c)d+cC?T/Az^%:'6)>+nf=%C +rtl'v+X.M]X=4:ok].*>NdRb!W9WUP+ *ռ h2U7Ɗd«UVּҙ &;OX9ni2$ANԓU}B]], W(:!>7cccϪo>Nd\*{vHC*4kYEw MF`ԕ#Gv^q<dT l mV,X$:cEI([?8ggww MK$"HP\>h٬"ls١.|(C3YEZ٣-j`s,q_h# /gsӗE-UH5~&QmU4rrll9e\\,w0^0qr| ztUunMj8\+ 5{|y.$xht.b_yzeKj-PbѴ"彋ԄM@e22 SJat7]Zo5~F]?}gAb7d?s#hL0EK3Fvqaw.y9q~6r7PWsNUNZ.6 U knmE l?2ͳ2dY Siut4f p<>nV5\ʾKMk1; ]O^lαٝ޴ˁ! mntj_%c.PI0O[A\z}i!qI'b+cT:`ӻEv52*>N Enk1~anDg :*ҩg4>4uk'h=ۏ18b5f$AyvҶ=<#LLNN])x>G/EyԺOHLic{ѽ";5$Z]FG˪`'LrF;读j{NE:F2YJ&>N S ʠBV7!vLUɚrꮷ~!I0BSvd@xXTO18]8K\gd2\䋮]邻W5=`qXEm`.Uݖ&0 S 7tR>$றe#mW\N%ˉkuOEHUtaQpP*O\ڮYzS&s5M`o-( ~IKR b웂]Uó~CRTTrl.,ZS%|z*ztN쩪U욨] EÏU7,S& ]+5ndhr̻1Do3UhF*^YpE^w\MuOX:hp'5K~J5^+*S}⃛ kSe4-s\z&Pq${|(:wfr9\BьKhUc9sAo4>XGUեw DzhQ1:HN"ߒ MtXm!ф\QU\X 8@*0谈} O*!1AQaq 0@P?!HR9Rd dj*0WT.S)u(5@Ed| Ϙ-y ø˫0s ;̹,U_))xi 9 `'æ P̋s,sld_#LVkiܵ8cF0f9fhE O22?2"P{9䀨h!ly_m13e1ÁUp#!mNq2jaSVMHhgy`ါ*eX&f$*&GyGJcrV~gį]u}.|{z^8<LlVeO"wnu(}.nSNbi}Pnd9bBl^F n3Y*vJBrlطMx!J-]m =9 SI)ߚ9EbA9L735 L.e#k;M5IߘƓ:e]Xu# @4㸔9fv^=y:3As 8rx%ĀyM:%Su1v-C+(8->飼ZkaJ2vuS ,(~ pP42.Pfk̸f[!:Ե(η38#\h zq^enVy_R5|xMZ!K\GDx\M3Oݨl%CnD(5,VuW01eY9ՐwsUߘwXpzW> n wzjf])U_-GڟYo9quƠl>ۤ6s,f y*7]z?Ͷͩƻ` n^/W1jPSL#;aە%r;WqNH)u;D*i<kt(c ud@aQ9 Oq - l~Z.7] /0pZKsl"s^(JXDFtwJ5jxfc%)=AxbD珉KjH3Nu{EO4 A](TꞢ90Y}4Qݻ-ո> S TEqh0{"l7LVGߘXRy/IǹԌ^f%0dbR rͥ^s˸`pQwuL}lnHFr‹1ҨjjPdpZ3dPc}#2bPnmj9Dg4*G@_yT"aًD9t+K$V(3$ Z+),9YUSxͻPু*Z<30ϥ0_igW_ &^z1n m!J[CY'(S8 1r;J(EV,7 -:.̋]E 3¢u45?3/O'"\Mo0hs%٣jƲfVvۈj2x>xi $ZG@W}E7̭:i)5fcBd>R+jJtYBIT&V8q1L#3mOTN`"^WG[ʓ"ve%ju? ,I*(WvDQ.h} H)sY&@]LT4C)1&- ) +ڲgK&ȮfA*| gg2ڀ_2H:p䍵Fg*#]@}%; B˫yQ/Zn7;}4G 9u UӀZ97@iU<h@Q!z}@QT*~ب/`1ǡER,?/Z~ւpsվ<`. 'eɽ&4Lm6j XZ|D ixO5a PlhY@4eDUz"rledd҆ 8pcHEz|؃g~Rz9+GdD69[sULFK@71|֓? 2P*!1AQa q0ᑱ@P?,aKY/sQL$>M?Ѣ~[ c침3&\;&kާ96na!W6y:pCa62A&~nCY Pfl !$ccz :/LDIqcDt&8HÞz8:ZS%A`c}K -.F>{xNxAKHkmB|s[c $Ewlu20O> m3RAPWu~qݻ'EŃ"$X2LE\0Zc#&60k![lǿZ=K<ݱϼ2ŢsjH 8(^y?hC|tuV&yUr~n 2z.mgN˻ϗ~ tN>7JG/gXm:6\_` aq`M!nnZ'Wt{?>6"bp:8N\ED^A#|`#Ŏ\XmͣĸOurFћ6z9ognG.#FvF\.A:xmt:0Yd١hn[▻JXl10SvXܤ.!W1C;.c0c*Cr5ᕖqhs`~ OVa_fpgsļ6~8tcl8@K6.qvWD-:\lry, Y&vy%ſNh y!f;d59kŌhpa.IJi?a7`a̦vú052-&0lJy>Kgq׊Ϥ#|$! u4#n6td[.3[-B8}"M0{*K&xc8،MՄPnZ~9<@a9%QjAJmdlz)!1AQaq 0@P?3Ϲ7k&8_$؎]B_E@!1Q@PaF?SI_FÌ^!r;\@V h$DS؀E0lDs2M,,,*1Ce*0\%`7-Bh"H881/ġdUL+mq `,0rP7p],6Q s`) F> 6Szz1Rq{k£RńC4`!b9rSϓUwc棲'1'IO#XxUhL]epk19{;a'AAj M%54N&[`GS|5e_Ƣj)AY*,;R)L#A >uu *(GO~O/ {"~nX$!X"Q8ozƁ8ˑy}w[Iw8J.!IH+ ǣ#CҏqYG<+MH]J`w{p!;y]e؂©wix"E#ysK;H\ %Ku7exҬWbPM 2tKBYDa 1T5QFjPs&8ۏ\\lѯF↬ao56x 8sMp9;=O/VG L,3;BA{EVΩߤ]x|÷q2h)u<}!r28) !r)X+ YjL ->Q6Bո\@*#bL!<`K 3P,7qPՁq-F ܵ1L VJ?s2Dh/y1 8/#,7\&cTsS"`Wl,H ~w`q\ o:Z2gTV\$LQ,a33q؁%AcL>yH?8W@CO?}NߘltFE $YDp2U@AlADxJqẚ89&Fa+ST]Lh pqb} օjQE.Jь$4b[!: Vxz*2vb-|/"ق%$5 $"Y1Xb) (ܙ7pqG'̽1O1VC, !IZcYDvE` z&D!QZJ-aX!YhN, qâ%i<~ZS[ B>eIġ jbVbk̵':rU%>x9mb_F(ذD]1vn&b> NAZP<jX_V"\ 1u  RJH*´/J̥;;3%2j]̗H| K ?®5 3!sV:h('lGGr+U_IiU-#f*fh !7 WDË́ IdL$ĢY;@T*!1AQaq 0@P?jbl.bfarCϜ40Bo ##;$)N Wi@j3YjYhقsF"̴+m@e9p)-`y5٪cy`r$x j!&3tV[^Y̹ŀϙpKBka7KST 4BVy)Xm,^L XaQtpJzIe:R~>Jy9 7RR([C<%.ZQ02\LV! S>c@R䯈"3k. -QCv?y=-IJ0fj[1"am*3GUmKOѨc,$c($ ]y.-}6LU1Y%cjQKf֣&LB5iA3& Cx֏*mc5P()4 aM5B|gZ s] {L&![1K툔Ⱥ+O" X+mQ-CWD'^tqr߽ܰ Oȅ bD [MN[Ħp\Z[xC;e fq/JB@9sPPrZcBMGJ(S t&qqh3n(Q] =9GGP(8Q4ɮe c n |"KUYNTKUKAaCmP3[J{WsY;ls<\1jV'b >%[ hL?),@ V@.xڜ(6-\w3 V3}|xֶ5rC=Kma0 yj _{Lj0 Ĵ(VS~O 7iqܠ&j* UnAkJDr#@-PfPtwuRDKبp7f2JWR6|ǁ^ S  *fNE 3u`P/!Õ6- `QVnvNe ztcA5) >&v4#D>%+L-Te(';5E7ÞYŽ.vl^7bE~sSxvDFRxTdKd(dwjFI3HZ]nHYwPopDj; iX0oQʓ.GaS>~*98 _ڿn/%T9^cͬpAY =Z,cQpTiҷWRiWjƘ^~*݋1^p`,3 ()(Q.x=p.c(zeS/f9h[9*.ja7/}AN  rـ=K:t wo^(^"catk2X1glR`2dӜmVBv,9Kc{?3}DX[U}՝Œ 䙅h5CôgP0hOe/,Y?%rL緷#l,fE-&]Ud!ML٤ Tmz C-"s-b{\[xK`If1[4nQ#jT ca. P4'1,7]Կ~,=vmP," 1Cih\eb!͒b|.4/paٔ_l- a_\_+/[bb%(yԿH8 !iAWV1;) $޿X2xB K&U[ܠ`!"UVYB ~彟Ϙ_ [Isn;h# Ʒmx&}d}P/% Z1XT*74!C, <Z' 0Y `,;p:5[%5(s ?>'$ȅ KPTrUhtF [ndwnuߣ+! ]ξ,SqxX2YjB\$p҄€v*>_~X2K5AW2n!nJ+Ww JXE6ƣp7KF(NI@P<͉TT:++q)n`8)e2,g&IC1T+jGA/&Q`H֘1+ 6`ݳ i j$'1 … 74J h 📢 Eask is very similar to Cask; anything that applies to Cask will apply to Eask [Eask](https://github.com/emacs-eask/cli) is a replacement for Cask which is actively maintained. ### Project Directory Layout > 📢 The project directory layout is similar to the Cask's one. But instead of > `Cask`-file, you should have `Eask`-file as a replacement. A basic project layout requires a project file, called `feature.el` here, an `Eask`-file to define dependencies, and a `tests/` directory for tests. It should look roughly like this: ``` feature/feature.el Eask tests/test-feature.el ``` **feature.el** ```elisp (defun featurize (bug feature) (format "It's not a %s, it's a %s" bug feature)) (provide 'feature) ``` **Eask-file** ```elisp (source 'gnu) (source 'melpa-stable) (development (depends-on "buttercup")) ``` **tests/test-feature.el** ```elisp ;;; -*- lexical-binding: t; -*- (require 'feature) (describe "The feature" (it "can use bug and feature" (expect (featurize "bug" "feature") :to-equal "It's not a bug, it's a feature"))) ``` ### Running Tests You can now use Eask to run your tests. First, you have to install the dependencies. You only have to do this once, or when the dependencies change: ```console $ eask install-deps --dev ... Installing 1 development dependency... Loading package information... done - Installing buttercup (20230119.2337)... done (Total of 1 dependency installed, 0 skipped) ``` Now, you can run your tests: ```console $ eask exec buttercup -L . ... Running 1 specs. The feature can use bug and feature Ran 1 specs, 0 failed, in 0.0 seconds. ``` That’s it. Buttercup’s built-in discover test runner looks for files named `test-*.el`, `*-test.el` or `*-tests.el`. Use the `--pattern PATTERN` option to only Only run tests with names matching PATTERN. The `--pattern` option can be used multiple times, in which case tests will be run if they match any of the given patterns. Combine with the `--no-skip` option to filter out the skipped tests. You can run this command whichever way you like. Common choices include a Makefile or shell scripts. See [relevant documentation](https://emacs-eask.github.io/) on Eask's own page for more information. ## Projectile If you use [Projectile](https://github.com/bbatsov/projectile) for interacting with your projects you can set the "default" project test command to be available when you invoke `projectile-test-project`. Create a `.dir-locals.el` file in the the root of your project tree (next to your Cask file). An example: **.dir-locals.el** ```elisp ((nil . ((eval . (progn (require 'projectile) (puthash (projectile-project-root) "cask exec buttercup -L ." projectile-test-cmd-map)))))) ``` If you are using Eldev as build tool, Projectile should provide testing command on its own, so you don’t need any special steps. ## Travis ### Cask If your project is hosted on github, you can use [Travis CI](https://travis-ci.org/) as your continuous integration environment. Buttercup can easily be used in such a setup. Simply add the following `.travis.yml` file: ```yaml language: emacs-lisp sudo: false cache: apt env: - EVM_EMACS=emacs-24.5-travis - EVM_EMACS=emacs-25.1-travis before_install: - curl -fsSkL https://gist.github.com/rejeep/ebcd57c3af83b049833b/raw > travis.sh && source ./travis.sh - evm install $EVM_EMACS --use --skip - cask install: - cask install script: - emacs --version - cask exec buttercup -L . ``` Most of the complexity here is from installing [EVM](https://github.com/rejeep/evm) and Cask to be able to test your project using different Emacs versions. ### Eldev For Eldev, use the following `.travis.yml` file: ```yaml language: emacs-lisp dist: trusty env: # Add more lines like this if you want to test on different Emacs versions. - EVM_EMACS=emacs-26.3-travis install: - curl -fsSL https://raw.github.com/doublep/eldev/master/webinstall/travis-eldev-and-evm > x.sh && source ./x.sh - evm install $EVM_EMACS --use script: - eldev -p -dtT test ``` For details, see [tool’s own documentation](https://github.com/doublep/eldev#continuous-integration). ### Eask For Eask, please see [tool's documentation](https://emacs-eask.github.io/Continuous-Integration/Travis-CI/). emacs-buttercup-1.37/docs/writing-tests.md000066400000000000000000000602211475447057000206620ustar00rootroot00000000000000# Introduction Buttercup is a behavior-driven development framework for testing Emacs Lisp code. It does not depend on any other Emacs Lisp libraries. It has a clean, obvious syntax so that you can easily write tests. It is heavily inspired by [Jasmine](https://jasmine.github.io/). So heavily inspired, in fact, that most of this page is more or less a verbatim copy of the [Jasmine introduction](https://jasmine.github.io/edge/introduction.html). All code in this file can be run by Buttercup’s built-in markdown test runner. Just use `make test` in the project directory to see the output. ## Suites: `describe` Your Tests A test suite begins with a call to the Buttercup macro `describe` with the first parameter describing the suite and the rest being the body of code that implements the suite. Note that `lexical-binding: t` is **required** in files defining buttercup tests. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (describe "A suite" (it "contains a spec with an expectation" (expect t :to-be t))) ``` ## Specs Specs are defined by calling the Buttercup macro `it`, which, like `describe` takes a string and code. The string is the title of the spec and the code is the spec, or test. A spec contains one or more expectations that test the state of the code. An expectation in Buttercup is an assertion that is either true or false. A spec with all true expectations is a passing spec. A spec with one or more false expectations is a failing spec. ### It’s Just Functions The code arguments to `describe` and `it` is just turned into functions internally, so they can contain any executable code necessary to implement the rules. Emacs Lisp scoping rules apply, so make sure to define your spec file to be lexically scoped. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (describe "A suite is just a function" :var (a) (it "and so is a spec" (setq a t) (expect a :to-be t))) ``` ## Expectations Expectations are expressed with the `expect` function. Its first argument is the actual value. The second argument is a test, followed by expected values for the test to compare the actual value against. If there is no test, the argument is simply tested for being non-nil. This can be used by people who dislike the matcher syntax. ### Matchers Each matcher implements a boolean comparison between the actual value and the expected value. It is responsible for reporting to Buttercup if the expectation is true or false. Buttercup will then pass or fail the spec. Any matcher can evaluate to a negative assertion by prepending it with the `:not` matcher. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (describe "The :to-be matcher compares with `eq'" (it "and has a positive case" (expect t :to-be t)) (it "and can have a negative case" (expect nil :not :to-be t))) ``` ### Included Matchers Buttercup has a rich set of matchers included. Each is used here — all expectations and specs pass. There is also the ability to write custom matchers (see the `buttercup-define-matcher` macro for further information) for when a project’s domain calls for specific assertions that are not included below. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (describe "Included matchers:" (it "The :to-be matcher compares with `eq'" (let* ((a 12) (b a)) (expect a :to-be b) (expect a :not :to-be nil))) (describe "The :to-equal matcher" (it "works for simple literals and variables" (let ((a 12)) (expect a :to-equal 12))) (it "should work for compound objects" (let ((foo '((a . 12) (b . 34))) (bar '((a . 12) (b . 34)))) (expect foo :to-equal bar)))) (it "The :to-have-same-items-as matcher compares two lists as sets" (let ((first (list "a" "b" "c")) (second (list "c" "a" "b")) (third (list "a" "c" "d")) (fourth (list "a" "b"))) (expect first :to-have-same-items-as second) (expect second :to-have-same-items-as first) (expect first :not :to-have-same-items-as third) (expect third :not :to-have-same-items-as second) (expect first :not :to-have-same-items-as fourth) (expect fourth :not :to-have-same-items-as first))) (it "The :to-match matcher is for regular expressions" (let ((message "foo bar baz")) (expect message :to-match "bar") (expect message :to-match (rx "bar")) (expect message :not :to-match "quux"))) (it "The :to-be-truthy matcher is for boolean casting testing" (let (a (foo "foo")) (expect foo :to-be-truthy) (expect a :not :to-be-truthy))) (it "The :to-contain matcher is for finding an item in a list" (let ((a '("foo" "bar" "baz"))) (expect a :to-contain "bar") (expect a :not :to-contain "quux"))) (it "The :to-be-less-than matcher is for mathematical comparisons" (let ((pi 3.1415926) (e 2.78)) (expect e :to-be-less-than pi) (expect pi :not :to-be-less-than e))) (it "The :to-be-greater-than matcher is for mathematical comparisons" (let ((pi 3.1415926) (e 2.78)) (expect pi :to-be-greater-than e) (expect e :not :to-be-greater-than pi))) (it "The :to-be-close-to matcher is for precision math comparison" (let ((pi 3.1415926) (e 2.78)) (expect pi :not :to-be-close-to e 2) (expect pi :to-be-close-to e 0))) (describe "The :to-throw matcher" (it "is for testing if an expression throws an exception" (expect (+ 1 2) :not :to-throw) (expect (+ a 1) :to-throw)) (it "accepts a symbol to check for the signal thrown" (expect (/ 1 0) :not :to-throw 'void-variable) (expect (+ a 1) :to-throw 'void-variable)) (it "optionally matches arguments to signals" (expect (+ a 1) :not :to-throw 'void-variable '(b)) (expect (+ a 1) :to-throw 'void-variable '(a))) (it "matches inherited signals" (expect (signal 'overflow-error nil) :to-throw 'overflow-error) (expect (signal 'overflow-error nil) :to-throw 'arith-error) (expect (signal 'overflow-error nil) :to-throw 'error) (expect (signal 'arith-error nil) :not :to-throw 'overflow-error) (expect (signal 'arith-error nil) :to-throw 'arith-error) (expect (signal 'arith-error nil) :to-throw 'error)))) ``` If you are migrating from ERT, you can also use `should` and similar macros inside a buttercup test just like you would inside an `ert-deftest` form. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (require 'ert) (describe "ERT support" (it "allows you to use ERT macros in tests" (let* ((a 12) (b a)) (should (= a b)) (should-not (eq a nil)) (should-error (error "Throws an error"))))) ``` ## Grouping Related Specs with `describe` The `describe` macro is for grouping related specs. The string parameter is for naming the collection of specs, and will be concatenated with specs to make a spec’s full name. This aids in finding specs in a large suite. If you name them well, your specs read as full sentences in traditional [BDD](http://en.wikipedia.org/wiki/Behavior-driven_development) style. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (describe "A spec" (it "is just a function, so it can contain any code" (let ((foo 0)) (setq foo (1+ foo)) (expect foo :to-equal 1))) (it "can have more than one expectation" (let ((foo 0)) (setq foo (1+ foo)) (expect foo :to-equal 1) (expect t :to-equal t)))) ``` ### Declaring Variables The `describe` macro supports the optional `:var` and `:var*` args. These bind variables for the suite by passing them as a varlist to the `let` and `let*` form respectively. Only one instance of `:var` or `:var*` is allowed, and it must come first in the `describe` form. It can not be interspersed between `it` statements. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (describe "A spec using :VAR" :var ((foo 1)) (it "has access to the variables bound in :VAR" (expect foo :to-be 1))) (describe "A spec using :VAR*" :var* ((foo 1) (bar (1+ foo))) (it "has access to the variables bound in :VAR* which can refer \ to symbols already bound" (expect bar :to-be 2))) ``` It's important to note that `lexical-binding` must be `non-nil` for `:var` and `:var*` to work properly. Within a test file this is usually set using a local file variable. Using `:var` and `:var*` works just like the `let` equivalents, but it's recommended to use the `:var` format to be future proof. Future internal changes in `buttercup` could break suites using `let`. ### Setup and Teardown To help a test suite DRY up any duplicated setup and teardown code, Buttercup provides the `before-each`, `after-each`, `before-all` and `after-all` special forms. As the name implies, code blocks defined with `before-each` are called once before each spec in the `describe` is run, and the `after-each` code blocks are called once after each spec. Here is the same set of specs written a little differently. The variable under test is defined at the top-level scope — the `describe` block — and initialization code is moved into a `before-each` block. The `after-each` block resets the variable before continuing. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (describe "A spec using `before-each' and `after-each'" :var (foo) (before-each (when (not foo) (setq foo 0)) (setq foo (1+ foo))) (after-each (setq foo 0)) (it "is just a function, so it can contain any code" (expect foo :to-equal 1)) (it "can have more than one expectation" (expect foo :to-equal 1) (expect t :to-equal t))) ``` The `before-all` form is called only once before all the specs in `describe` are run, and the `after-all` form is called after all specs finish. These functions can be used to speed up test suites with expensive setup and teardown. However, be careful using `before-all` and `after-all`! Since they are not reset between specs, it is easy to accidentally leak state between your specs so that they erroneously pass or fail. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (describe "A spec using `before-all' and `after-all'" :var (foo) (before-all (setq foo 1)) (after-all (setq foo 0)) (it "sets the initial value of foo before specs run" (expect foo :to-equal 1) (setq foo (1+ foo))) (it "does not reset foo between specs" (expect foo :to-equal 2))) ``` ### Nesting `describe` Blocks Calls to `describe` can be nested, with specs defined at any level. This allows a suite to be composed as a tree of functions. Before a spec is executed, Buttercup walks down the tree executing each `before-each` function in order. After the spec is executed, Buttercup walks through the `after-each` functions similarly. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (describe "A spec" :var (foo) (before-each (setq foo 0) (setq foo (1+ foo))) (after-each (setq foo 0)) (it "is just a function, so it can contain any code" (expect foo :to-equal 1)) (it "can have more than one expectation" (expect foo :to-equal 1) (expect t :to-equal t)) (describe "nested inside a second describe" (let (bar) (before-each (setq bar 1)) (it "can reference both scopes as needed" (expect foo :to-equal bar))))) ``` ## Disabling Suites Suites and specs can be disabled by marking them as pending with the `xdescribe` and `xit` macros, respectively. Any suites or specs inside a `xdescribe' suite is also pending. Pending suites and specs will be listed as pending in the results, but the containing code will not be run. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (xdescribe "A spec" :var (foo) (before-each (setq foo 0) (setq foo (1+ foo))) (it "is just a function, so it can contain any code" (expect foo :to-equal 1))) ``` ## Pending Specs Pending specs do not run, but will be listed in the results. Any spec declared with `xit` is marked as pending. Any spec declared without a function body will also be marked as pending in results. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (describe "Pending specs" (xit "can be declared using `xit'" (expect t :to-be nil)) (it "can be declared with `it' but without a body")) ``` ## Conditionally Skipping Specs Use the `assume` macro to conditionally skip a spec. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (describe "Conditionally skip specs" (it "with the `assume' macro" (assume (fboundp 'new-function) "`new-function' not availeble") (expect (new-function)))) ``` If the first argument to `assume` evals to nil, the spec will be marked as pending, and the second arg `message` will be added to the output. ## Spies Buttercup has test double functions called spies. While other frameworks call these mocks and similar, we call them spies, because their main job is to spy in on function calls. Also, Jasmine calls them spies, and so do we. A spy can stub any function - whether it already exists or not - and tracks calls to it and all arguments. Spies may only be created in `before-each` or `it` blocks. Spies are removed and all counters reset after each spec and its `after-each` blocks have completed. There are special matchers for interacting with spies. The `:to-have-been-called` matcher will return true if the spy was called at all. The `:to-have-been-called-with` matcher will return true if the argument list matches any of the recorded calls to the spy. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (describe "A spy" :var (foo bar) (before-each (setf (symbol-function 'foo) (lambda (value) (setq bar value))) (spy-on 'foo) (foo 123) (foo 456 "another param")) (it "tracks that the spy was called" (expect 'foo :to-have-been-called) (foo 789)) (it "resets tracking after each spec" (expect 'foo :not :to-have-been-called-with 789)) (describe "that is defined in a nested `describe'" (before-each (spy-on 'foo :and-return-value 1)) (it "will override any outer spy" (expect (foo 789) :to-equal 1) (expect 'foo :not :to-have-been-called-with 123))) (it "will not be active outside it's scope" (expect (foo 789) :to-equal nil)) (it "tracks all arguments of its calls" (expect 'foo :to-have-been-called-with 123) (expect 'foo :to-have-been-called-with 456 "another param")) (it "stops all execution on a function" (expect bar :to-be nil))) ``` The `:to-have-been-called-times` matcher will return true if the spy was called a certain number of times. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (describe "A spy" :var (foo bar) (before-each (setf (symbol-function 'foo) (lambda (value) (setq bar value))) (spy-on 'foo) (foo 123) (foo 456 "another param")) (it "tracks that the spy was called twice" (expect 'foo :to-have-been-called-times 2))) ``` ### Spies: `:and-call-through` The keyword argument `:and-call-through` to `spy-on` will make the spy call the original function instead of returning `nil`. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (describe "A spy, when configured to call through" :var (bar set-bar get-bar fetched-bar) (before-each (fset 'set-bar (lambda (val) (setq bar val))) (fset 'get-bar (lambda () bar)) (spy-on 'get-bar :and-call-through) (set-bar 123) (setq fetched-bar (get-bar))) (it "tracks that the spy was called" (expect 'get-bar :to-have-been-called)) (it "should not affect other functions" (expect bar :to-equal 123)) (it "when called returns the requested value" (expect fetched-bar :to-equal 123))) ``` ### Spies: `:and-return-value` The keyword argument `:and-return-value` specifies the value the spied-on function should return. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (describe "A spy, when configured to fake a return value" :var (bar set-bar get-bar fetched-bar) (before-each (fset 'set-bar (lambda (val) (setq bar val))) (fset 'get-bar (lambda () bar)) (spy-on 'get-bar :and-return-value 745) (set-bar 123) (setq fetched-bar (get-bar))) (it "tracks that the spy was called" (expect 'get-bar :to-have-been-called)) (it "should not affect other functions" (expect bar :to-equal 123)) (it "when called returns the requested value" (expect fetched-bar :to-equal 745))) ``` ### Spies: `:and-call-fake` The keyword argument `:and-call-fake` delegates calls to a supplied function. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (describe "A spy, when configured with an alternate implementation" :var (bar set-bar get-bar fetched-bar) (before-each (fset 'set-bar (lambda (val) (setq bar val))) (fset 'get-bar (lambda () bar)) (spy-on 'get-bar :and-call-fake (lambda () 1001)) (set-bar 123) (setq fetched-bar (get-bar))) (it "tracks that the spy was called" (expect 'get-bar :to-have-been-called)) (it "should not affect other functions" (expect bar :to-equal 123)) (it "when called returns the requested value" (expect fetched-bar :to-equal 1001))) ``` ### Spies: `:and-throw-error` With the keyword argument `:and-throw-error`, all calls to the spy will `signal` the specified value as an error. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (describe "A spy, when configured to throw an error" :var (bar set-bar get-bar fetched-bar) (before-each (fset 'set-bar (lambda (val) (setq bar val))) (fset 'get-bar (lambda () bar)) (spy-on 'get-bar :and-throw-error 'error)) (it "throws the error" (expect (get-bar) :to-throw 'error))) ``` ### Other tracking properties Every call to a spy is tracked and exposed using the `spy-calls` accessor. This tracks both successful calls and calls that throw errors. `spy-calls-any` returns `nil` if the spy has not been called at all, and then `t` once at least one call happens. `spy-calls-count` returns the number of times the spy was called. `spy-calls-args-for` returns the arguments passed to a given call (by index). `spy-calls-all-args` returns the arguments to all calls. `spy-calls-all` returns the context (current buffer, arguments passed and return status) of all calls. `spy-calls-most-recent` returns the context of the most recent call. `spy-calls-first` returns the context for the first call. Contexts are represented by instances of the `spy-context` struct with the slots `args`, `current-buffer`, `return-value` and `thrown-signal`. The `return-value` and `thrown-signal` slots represent the return status. Calling `spy-context-return-value` for a context representing a raised signal (or vice versa) will raise an error. Test the context type with `spy-context-return-p` and `spy-context-thrown-p`. Finally, `spy-calls-reset` clears all tracking for a spy. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (describe "A spy" :var (set-foo foo) (before-each (fset 'set-foo (lambda (val &rest ignored) (setq foo val))) (spy-on 'set-foo)) (it "tracks if it was called at all" (expect (spy-calls-any 'set-foo) :to-equal nil) (set-foo 5) (expect (spy-calls-any 'set-foo) :to-equal t)) (it "tracks the number of times it was called" (expect (spy-calls-count 'set-foo) :to-equal 0) (set-foo 2) (set-foo 3) (expect (spy-calls-count 'set-foo) :to-equal 2)) (it "tracks the arguments of each call" (set-foo 123) (set-foo 456 "baz") (expect (spy-calls-args-for 'set-foo 0) :to-equal '(123)) (expect (spy-calls-args-for 'set-foo 1) :to-equal '(456 "baz"))) (it "tracks the arguments of all calls" (set-foo 123) (set-foo 456 "baz") (expect (spy-calls-all-args 'set-foo) :to-equal '((123) (456 "baz")))) (it "can provide the context and arguments to all calls" (set-foo 123) (expect (spy-calls-all 'set-foo) :to-equal `(,(make-spy-context :current-buffer (current-buffer) :args '(123))))) (it "has a shortcut to the most recent call" (set-foo 123) (set-foo 456 "baz") (expect (spy-calls-most-recent 'set-foo) :to-equal (make-spy-context :current-buffer (current-buffer) :args '(456 "baz")))) (it "has a shortcut to the first call" (set-foo 123) (set-foo 456 "baz") (expect (spy-calls-first 'set-foo) :to-equal (make-spy-context :current-buffer (current-buffer) :args '(123)))) (it "tracks the return values and error signals of each call" ;; Set up `set-foo' so that it can either return a value or throw ;; an error (spy-on 'set-foo :and-call-fake (lambda (val &rest ignored) (if (>= val 0) val (error "Value must not be negative")))) (expect (set-foo 1) :to-be 1) (expect (set-foo -1) :to-throw 'error) (expect (spy-context-return-p (spy-calls-first 'set-foo))) (expect (spy-context-return-value (spy-calls-first 'set-foo)) :to-be 1) ;; Trying to get the thrown signal from a call that didn't throw a ;; signal is an error (expect (spy-context-thrown-signal (spy-calls-first 'set-foo)) :to-throw) (expect (spy-context-thrown-p (spy-calls-most-recent 'set-foo))) (expect (spy-context-thrown-signal (spy-calls-most-recent 'set-foo)) :to-equal '(error "Value must not be negative")) ;; Trying to get the return value from a call that threw a signal ;; raises an error (expect (spy-context-return-value (spy-calls-most-recent 'set-foo)) :to-throw) ;; Use :return-value and :thrown-signal to create matching spy-contexts (expect (spy-calls-all 'set-foo) :to-equal (list (make-spy-context :args '(1) :current-buffer (current-buffer) :return-value 1) (make-spy-context :args '(-1) :current-buffer (current-buffer) :thrown-signal '(error "Value must not be negative"))))) (it "counts the number of successful and failed calls" ;; Set up `set-foo' so that it can either return a value or throw ;; an error (spy-on 'set-foo :and-call-fake (lambda (val &rest ignored) (if (>= val 0) val (error "Value must not be negative")))) (expect (set-foo 1) :to-be 1) (expect (set-foo 2) :to-be 2) (expect (set-foo 3) :to-be 3) (expect (set-foo -1) :to-throw 'error) (expect (set-foo -2) :to-throw 'error) (expect (set-foo -3) :to-throw 'error) (expect (set-foo -4) :to-throw 'error) (expect (spy-calls-count 'set-foo) :to-be 7) (expect (spy-calls-count-returned 'set-foo) :to-be 3) (expect (spy-calls-count-errors 'set-foo) :to-be 4)) (it "can be reset" (set-foo 123) (set-foo 456 "baz") (expect (spy-calls-any 'set-foo) :to-be t) (spy-calls-reset 'set-foo) (expect (spy-calls-any 'set-foo) :to-be nil))) ``` ## Warnings in tests By default, Buttercup captures any warning emitted during a test and displays them all after the test completes in order to keep the output readable. If you need to suppress this (for example if your test deals with the warnings itself), you can use the macro `buttercup-suppress-warning-capture`, which works like `progn` but suppresses Buttercup's warning capturing within the body. ```Emacs-Lisp ;;; -*- lexical-binding: t; -*- (describe "A test" (it "can issue warnings while running" (display-warning 'buttercup "This warning should be visible after the test report.") (expect (+ 2 2) :to-equal 4)) (it "can capture its own warnings as part of the test" (buttercup-suppress-warning-capture (let ((warning-text (format "This warning, issued at %s should be sent to the *Warnings* buffer as normal." (current-time-string)))) (display-warning 'buttercup warning-text) (expect (with-current-buffer "*Warnings*" (buffer-string)) :to-match (regexp-quote warning-text)))))) ``` emacs-buttercup-1.37/scripts/000077500000000000000000000000001475447057000162535ustar00rootroot00000000000000emacs-buttercup-1.37/scripts/release000077500000000000000000000001751475447057000176240ustar00rootroot00000000000000#!/bin/bash set -e cd "$(dirname "$0")/.." main() { run bumpversion minor } run() { echo "\$ $*" "$@" } main emacs-buttercup-1.37/tests/000077500000000000000000000000001475447057000157265ustar00rootroot00000000000000emacs-buttercup-1.37/tests/test-buttercup.el000066400000000000000000003536211475447057000212540ustar00rootroot00000000000000;;; buttercup-test.el --- Tests for buttercup.el -*-lexical-binding:t-*- ;; Copyright (C) 2015-2017 Jorgen Schaefer ;; Copyright (C) 2017-2024 Ola Nilsson ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License ;; as published by the Free Software Foundation; either version 3 ;; of the License, or (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; ;; Define test-suites to test buttercup itself. This test suite ;; should pass for all Emacs versions defined in the ;; .github/workflows/test.yml file in the project directory root. ;;; Code: (require 'buttercup) (require 'autoload) (require 'ansi-color) (require 'bytecomp) (require 'ert) (require 'ert-x) (require 'cl-lib) (require 'imenu) (defmacro with-local-buttercup (&rest body) "Execute BODY with local buttercup state variables. Keyword arguments can be used to override the values of certain variables or environment variables while executing BODY: :color -> `buttercup-color' :frame-style -> `buttercup-stack-frame-style' :quiet -> `buttercup-reporter-batch-quiet-statuses' :reporter -> `buttercup-reporter' :suites -> `buttercup-suites' :no-color -> `NO_COLOR' :github-action -> `GITHUB_ACTION' \n(fn &keys COLOR FRAME-STYLE QUIET REPORTER SUITES NO-COLOR GITHUB-ACTION &rest BODY)" (declare (debug t) (indent defun)) ;; extract keyword arguments (let ((keys '(:color buttercup-color :frame-style buttercup-stack-frame-style :reporter buttercup-reporter :suites buttercup-suites :quiet buttercup-reporter-batch-quiet-statuses :no-color "NO_COLOR" :github-action "GITHUB_ACTION")) env-vars extra-vars) (while (plist-member keys (car body)) (let* ((key (pop body)) (var (plist-get keys key))) (push (list var (pop body)) (if (symbolp var) extra-vars env-vars)))) `(let (buttercup--after-each buttercup--before-each (buttercup--cleanup-functions :invalid) buttercup--current-suite (buttercup-reporter #'ignore) buttercup-suites buttercup-color buttercup-reporter-batch-quiet-statuses buttercup-reporter-batch--suite-stack buttercup-reporter-batch--failures (buttercup-stack-frame-style 'crop) (buttercup-warning-buffer-name " *ignored buttercup warnings*") ,@(nreverse extra-vars)) (with-environment-variables (("NO_COLOR" nil) ("GITHUB_ACTION" nil) ,@(nreverse env-vars) ) ,@body)))) (defmacro buttercup--test-with-tempdir (files &rest body) "Create FILES and execute BODY in a temporary directory. FILES shall be a list of file names. An empty file with that name will be created in the temporary directory. Any path prefix for a file will be created in the temporary directory. Elements in FILE can also be a list of up to two elements where the first is the filename as above and the second is the file contents. Return the value of the last form in BODY." (declare (debug t) (indent defun)) (let ((tmproot (cl-gensym)) (olddir (cl-gensym))) `(let ((,tmproot (make-temp-file "buttercup-test-temp-" t)) (,olddir default-directory)) (cl-labels ((make-file (file &optional content) (setq file (expand-file-name file ,tmproot)) (make-directory (file-name-directory file) t) (write-region (or content "") nil file))) (dolist (file ,files) (if (listp file) (apply #'make-file file) (make-file file)))) ;; It is tempting to use unwind-protect or condition-case here, ;; but that will mask actual test failures by interfering with ;; the debugger installed by buttercup (cd ,tmproot) (progn ,@body) (cd ,olddir) (delete-directory ,tmproot t)))) (defun send-string-to-ansi-buffer (buffer string) "A `send-string-to-terminal' variant that sends STRING to BUFFER. Any backspace, tab, newline, vertical tab, formfeed, or carriage return in STRING will be translared to in-buffer movement to emulate a terminal. Escape sequences in STRING are translated to text properties using `ansi-color-apply'." (setq string (ansi-color-apply string)) (cl-labels ((insert-owrt (text) "Insert TEXT by first overwriting until end of line." ;; Delete and insert separately. Otherwise characters ;; with text properties may remain when the new and ;; the old text share substrings. (delete-region (point) ; only delete up to the end of line (min (+ (point) (length text)) (line-end-position))) (insert text)) (line-feed () "Go to beginning of next line, creating it if necessary." (end-of-line) (or (zerop (forward-line)) (insert-and-inherit "\n")))) (with-current-buffer buffer (let ((tab-width 8) ; terminal uses 8 char tabs (indent-tabs-mode nil) ; make sure move-* does not insert tabs ;; default tab-stops (8 char interval) tab-stop-list ctrl-char) (save-match-data (while (string-match "\\(.*?\\)\\([\b\t\n\v\f\r]\\)\\([^z-a]*\\)" string) (insert-owrt (match-string 1 string)) (setq ctrl-char (aref (match-string 2 string) 0) string (match-string 3 string)) (cl-case ctrl-char (?\b (unless (bolp) (backward-char))) (?\t (move-to-tab-stop)) (?\n (line-feed)) ((?\v ?\f) (let ((line-pos (current-column))) (line-feed) (move-to-column line-pos t))) (?\r (forward-line 0)))) ;; print remaining text (insert-owrt string)))))) (defun buttercup--wrap-expr-and-eval (expr) "Return the result of `eval'ing a wrapped EXPR. When `buttercup--wrap-expr' uses `buttercup-thunk' oclosures, it actually returns a form that has to be `eval'ed to get a `buttercup-thunk'. This is not an issue when `buttercup--wrap-expr' is used in the `expect' macro, because the expansion of `expect' will be read/eval:ed anyway. But in the tests the return will sometimes have to be explicitly evaled before it's processed by other functions." (eval (buttercup--wrap-expr expr) t)) ;;;;;;;;;; ;;; helpers (describe "The buttercup--enclosed-expr function" (describe "should handle" (it "expressions wrapped by buttercup--wrap-expr" (expect (buttercup--enclosed-expr (buttercup--wrap-expr-and-eval '(ignore))) :to-equal '(ignore))) (it "a closure with expression copy?" ;; This is for before Oclosures were added, and is not testable ;; once interpreted-function types were added in Emacs 30. (assume (not (fboundp 'interpreted-function-p)) "Not testable on Emacs 30+, not relevant for Emacs 29+") (expect (buttercup--enclosed-expr (let ((_foo 1)) (lambda () '(ignore) (ignore)))) :to-equal '(ignore))) (it "a lambda with expression copy?" ;; I suspect there is nothing to make sure that the quoted ;; expression matches the actual expression (expect (buttercup--enclosed-expr '(lambda () (quote (ignore)) (ignore)))) :to-equal '(ignore)) (describe "byte compiled" (it "lambda objects" (expect (buttercup--enclosed-expr (byte-compile-sexp '(lambda () '(ignore) (ignore)))))) (it "wrapped expression" (assume (not (fboundp 'buttercup--thunk-p)) "Not with Oclosures") (expect (buttercup--enclosed-expr (byte-compile-sexp (buttercup--wrap-expr '(ignore)))))))) (describe "should error" (it "on a simple closure" (expect (buttercup--enclosed-expr (let ((_foo 1)) (lambda () (ignore)))) :to-throw 'buttercup-enclosed-expression-error)) (it "on a closure with stackframe marker but no quoted expression" (expect (buttercup--enclosed-expr (let ((_foo 1)) (lambda () (ignore)))) :to-throw 'buttercup-enclosed-expression-error)) (it "for multi-statement closures" (expect (buttercup--enclosed-expr (lambda () '(+ 1 2) (+ 1 2) (ignore))) :to-throw 'buttercup-enclosed-expression-error)) (it "for closures with non-empty argument lists" (expect (buttercup--enclosed-expr (lambda (foo) '(ignore foo) (ignore foo))) :to-throw 'buttercup-enclosed-expression-error)) (it "on simple lambda objects" (expect (buttercup--enclosed-expr '(lambda () (ignore))) :to-throw)) (it "on a lambda with stackframe marker but no quoted expression" (expect (buttercup--enclosed-expr '(lambda () (ignore))) :to-throw 'buttercup-enclosed-expression-error)) (it "for multi-statement lambdas" (expect (buttercup--enclosed-expr '(lambda () (+ 1 2) (ignore))) :to-throw 'buttercup-enclosed-expression-error)) (it "for lambdas with non-empty argument lists" (expect (buttercup--enclosed-expr '(lambda (foo) (ignore foo))) :to-throw 'buttercup-enclosed-expression-error)) (it "on byte-compiled functions with arguments" (expect (buttercup--enclosed-expr (byte-compile-sexp '(lambda (_a) '(ignore) (ignore)))) :to-throw 'buttercup-enclosed-expression-error)))) ;;;;;;;;;; ;;; expect (describe "The buttercup-failed signal" (it "can be raised" (expect (signal 'buttercup-failed t) :to-throw 'buttercup-failed))) (describe "The buttercup-pending signal" (it "can be raised" (expect (signal 'buttercup-pending t) :to-throw 'buttercup-pending))) (describe "The `expect' form" (it "with a matcher should translate to the function call with closures" (let ((expansion (macroexpand '(expect (+ 1 1) :to-equal 2)))) (expect (length expansion) :to-equal 4) (expect (nth 0 expansion) :to-be 'buttercup-expect) (expect (functionp (eval (nth 1 expansion) t))) (expect (buttercup--wrapper-fun-p (eval (nth 1 expansion) t))) (expect (nth 2 expansion) :to-be :to-equal) (expect (functionp (eval (nth 3 expansion) t))) (expect (buttercup--wrapper-fun-p (eval (nth 3 expansion) t))))) (it "with no matcher should use `:to-be-truthy' as the matcher" (let ((expansion (macroexpand '(expect (equal (+ 1 1) 2))))) (expect (length expansion) :to-equal 3) (expect (nth 0 expansion) :to-be 'buttercup-expect) (expect (functionp (eval (nth 1 expansion) t))) (expect (nth 2 expansion) :to-be :to-be-truthy)))) (describe "The `buttercup-expect' function" (describe "with a function as a matcher argument" (it "should not raise an error if the function returns true" (expect (buttercup-expect (buttercup--wrap-expr-and-eval t) #'eq (buttercup--wrap-expr-and-eval t)) :not :to-throw 'buttercup-failed)) (it "should raise an error if the function returns false" (expect (buttercup-expect (buttercup--wrap-expr-and-eval t) #'eq (buttercup--wrap-expr-and-eval nil)) :to-throw 'buttercup-failed))) (describe "with a matcher argument" (it "should not raise an error if the matcher returns true" (expect (buttercup-expect (buttercup--wrap-expr-and-eval (ignore)) #'always) :not :to-throw 'buttercup-failed)) (it "should raise an error if the matcher returns false" (expect (buttercup-expect (buttercup--wrap-expr-and-eval t) #'ignore) :to-throw 'buttercup-failed)))) (describe "The `buttercup-fail' function" (it "should raise a signal with its arguments" (expect (buttercup-fail "Explanation" ) :to-throw 'buttercup-failed "Explanation"))) (describe "The `assume' form" (it "should raise a signal if the condition is nil" (expect (assume nil "Explanation") :to-throw 'buttercup-pending "!! CANCELLED !! Explanation")) (it "should show the format if no message is given" (expect (assume (< 1 0)) :to-throw 'buttercup-pending "!! CANCELLED !! (< 1 0) => nil")) (it "should not raise a signal if the condition is non-nil" (expect (assume 'non-nil "Explanation") :not :to-throw))) (describe "The `buttercup-skip' function" (it "should raise a signal with its arguments" (expect (buttercup-skip "Explanation" ) :to-throw 'buttercup-pending "Explanation"))) (buttercup-define-matcher :test-matcher (a b) (+ (funcall a) (funcall b))) (describe "The `buttercup-define-matcher' macro" (it "should create a matcher usable by apply-matcher" (expect (buttercup--apply-matcher :test-matcher (mapcar #'buttercup--wrap-expr-and-eval '(1 2))) :to-equal 3))) (describe "The `buttercup--apply-matcher' function" (it "should work with functions" (expect (buttercup--apply-matcher #'+ (mapcar #'buttercup--wrap-expr-and-eval '(1 2))) :to-equal 3)) (it "should work with matchers" (expect (buttercup--apply-matcher :test-matcher (mapcar #'buttercup--wrap-expr-and-eval '(1 2))) :to-equal 3)) (it "should fail if the matcher is not defined" (expect (buttercup--apply-matcher :not-defined (mapcar #'buttercup--wrap-expr-and-eval '(1 2))) :to-throw))) ;;;;;;;;;;;;;;;;;;;;; ;;; Built-in matchers ;; Are tested in docs/writing-tests.md (buttercup-define-matcher-for-unary-function :test-to-be-truthy identity) (describe "The :buttercup-define-matcher-for-unary-function helper" (it "should not modify match data" (string-match ".." "foo") (expect t :test-to-be-truthy) (expect (match-end 0) :to-equal 2))) (buttercup-define-matcher-for-binary-function :test-to-be-eq eq) (describe "The :buttercup-define-matcher-for-binary-function helper" (it "should not modify match data" (string-match ".." "foo") (expect t :test-to-be-eq t) (expect (match-end 0) :to-equal 2))) (describe "The included matcher" (describe ":to-be-truthy" :var (matcher-function) (before-all (setq matcher-function (buttercup--find-matcher-function :to-be-truthy))) (it "should match for a truthy expression" (expect (buttercup--apply-matcher :to-be-truthy (mapcar #'buttercup--wrap-expr-and-eval '((not nil)))) :to-equal '(t . "Expected `(not nil)' to be nil, but instead it was `t'."))) (it "should not match for an untruthy expression" (expect (buttercup--apply-matcher :to-be-truthy (mapcar #'buttercup--wrap-expr-and-eval '((ignore)))) :to-equal '(nil . "Expected `(ignore)' to be non-nil, but instead it was nil.")))) (describe ":to-be" (it "should match if the args are `eq'" (cl-destructuring-bind (status . msg) (buttercup--apply-matcher :to-be (mapcar #'buttercup--wrap-expr-and-eval '('a 'a))) (expect status) (expect msg :to-match (rx "Expected `" (or "'a" "(quote a)") "' not to be `eq' to `a', but it was.")))) (it "should not match if the args are not `eq'" (cl-destructuring-bind (status . msg) (buttercup--apply-matcher :to-be (mapcar #'buttercup--wrap-expr-and-eval '('a 'b))) (expect status :not :to-be-truthy) (expect msg :to-match (rx "Expected `" (or "'a" "(quote a)") "' to be `eq' to `b', but instead it was `a'."))))) (describe ":to-equal" ;; Assumes (get 'equal 'ert-explainer) => 'ert--explain-equal (before-each (spy-on 'ert--explain-equal :and-call-through)) (it "should match if the args are `equal'" (let ((res (buttercup--apply-matcher :to-equal (mapcar #'buttercup--wrap-expr-and-eval '(0.2 0.2))))) ;; Check before using :to-equal to verify the return value (expect 'ert--explain-equal :to-have-been-called-times 1) (expect res :to-equal '(t . "Expected `0.2' not to be `equal' to `0.2', but it was.")))) (it "should not match if the args are not `equal'" (let ((res (buttercup--apply-matcher :to-equal (mapcar #'buttercup--wrap-expr-and-eval '(0.2 1.0))))) ;; Check before using :to-equal to verify the return value (expect 'ert--explain-equal :to-have-been-called-times 1) (expect res :to-equal '(nil . "Expected `0.2' to be `equal' to `1.0', but instead it was `0.2' which does not match because: (different-atoms 0.2 1.0)."))))) (describe ":not" (it "should invert the car of the nested matcher's return value" (expect (buttercup--apply-matcher :not (mapcar #'buttercup--wrap-expr-and-eval '(1 :to-equal 2))) :to-equal (cl-destructuring-bind (res . msg) (buttercup--apply-matcher :to-equal (mapcar #'buttercup--wrap-expr-and-eval '(1 2))) (cons (not res) msg))))) (describe ":to-have-same-items-as" (it "should match equal sets" (cl-destructuring-bind (status . msg) (buttercup--apply-matcher :to-have-same-items-as (mapcar #'buttercup--wrap-expr-and-eval '('(1 1 2 3 4) '(4 2 1 3)))) (expect status) (expect msg :to-match (rx "Expected `" (or "'(1 1 2 3 4)" "(quote (1 1 2 3 4))") "' not to have same items as `(4 2 1 3)'")))) (it "should notice missing elements in the second argument" (cl-destructuring-bind (status . msg) (buttercup--apply-matcher :to-have-same-items-as (mapcar #'buttercup--wrap-expr-and-eval '('(1 2 3 4) '(4 2 3)))) (expect status :not :to-be-truthy) (expect msg :to-match (rx "Expected `" (or "'(1 2 3 4)" "(quote (1 2 3 4))") "' to contain the same items as `(4 2 3)', " "but `(1)' are present unexpectedly.")))) (it "should notice extra items in the second argument" (cl-destructuring-bind (status . msg) (buttercup--apply-matcher :to-have-same-items-as (mapcar #'buttercup--wrap-expr-and-eval '('(1 2 3 4) '(4 1 2 3 5)))) (expect status :not :to-be-truthy) (expect msg :to-match (rx "Expected `" (or "'(1 2 3 4)" "(quote (1 2 3 4))") "' to contain the same items as `(4 1 2 3 5)', " "but `(5)' are missing.")))) (it "should notice extra items in both arguments" (cl-destructuring-bind (status . msg) (buttercup--apply-matcher :to-have-same-items-as (mapcar #'buttercup--wrap-expr-and-eval '('(1 2 3 4) '(4 1 3 5)))) (expect status :not :to-be-truthy) (expect msg :to-match (rx "Expected `" (or "'(1 2 3 4)" "(quote (1 2 3 4))") "' to contain the same items as `(4 1 3 5)', " "but `(5)' are missing and `(2)' are present unexpectedly."))))) (describe ":to-match" (it "should match the first argument against a regex" (expect (buttercup--apply-matcher :to-match (mapcar #'buttercup--wrap-expr-and-eval '("some string" "."))) :to-equal '(t . "Expected some string not to match the regexp \".\", but it matched the substring \"s\" from position 0 to 1."))) (it "should show regex mismatches" (expect (buttercup--apply-matcher :to-match (mapcar #'buttercup--wrap-expr-and-eval '("some string" "[0-9]+"))) :to-equal '(nil . "Expected some string to match the regexp \"[0-9]+\", but instead it was \"some string\".")))) (describe ":to-be-in" (it "should match when the first argument is a member of the second argument" (cl-destructuring-bind (status . msg) (buttercup--apply-matcher :to-be-in (mapcar #'buttercup--wrap-expr-and-eval '('a '(b a c)))) (expect status) (expect msg :to-match (rx "Expected `" (or "'a" "(quote a)") "' not to be an element of `(b a c)', but it was `a'.")))) (it "should not match when the first argument is not a member of the second argument" (cl-destructuring-bind (status . msg) (buttercup--apply-matcher :to-be-in (mapcar #'buttercup--wrap-expr-and-eval '( ''a '(b d c)))) (expect status :not :to-be-truthy) (expect msg :to-match (rx "Expected `" (or "''a" "(quote (quote a))") "' to be an element of `(b d c)', but it was `" (or "'a" "(quote a)") "'."))))) (describe ":to-contain" (it "should match when the second argument is a member of the first argument" (cl-destructuring-bind (status . msg) (buttercup--apply-matcher :to-contain (mapcar #'buttercup--wrap-expr-and-eval '('(b a c) 'a))) (expect status) (expect msg :to-match "Expected `\\('(b a c)\\|(quote (b a c))\\)' to be a list not containing `a', but instead it was `(b a c)'."))) (it "should not match when the second argument is not a member of the first argument" (cl-destructuring-bind (status . msg) (buttercup--apply-matcher :to-contain (mapcar #'buttercup--wrap-expr-and-eval '('(b d c) 'a))) (expect status :not :to-be-truthy) (expect msg :to-match "Expected `\\('(b d c)\\|(quote (b d c))\\)' to be a list containing `a', but instead it was `(b d c)'.")))) (describe ":to-be-less-than" (it "should match when the first argument is less than the second argument" (expect (buttercup--apply-matcher :to-be-less-than (mapcar #'buttercup--wrap-expr-and-eval '(1 2))) :to-equal '(t . "Expected `1' >= 2, but `1' was 1."))) (it "should not match when the first argument is equal to the second argument" (expect (buttercup--apply-matcher :to-be-less-than (mapcar #'buttercup--wrap-expr-and-eval '(2 2))) :to-equal '(nil . "Expected `2' < 2, but `2' was 2."))) (it "should not match when the first argument is greater than the second argument" (expect (buttercup--apply-matcher :to-be-less-than (mapcar #'buttercup--wrap-expr-and-eval '(3 2))) :to-equal '(nil . "Expected `3' < 2, but `3' was 3.")))) (describe ":to-be-greater-than" (it "should match when the first argument is greater than the second argument" (expect (buttercup--apply-matcher :to-be-greater-than (mapcar #'buttercup--wrap-expr-and-eval '(2 1))) :to-equal '(t . "Expected `2' <= 1, but `2' was 2."))) (it "should not match when the first argument is equal to the second argument" (expect (buttercup--apply-matcher :to-be-greater-than (mapcar #'buttercup--wrap-expr-and-eval '(2 2))) :to-equal '(nil . "Expected `2' > 2, but `2' was 2."))) (it "should not match when the first argument is greater than the second argument" (expect (buttercup--apply-matcher :to-be-greater-than (mapcar #'buttercup--wrap-expr-and-eval '(2 3))) :to-equal '(nil . "Expected `2' > 3, but `2' was 2.")))) (describe ":to-be-weakly-less-than" (it "should match when the first argument is less than the second argument" (expect (buttercup--apply-matcher :to-be-weakly-less-than (mapcar #'buttercup--wrap-expr-and-eval '(1 2))) :to-equal '(t . "Expected `1' > 2, but `1' was 1."))) (it "should match when the first argument is equal to the second argument" (expect (buttercup--apply-matcher :to-be-weakly-less-than (mapcar #'buttercup--wrap-expr-and-eval '(2 2))) :to-equal '(t . "Expected `2' > 2, but `2' was 2."))) (it "should not match when the first argument is greater than the second argument" (expect (buttercup--apply-matcher :to-be-weakly-less-than (mapcar #'buttercup--wrap-expr-and-eval '(3 2))) :to-equal '(nil . "Expected `3' <= 2, but `3' was 3.")))) (describe ":to-be-weakly-greater-than" (it "should match when the first argument is greater than the second argument" (expect (buttercup--apply-matcher :to-be-weakly-greater-than (mapcar #'buttercup--wrap-expr-and-eval '(2 1))) :to-equal '(t . "Expected `2' < 1, but `2' was 2."))) (it "should match when the first argument is equal to the second argument" (expect (buttercup--apply-matcher :to-be-weakly-greater-than (mapcar #'buttercup--wrap-expr-and-eval '(2 2))) :to-equal '(t . "Expected `2' < 2, but `2' was 2."))) (it "should not match when the first argument is greater than the second argument" (expect (buttercup--apply-matcher :to-be-weakly-greater-than (mapcar #'buttercup--wrap-expr-and-eval '(2 3))) :to-equal '(nil . "Expected `2' >= 3, but `2' was 2.")))) (describe ":to-be-close-to" (it "should match when value difference is less than precision" (cl-destructuring-bind (status . msg) (buttercup--apply-matcher :to-be-close-to (mapcar #'buttercup--wrap-expr-and-eval '(0.01 0.011 2))) (expect status) (expect msg :to-match "Expected `0.01' to differ from 0.011 by more than 0.01, but instead it was 0.01, with a difference of 0.00[0-9]+"))) (it "should not match when value difference is larger than precision" (cl-destructuring-bind (status . msg) (buttercup--apply-matcher :to-be-close-to (mapcar #'buttercup--wrap-expr-and-eval '(0.01 0.011 4))) (expect status :not :to-be-truthy) (expect msg :to-match "Expected `0.01' to be within 0.0001 of 0.011, but instead it was 0.01, with a difference of 0.00[0-9]+")))) (describe ":to-throw" ;; Actually tests `buttercup--handle-to-throw' (it "should match when signal symbol and argument match exactly" (expect (buttercup--handle-to-throw '(overflow-error "Foobar") (list 'overflow-error (concat "Foo" "bar")) '(myfunc) nil) :to-equal '(t . "Expected `(myfunc)' not to throw a child signal of `overflow-error' with args `(\"Foobar\")', but it threw `overflow-error' with args `(\"Foobar\")'"))) (it "should match the error symbol without args" (expect (buttercup--handle-to-throw '(overflow-error "Foobar") '(overflow-error) '(myfunc) nil) :to-equal '(t . "Expected `(myfunc)' not to throw a child signal of `overflow-error', but it threw `overflow-error'"))) (it "should match the with no error signal specified" (expect (buttercup--handle-to-throw '(overflow-error "Foobar") '() '(myfunc) nil) :to-equal '(t . "Expected `(myfunc)' not to throw a signal, but it threw `overflow-error'"))) (it "should match a child signal" (expect (buttercup--handle-to-throw '(overflow-error "Foobar") '(arith-error) '(myfunc) nil) :to-equal '(t . "Expected `(myfunc)' not to throw a child signal of `arith-error', but it threw `overflow-error'"))) (it "should match child signals and equal arguments" (expect (buttercup--handle-to-throw '(overflow-error "Foobar") `(arith-error ,(concat "Foo" "bar")) '(myfunc) nil) :to-equal '(t . "Expected `(myfunc)' not to throw a child signal of `arith-error' with args `(\"Foobar\")', but it threw `overflow-error' with args `(\"Foobar\")'"))) (it "should not match with different arguments" (expect (buttercup--handle-to-throw '(overflow-error "Foobar") (list 'overflow-error (concat "Foo" "bar" "baz")) '(myfunc) nil) :to-equal '(nil . "Expected `(myfunc)' to signal a child signal of `overflow-error' with args `(\"Foobarbaz\")', but instead signalled with args `(\"Foobar\")' which does not match because (list-elt 0 (arrays-of-different-length 6 9 \"Foobar\" \"Foobarbaz\" first-mismatch-at 6))."))) (it "should not match an unrelated symbol" (expect (buttercup--handle-to-throw '(void-variable "Foobar") (list 'overflow-error (concat "Foo" "bar")) '(myfunc) nil) :to-equal '(nil . "Expected `(myfunc)' to throw a child signal of `overflow-error' with args `(\"Foobar\")', but instead it threw `void-variable' with args `(\"Foobar\")'"))) (it "should not match a parent signal" (expect (buttercup--handle-to-throw '(arith-error "Foobar") `(overflow-error) '(myfunc) nil) :to-equal '(nil . "Expected `(myfunc)' to throw a child signal of `overflow-error', but instead it threw `arith-error'"))) (describe "should not match when no signal is raised" (it "and not mention unspecified signal" ;; since this test does not need to signal an error, it can apply the full matcher (expect (buttercup--apply-matcher :to-throw (mapcar #'buttercup--wrap-expr-and-eval '((identity t)))) :to-equal '(nil . "Expected `(identity t)' to throw a signal, but instead it returned `t'"))) (it "and mention any specified signal" (expect (buttercup--apply-matcher :to-throw (mapcar #'buttercup--wrap-expr-and-eval '((identity t) 'arith-error))) :to-equal '(nil . "Expected `(identity t)' to throw a child signal of `arith-error', but instead it returned `t'"))) ) ) (describe ":to-have-been-called" (before-each (spy-on 'i-spy-with-my-little-eye)) (it "should not match if the spy has not been called" (expect (buttercup--apply-matcher :to-have-been-called (mapcar #'buttercup--wrap-expr-and-eval '('i-spy-with-my-little-eye))) :not :to-be-truthy)) (it "should match if the spy has been called once" (i-spy-with-my-little-eye) (expect (buttercup--apply-matcher :to-have-been-called (mapcar #'buttercup--wrap-expr-and-eval '('i-spy-with-my-little-eye))) :to-be-truthy)) (it "should match if the spy has been called multiple times" (dotimes (x 1000) (i-spy-with-my-little-eye)) (expect (buttercup--apply-matcher :to-have-been-called (mapcar #'buttercup--wrap-expr-and-eval '('i-spy-with-my-little-eye))) :to-be-truthy)) ) (describe ":to-have-been-called-with" (before-each (spy-on 'i-spy-with-my-little-eye)) (it "should not match if the spy has not been called at all" (expect (buttercup--apply-matcher :to-have-been-called-with (mapcar #'buttercup--wrap-expr-and-eval '('i-spy-with-my-little-eye 123))) :to-equal '(nil . "Expected `i-spy-with-my-little-eye' to have been called with (123), but it was not called at all"))) (it "should not match if the spy has not been called with the specified arguments" (i-spy-with-my-little-eye 123) (i-spy-with-my-little-eye 456) (i-spy-with-my-little-eye 789) (i-spy-with-my-little-eye 'ABC) (i-spy-with-my-little-eye 'DEF) (i-spy-with-my-little-eye 'HIJ) (i-spy-with-my-little-eye 'KLM) (expect (buttercup--apply-matcher :to-have-been-called-with (mapcar #'buttercup--wrap-expr-and-eval '('i-spy-with-my-little-eye 234))) :to-equal '(nil . "Expected `i-spy-with-my-little-eye' to have been called with (234), but it was called with (123), (456), (789), (ABC), (DEF), (HIJ), (KLM)"))) (it "should match if the spy has been called once with the specified arguments" (i-spy-with-my-little-eye 123) (i-spy-with-my-little-eye 456) (i-spy-with-my-little-eye 789) (i-spy-with-my-little-eye 789 789) (i-spy-with-my-little-eye 'ABC) (i-spy-with-my-little-eye 'DEF) (i-spy-with-my-little-eye 'HIJ) (i-spy-with-my-little-eye 'KLM) (expect (buttercup--apply-matcher :to-have-been-called-with (mapcar #'buttercup--wrap-expr-and-eval '('i-spy-with-my-little-eye 789 789))) :to-equal t)) (it "should match if the spy has been called multiple times with the specified arguments" (dotimes (x 10) (i-spy-with-my-little-eye 123) (i-spy-with-my-little-eye 456)) (expect (buttercup--apply-matcher :to-have-been-called-with (mapcar #'buttercup--wrap-expr-and-eval '('i-spy-with-my-little-eye 456))) :to-be-truthy)) ) (describe ":to-have-been-called-times" (before-each (spy-on 'i-spy-with-my-little-eye)) (it "should not match if the spy has been called less times" (i-spy-with-my-little-eye) (expect (buttercup--apply-matcher :to-have-been-called-times (mapcar #'buttercup--wrap-expr-and-eval '('i-spy-with-my-little-eye 2))) :to-equal '(nil . "Expected `i-spy-with-my-little-eye' to have been called 2 times, but it was called 1 time"))) (it "should not match if the spy has been called more times" (dotimes (x 6) (i-spy-with-my-little-eye)) (expect (buttercup--apply-matcher :to-have-been-called-times (mapcar #'buttercup--wrap-expr-and-eval '('i-spy-with-my-little-eye 4))) :to-equal '(nil . "Expected `i-spy-with-my-little-eye' to have been called 4 times, but it was called 6 times"))) (it "should match if the spy has been called the correct number of times" (dotimes (x 6) (i-spy-with-my-little-eye)) (expect (buttercup--apply-matcher :to-have-been-called-times (mapcar #'buttercup--wrap-expr-and-eval '('i-spy-with-my-little-eye 6))) :to-equal '(t . "Expected `i-spy-with-my-little-eye' to not have been called exactly 6 times, but it was."))) (it "should match if the spy has been called 0 times" (expect (buttercup--apply-matcher :to-have-been-called-times (mapcar #'buttercup--wrap-expr-and-eval '('i-spy-with-my-little-eye 0))) :to-equal '(t . "Expected `i-spy-with-my-little-eye' to not have been called exactly 0 times, but it was."))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Suite and spec data structures (describe "The `buttercup-suite-add-child' function" (it "should add an element at the end of the list and return it" (let* ((specs (list (make-buttercup-spec) (make-buttercup-spec) (make-buttercup-spec))) (suite (make-buttercup-suite :children specs)) (spec (make-buttercup-spec))) (expect (buttercup-suite-add-child suite spec) :to-be spec) (expect (buttercup-suite-children suite) :to-equal (append specs (list spec))))) (it "should add an element even if the list is empty and return it" (let ((suite (make-buttercup-suite :children nil)) (spec (make-buttercup-spec))) (expect (buttercup-suite-add-child suite spec) :to-be spec) (expect (buttercup-suite-children suite) :to-equal (list spec)))) (it "should add the parent to the child" (let ((parent (make-buttercup-suite)) (child (make-buttercup-suite))) (buttercup-suite-add-child parent child) (expect (buttercup-suite-parent child) :to-equal parent)))) (describe "The `buttercup-suite-parents' function" (it "should return the list of parents for a suite" (let ((grandparent (make-buttercup-suite)) (parent (make-buttercup-suite)) (child (make-buttercup-suite))) (buttercup-suite-add-child grandparent parent) (buttercup-suite-add-child parent child) (expect (buttercup-suite-or-spec-parents child) :to-equal (list parent grandparent))))) (describe "The `buttercup-spec-parents' function" (it "should return the list of parents for a spec" (let ((grandparent (make-buttercup-suite)) (parent (make-buttercup-suite)) (child (make-buttercup-spec))) (buttercup-suite-add-child grandparent parent) (buttercup-suite-add-child parent child) (expect (buttercup-suite-or-spec-parents child) :to-equal (list parent grandparent))))) (describe "The `buttercup-suites-total-specs-defined' function" (it "should return the number of specs in a list of suites" (let ((su1 (make-buttercup-suite :description "su1")) (su2 (make-buttercup-suite :description "su2")) (sp1 (make-buttercup-spec :description "sp1")) (sp2 (make-buttercup-spec :description "sp2"))) (buttercup-suite-add-child su1 su2) (buttercup-suite-add-child su1 sp1) (buttercup-suite-add-child su2 sp2) (expect (buttercup-suites-total-specs-defined (list su1)) :to-equal 2)))) (describe "The `buttercup-suites-total-specs-pending' function" :var (suites) (before-each (with-local-buttercup (describe "first suite" (it "active test" (expect 1 :to-equal 1)) (xit "pending test")) (xdescribe "second suite" (it "forced pending" (expect 1 :to-equal 2))) (describe "third suite" (it "potentially skipped" (expect 1 :to-equal 1))) (setq suites buttercup-suites))) (it "should return the number of pending specs in a list of suites" (with-local-buttercup (expect (buttercup-suites-total-specs-pending suites) :to-equal 2))) (it "should also count skipped specs" (with-local-buttercup :suites suites (buttercup-mark-skipped "skipped" t) (expect (buttercup-suites-total-specs-pending suites) :to-equal 3)))) (describe "The `buttercup-suites-total-specs-failed' function" (it "should return the number of failed specs in a list of suites" (let ((su1 (make-buttercup-suite :description "su1")) (su2 (make-buttercup-suite :description "su2")) (sp1 (make-buttercup-spec :description "sp1")) (sp2 (make-buttercup-spec :description "sp2" :status 'failed))) (buttercup-suite-add-child su1 su2) (buttercup-suite-add-child su1 sp1) (buttercup-suite-add-child su2 sp2) (expect (buttercup-suites-total-specs-failed (list su1)) :to-equal 1)))) (describe "The `buttercup-suite-full-name' function" (let (su1 su2) (before-each (setq su1 (make-buttercup-suite :description "su1") su2 (make-buttercup-suite :description "su2")) (buttercup-suite-add-child su1 su2)) (it "should return the full name of a suite without parents" (expect (buttercup-suite-full-name su1) :to-equal "su1")) (it "should return the full name of a suite with parents" (expect (buttercup-suite-full-name su2) :to-equal "su1 su2")))) (describe "The `buttercup-spec-full-name' function" (let (su1 su2 sp1 sp2) (before-each (setq su1 (make-buttercup-suite :description "su1") su2 (make-buttercup-suite :description "su2") sp1 (make-buttercup-spec :description "sp1") sp2 (make-buttercup-spec :description "sp2")) (buttercup-suite-add-child su1 su2) (buttercup-suite-add-child su2 sp2)) (it "should return the full name of a spec without parents" (expect (buttercup-spec-full-name sp1) :to-equal "sp1")) (it "should return the full name of a spec with parents" (expect (buttercup-spec-full-name sp2) :to-equal "su1 su2 sp2")))) (describe "The `buttercup-elapsed-time' function" (let ((spytime (current-time))) (before-each (spy-on 'current-time :and-call-fake (lambda () (setq spytime (time-add spytime (seconds-to-time 1.5)))))) (it "should report elapsed time for suites" (let ((suite (make-buttercup-suite))) (buttercup--set-start-time suite) (buttercup--set-end-time suite) (expect (buttercup-elapsed-time suite) :to-equal (seconds-to-time 1.5)))) (it "should report elapsed time for specs" (let ((spec (make-buttercup-spec))) (buttercup--set-start-time spec) (buttercup--set-end-time spec) (expect (buttercup-elapsed-time spec) :to-equal (seconds-to-time 1.5)))))) (describe "The `buttercup--run-suite' function" (before-each (spy-on 'buttercup--set-start-time :and-call-through) (spy-on 'buttercup--set-end-time :and-call-through)) (it "should set start and end time of the suite" (with-local-buttercup (let ((suite (make-buttercup-suite))) (buttercup--run-suite suite) (expect 'buttercup--set-start-time :to-have-been-called-times 1) (expect (buttercup-suite-or-spec-time-started suite) :not :to-be nil) (expect 'buttercup--set-end-time :to-have-been-called-times 1) (expect (buttercup-suite-or-spec-time-ended suite) :not :to-be nil))))) (describe "The `buttercup--run-spec' function" (before-each (spy-on 'buttercup--set-start-time :and-call-through) (spy-on 'buttercup--set-end-time :and-call-through)) (it "should set start and end time of the spec" (with-local-buttercup (let ((spec (make-buttercup-spec))) (buttercup--run-spec spec) (expect 'buttercup--set-start-time :to-have-been-called-times 1) (expect (buttercup-suite-or-spec-time-started spec) :not :to-be nil) (expect 'buttercup--set-end-time :to-have-been-called-times 1) (expect (buttercup-suite-or-spec-time-ended spec) :not :to-be nil)))) (it "should not overwrite pending status with `after-each' results" (with-local-buttercup (let ((suite (make-buttercup-suite)) spec) (let ((buttercup--current-suite suite)) (after-each (ignore)) (setq spec (xit "pending"))) (buttercup--run-suite suite) (expect (buttercup-spec-status spec) :to-be 'pending)))) (describe "should set status to pending" (it "for assume in `before-each'" (with-local-buttercup (describe "suite" (before-each (assume nil "assume nil in before-each")) (it "spec" (expect 1 :to-equal 1)) (after-each (ignore))) (buttercup-run) (expect (buttercup-suites-total-specs-pending buttercup-suites) :to-equal 1))) (it "for assume in spec" (with-local-buttercup (describe "suite" (before-each (ignore)) (it "spec" (assume nil "assume nil in spec")) (after-each (ignore))) (buttercup-run) (expect (buttercup-suites-total-specs-pending buttercup-suites) :to-equal 1))) (it "for assume in `after-each'" (with-local-buttercup (describe "suite" (before-each (ignore)) (it "spec" (expect 1 :to-equal 1)) (after-each (assume nil "assume nil in after-each"))) (buttercup-run) (expect (buttercup-suites-total-specs-pending buttercup-suites) :to-equal 1))))) ;;;;;;;;;;;;;;;;;;;; ;;; Suites: describe (describe "The `describe' macro" (it "should expand to a simple call to the buttercup-describe function" (let ((lexical-binding t)) ; Emacs < 27 needs this? (expect (macroexpand '(describe "description" (+ 1 1))) :to-equal '(buttercup-describe "description" (lambda () (+ 1 1)))))) (it "should support the :var argument" (let ((lexical-binding t)) ; Emacs < 27 needs this? (expect (macroexpand '(describe "description" :var (foo bar) (+ foo bar))) :to-equal '(buttercup-describe "description" (lambda () (let (foo bar) (+ foo bar))))))) (it "should support the :var* argument" (let ((lexical-binding t)) ; Emacs < 27 needs this? (expect (macroexpand '(describe "description" :var* (foo bar) (+ foo bar))) :to-equal '(buttercup-describe "description" (lambda () (let* (foo bar) (+ foo bar))))))) (describe "should error when " (it ":var is not first" (let ((lexical-binding t)) ; Emacs < 27 needs this? (expect (macroexpand '(describe "description" (it "foo") :var (x))) :to-equal '(error "buttercup: :var(*) found in invalid position of describe form \"%s\"" "description")))) (it ":var* is not first" (let ((lexical-binding t)) ; Emacs < 27 needs this? (expect (macroexpand '(describe "description" (it "foo") :var* (x))) :to-equal '(error "buttercup: :var(*) found in invalid position of describe form \"%s\"" "description")))) (it "is expanded with `lexical-binding' nil" (let (lexical-binding) (expect (macroexpand '(describe "lexical-binding" (it "nil" (ignore)))) :to-throw 'buttercup-dynamic-binding-error))))) (describe "The `buttercup-describe' function" (it "should run the enclosing body" (let ((it-ran nil)) (buttercup-describe "foo" (lambda () (setq it-ran t))) (expect it-ran))) (it "should set the `buttercup-suites' variable" (let ((buttercup-suites nil) (description "test to set global value")) (buttercup-describe description (lambda () nil)) (expect (buttercup-suite-description (car buttercup-suites)) :to-equal description))) (it "should add child suites when called nested" (let ((buttercup-suites nil) (desc1 "description1") (desc2 "description2")) (buttercup-describe desc1 (lambda () (buttercup-describe desc2 (lambda () nil)))) (expect (buttercup-suite-description (car buttercup-suites)) :to-equal desc1) (let ((child-suite (car (buttercup-suite-children (car buttercup-suites))))) (expect (buttercup-suite-description child-suite) :to-equal desc2))))) ;;;;;;;;;;;;; ;;; Specs: it (describe "The `it' macro" (it "should expand to a call to the `buttercup-it' function" (expect (macroexpand '(it "description" body)) :to-equal '(buttercup-it "description" (lambda () (buttercup-with-converted-ert-signals body))))) (it "without argument should expand to xit." (expect (macroexpand '(it "description")) :to-equal '(buttercup-xit "description")))) (describe "The `buttercup-it' function" (it "should fail if not called from within a describe form" (expect (let ((buttercup--current-suite nil)) (buttercup-it "" (lambda ()))) :to-throw)) (it "should add a spec to the current suite and return the spec" (let ((buttercup--current-suite (make-buttercup-suite))) (let* ((created (buttercup-it "the test spec" (lambda () 23))) (spec (car (buttercup-suite-children buttercup--current-suite)))) (expect created :to-be spec) (expect (buttercup-spec-description spec) :to-equal "the test spec") (expect (funcall (buttercup-spec-function spec)) :to-equal 23))))) ;;;;;;;;;;;;;;;;;;;;;; ;;; Setup and Teardown (describe "The `before-each' macro" (it "expands to a function call" (expect (macroexpand '(before-each (+ 1 1))) :to-equal '(buttercup-before-each (lambda () (+ 1 1)))))) (describe "The `buttercup-before-each' function" (it "adds its argument to the before-each list of the current suite" (let* ((suite (make-buttercup-suite)) (buttercup--current-suite suite)) (buttercup-before-each 23) (expect (buttercup-suite-before-each suite) :to-equal (list 23))))) (describe "The `after-each' macro" (it "expands to a function call" (expect (macroexpand '(after-each (+ 1 1))) :to-equal '(buttercup-after-each (lambda () (+ 1 1)))))) (describe "The `buttercup-after-each' function" (it "adds its argument to the after-each list of the current suite" (let* ((suite (make-buttercup-suite)) (buttercup--current-suite suite)) (buttercup-after-each 23) (expect (buttercup-suite-after-each suite) :to-equal (list 23))))) (describe "The `before-all' macro" (it "expands to a function call" (expect (macroexpand '(before-all (+ 1 1))) :to-equal '(buttercup-before-all (lambda () (+ 1 1)))))) (describe "The `buttercup-before-all' function" (it "adds its argument to the before-all list of the current suite" (let* ((suite (make-buttercup-suite)) (buttercup--current-suite suite)) (buttercup-before-all 23) (expect (buttercup-suite-before-all suite) :to-equal (list 23))))) (describe "The `after-all' macro" (it "expands to a function call" (expect (macroexpand '(after-all (+ 1 1))) :to-equal '(buttercup-after-all (lambda () (+ 1 1)))))) (describe "The `buttercup-after-all' function" (it "adds its argument to the after-all list of the current suite" (let* ((suite (make-buttercup-suite)) (buttercup--current-suite suite)) (buttercup-after-all 23) (expect (buttercup-suite-after-all suite) :to-equal (list 23))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Disabled Suites: xdescribe (describe "The `xdescribe' macro" (it "expands directly to a function call" (let ((lexical-binding t)) ; Emacs < 27 needs this? (expect (macroexpand '(xdescribe "bla bla" (+ 1 1))) :to-equal '(buttercup-describe "bla bla" (lambda () (signal 'buttercup-pending "PENDING")))))) (it "changes contained it-specs to pending specs" (let ((lexical-binding t)) ; Emacs < 27 needs this? (expect (macroexpand-all '(xdescribe "bla bla" (let ((a 1) b (c 2) (d (it "nested" (+ 1 1)))) (it "spec1" (+ 1 1)) (describe "inner suite" (it "inner spec")) (xit "spec2" (+ 1 1))))) :to-equal '(buttercup-describe "bla bla" #'(lambda () (buttercup-xit "nested") (buttercup-xit "spec1") (buttercup-describe "inner suite" #'(lambda () (buttercup-xit "inner spec") (signal 'buttercup-pending "PENDING"))) (buttercup-xit "spec2") (signal 'buttercup-pending "PENDING")))))) (it "should add a pending suite" (let ((buttercup--current-suite nil) (buttercup-suites nil)) (xdescribe "bla bla" (lambda () nil)) (expect (buttercup-suite-status (car buttercup-suites)) :to-be 'pending)))) ;;;;;;;;;;;;;;;;;;;;;; ;;; Pending Specs: xit (describe "The `xit' macro" (it "expands directly to a function call" (expect (macroexpand '(xit "bla bla" (+ 1 1))) :to-equal '(buttercup-xit "bla bla")))) (describe "The `buttercup-xit' function" (it "should be a no-op" (expect (let ((buttercup--current-suite (make-buttercup-suite))) (buttercup-xit "bla bla" (lambda () (error "Should not happen"))))) :not :to-throw) (it "should add a function that raises a pending signal" (let ((buttercup--current-suite (make-buttercup-suite))) (buttercup-xit "bla bla" (lambda () (error "Should not happen"))) (expect (funcall (buttercup-spec-function (car (buttercup-suite-children buttercup--current-suite)))) :to-throw 'buttercup-pending))) (it "should mark the suite as pending" (let ((buttercup--current-suite (make-buttercup-suite))) (buttercup-xit "bla bla" (lambda ())) (expect (buttercup-spec-status (car (last (buttercup-suite-children buttercup--current-suite)))) :to-be 'pending))) (it "should set the failure description to PENDING" (let* ((buttercup--current-suite (make-buttercup-suite)) (spec (buttercup-xit "bla bla"))) (buttercup--update-with-funcall spec (buttercup-spec-function spec)) (expect (buttercup-suite-or-spec-failure-description spec) :to-equal "PENDING") (expect (buttercup-suite-or-spec-status spec) :to-equal 'pending)))) ;;;;;;;;; ;;; Spies (describe "The Spy" (let (saved-test-function saved-test-command saved-test-function-throws-on-negative) ;; We use `before-all' here because some tests need to access the ;; same function as previous tests in order to work, so overriding ;; the function before each test would invalidate those tests. (before-all (setq saved-test-function (and (fboundp 'test-function) (symbol-function 'test-function)) saved-test-command (and (fboundp 'test-command) (symbol-function 'test-command)) saved-test-function-throws-on-negative (and (fboundp 'test-function-throws-on-negative) (symbol-function 'test-function-throws-on-negative))) (fset 'test-function (lambda (a b) (+ a b))) (fset 'test-command (lambda () (interactive) t)) (fset 'test-function-throws-on-negative (lambda (x) (if (>= x 0) x (error "x is less than zero"))))) (after-all (if saved-test-function (fset 'test-function saved-test-function) (fmakunbound 'test-function)) (if saved-test-command (fset 'test-command saved-test-command) (fmakunbound 'test-command)) (if saved-test-function-throws-on-negative (fset 'test-function-throws-on-negative saved-test-function-throws-on-negative) (fmakunbound 'test-function-throws-on-negative))) (describe "`spy-on' function" (it "replaces a symbol's function slot" (spy-on 'test-function) (expect (test-function 1 2) :to-be nil)) (it "restores the old value after a spec run" (expect (test-function 1 2) :to-equal 3)) (it "allows a spied-on command to be executed as a command" (spy-on 'test-command) (expect (commandp 'test-command)) (expect (command-execute 'test-command) :not :to-throw) (expect 'test-command :to-have-been-called)) (it "can spy on autoloaded functions" (let* ((function-file (make-temp-file "test-file-" nil ".el")) (function-name 'test-autoloaded-function) (defun-form `(defun ,function-name () "An autoloaded function" :loaded-successfully)) (autoload-form (make-autoload defun-form function-file))) (unwind-protect (progn ;; Create the real function in a file (with-temp-file function-file (insert ";; -*-lexical-binding:t-*-\n" (pp-to-string defun-form))) ;; Define the autoload for the function (fmakunbound function-name) (eval autoload-form) (expect (autoloadp (symbol-function function-name))) (spy-on function-name :and-call-through) (expect (not (autoloadp (symbol-function function-name)))) (expect (funcall function-name) :to-be :loaded-successfully)) (delete-file function-file nil)))) (it "can spy on non-existing functions" (spy-on 'local-function) (local-function) (expect 'local-function :to-have-been-called)) (it "only accepts ARG for keywords that use it" (expect (spy-on 'test-function :and-call-through :arg-not-allowed) :to-throw) (expect (spy-on 'test-function nil :arg-not-allowed) :to-throw) (expect (spy-on 'test-function :and-throw-error) :not :to-throw) (expect (test-function 1 2) :to-throw 'error)) (it "works on native-compilation primitives" ;; Redefining certain primitive's trampolines will cause problems, ;; see https://github.com/jorgenschaefer/emacs-buttercup/issues/230 and ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=61880 (spy-on 'file-exists-p :and-return-value t) (expect (spy-on 'buffer-file-name) :not :to-throw) (expect (file-exists-p "foobar")) (expect (buffer-file-name) :not :to-be-truthy) (expect 'file-exists-p :to-have-been-called) (expect 'buffer-file-name :to-have-been-called)) (describe "will signal en error if" (it "used in before-all" (with-local-buttercup (let ((suite (describe "A bad spy scope" (before-all (spy-on 'some-function))))) (expect (buttercup--run-suite suite) :to-throw)))) (it "used directly in describe" (with-local-buttercup (expect (describe "Not in describe" (spy-on 'foo)) :to-throw))))) (describe ":to-have-been-called matcher" (before-each (spy-on 'test-function)) (it "returns false if the spy was not called" (expect (buttercup--apply-matcher :to-have-been-called (list (buttercup--wrap-expr-and-eval ''test-function))) :to-be nil)) (it "returns true if the spy was called at all" (test-function 1 2 3) (expect (buttercup--apply-matcher :to-have-been-called (list (buttercup--wrap-expr-and-eval ''test-function))) :to-be t))) (describe ":to-have-been-called-with matcher" (before-each (spy-on 'test-function)) (it "returns false if the spy was not called at all" (expect (buttercup--apply-matcher :to-have-been-called-with (mapcar #'buttercup--wrap-expr-and-eval '('test-function '1 '2 '3))) :to-equal (cons nil "Expected `test-function' to have been called with (1 2 3), but it was not called at all"))) (it "returns false if the spy was called with different arguments" (test-function 3 2 1) (expect (buttercup--apply-matcher :to-have-been-called-with (mapcar #'buttercup--wrap-expr-and-eval '('test-function 1 2 3))) :to-equal (cons nil "Expected `test-function' to have been called with (1 2 3), but it was called with (3 2 1)"))) (it "returns true if the spy was called with those arguments" (test-function 1 2 3) (expect (buttercup--apply-matcher :to-have-been-called-with (mapcar #'buttercup--wrap-expr-and-eval '('test-function 1 2 3))) :to-be t))) (describe ":to-have-been-called-times matcher" (before-each (spy-on 'test-function)) (it "returns error if the spy was called less than expected" (expect (buttercup--apply-matcher :to-have-been-called-times (mapcar #'buttercup--wrap-expr-and-eval '('test-function 1))) :to-equal (cons nil "Expected `test-function' to have been called 1 time, but it was called 0 times"))) (it "returns error if the spy was called more than expected" (test-function) (test-function) (expect (buttercup--apply-matcher :to-have-been-called-times (mapcar #'buttercup--wrap-expr-and-eval '('test-function 1))) :to-equal (cons nil "Expected `test-function' to have been called 1 time, but it was called 2 times"))) (it "returns true if the spy was called the expected number of times" (test-function) (test-function) (expect (buttercup--apply-matcher :to-have-been-called-times (mapcar #'buttercup--wrap-expr-and-eval '('test-function 2))) :to-equal (cons t "Expected `test-function' to not have been called exactly 2 times, but it was."))) (it "use plural words in error message" (test-function) (test-function) (expect (buttercup--apply-matcher :to-have-been-called-times (mapcar #'buttercup--wrap-expr-and-eval '('test-function 3))) :to-equal (cons nil "Expected `test-function' to have been called 3 times, but it was called 2 times"))) (it "use singular expected word in error message" (expect (buttercup--apply-matcher :to-have-been-called-times (mapcar #'buttercup--wrap-expr-and-eval '('test-function 1))) :to-equal (cons nil "Expected `test-function' to have been called 1 time, but it was called 0 times"))) (it "use singular actual word in error message" (test-function) (expect (buttercup--apply-matcher :to-have-been-called-times (mapcar #'buttercup--wrap-expr-and-eval '('test-function 2))) :to-equal (cons nil "Expected `test-function' to have been called 2 times, but it was called 1 time")))) (describe ":and-call-through keyword functionality" (before-each (spy-on 'test-function :and-call-through)) (it "tracks calls to the function" (test-function 42 23) (expect 'test-function :to-have-been-called)) (it "passes the arguments to the original function" (expect (test-function 2 3) :to-equal 5))) (describe ":and-return-value keyword functionality" (before-each (spy-on 'test-function :and-return-value 23)) (it "tracks calls to the function" (test-function 42 23) (expect 'test-function :to-have-been-called)) (it "returns the specified value" (expect (test-function 2 3) :to-equal 23)) (it "works with strings" (spy-on 'test-function :and-return-value "return value") (expect (test-function 2 3) :to-equal "return value")) (it "works with vectors" (spy-on 'test-function :and-return-value [1 2 3 4]) (expect (test-function 2 3) :to-equal [1 2 3 4])) (it "works with symbols" (spy-on 'test-function :and-return-value 'symbol) (expect (test-function 2 3) :to-equal 'symbol)) (it "works with conses" (spy-on 'test-function :and-return-value '(1 . 2)) (expect (test-function 2 3) :to-equal (cons 1 2))) (it "works with lists" (spy-on 'test-function :and-return-value '(1 2 3)) (expect (test-function 2 3) :to-equal '(1 2 3))) (it "works with alists" (spy-on 'test-function :and-return-value '((first . 1) (second . 2) (third . 3))) (expect (test-function 2 3) :to-equal '((first . 1) (second . 2) (third . 3))))) (describe ":and-call-fake keyword functionality" (before-each (spy-on 'test-function :and-call-fake (lambda (_a _b) 1001))) (it "tracks calls to the function" (test-function 42 23) (expect 'test-function :to-have-been-called)) (it "returns the specified value" (expect (test-function 2 3) :to-equal 1001))) (describe ":and-throw-error keyword functionality" (before-each (spy-on 'test-function :and-throw-error 'error)) (it "throws an error when called" (expect (test-function 1 2) :to-throw 'error "Stubbed error"))) (describe "error-recording functionality" (before-each (spy-on 'test-function-throws-on-negative :and-call-through)) (it "records the function as called even if it throws an error" (expect (test-function-throws-on-negative -5) :to-throw) (expect (buttercup--apply-matcher :to-have-been-called (list (buttercup--wrap-expr-and-eval ''test-function-throws-on-negative))) :to-be t)) (it "counts both successful calls and calls that threw errors" (test-function-throws-on-negative 5) (expect (test-function-throws-on-negative -5) :to-throw) (expect (buttercup--apply-matcher :to-have-been-called-times (mapcar #'buttercup--wrap-expr-and-eval '('test-function-throws-on-negative 2))) :to-equal '(t . "Expected `test-function-throws-on-negative' to not have been called exactly 2 times, but it was."))) (it "records args to the function whether it throw an error or not" (test-function-throws-on-negative 5) (expect (test-function-throws-on-negative -5) :to-throw) (expect (buttercup--apply-matcher :to-have-been-called-with (mapcar #'buttercup--wrap-expr-and-eval '('test-function-throws-on-negative 5))) :to-be t) (expect (buttercup--apply-matcher :to-have-been-called-with (mapcar #'buttercup--wrap-expr-and-eval '('test-function-throws-on-negative -5))) :to-be t)) (it "records the signal thrown by a call to the function" (test-function-throws-on-negative 5) (expect (test-function-throws-on-negative -5) :to-throw 'error) (expect (spy-context-thrown-signal (spy-calls-first 'test-function-throws-on-negative)) :to-throw) (expect (spy-context-thrown-signal (spy-calls-most-recent 'test-function-throws-on-negative)) :to-equal '(error "x is less than zero")))))) ;;;;;;;;;;;;; ;;; Reporters (if (and (fboundp 'equal-including-properties) (plist-member (symbol-plist 'ert-equal-including-properties) 'byte-obsolete-info)) (defalias 'buttercup--test-equal-including-properties 'equal-including-properties "`equal-including-properties' works as a replacement for `ert-equal-including-properties'.") (defalias 'buttercup--test-equal-including-properties 'ert-equal-including-properties "Still needs `ert-equal-including-properties'.")) (buttercup-define-matcher-for-binary-function :to-equal-including-properties buttercup--test-equal-including-properties) (describe "The batch reporters" :var (print-buffer) (let (parent-suite child-suite spec) (before-each (setq parent-suite (make-buttercup-suite :description "parent-suite") child-suite (make-buttercup-suite :description "child-suite") spec (make-buttercup-spec :description "spec") print-buffer (generate-new-buffer "*btrcp-reporter-test*")) (buttercup-suite-add-child parent-suite child-suite) (buttercup-suite-add-child child-suite spec) (spy-on 'send-string-to-terminal :and-call-fake (apply-partially #'send-string-to-ansi-buffer print-buffer)) ;; Convenience function (spy-on 'buttercup-output :and-call-fake (lambda () "Return the text of print-buffer." (with-current-buffer print-buffer (buffer-string))))) (after-each (kill-buffer print-buffer) (setq print-buffer nil)) (describe "on the buttercup-started event" :var (skipped ;; Local var for testing. The real variable is used by the ;; reporter attached to the buttercup instance running ;; these tests. buttercup-reporter-batch--start-time) (before-each (setq skipped (make-buttercup-spec :description "skipped" :status 'pending))) (it "should print the number of specs" (with-local-buttercup :color nil (buttercup-reporter-batch 'buttercup-started (list parent-suite))) (expect (buttercup-output) :to-equal-including-properties "Running 1 specs.\n\n")) (it "should color-print the number of specs with the default color" (with-local-buttercup :color t (buttercup-reporter-batch 'buttercup-started (list parent-suite))) (expect (buttercup-output) :to-equal-including-properties "Running 1 specs.\n\n")) (it "should print the number of skipped specs" (with-local-buttercup :color nil (buttercup-suite-add-child child-suite skipped) (buttercup-reporter-batch 'buttercup-started (list parent-suite))) (expect (buttercup-output) :to-equal-including-properties "Running 1 out of 2 specs.\n\n")) (it "should color-print the number of skipped specs with the default color" (with-local-buttercup :color t (buttercup-suite-add-child child-suite skipped) (buttercup-reporter-batch 'buttercup-started (list parent-suite))) (expect (buttercup-output) :to-equal-including-properties "Running 1 out of 2 specs.\n\n"))) (describe "on the suite-started event" (it "should emit an indented suite description" (with-local-buttercup :color nil (buttercup-reporter-batch 'suite-started child-suite)) (expect (buttercup-output) :to-equal-including-properties " child-suite\n")) (it "should color-print an indented suite description with the default color" (with-local-buttercup :color t (buttercup-reporter-batch 'suite-started child-suite)) (expect (buttercup-output) :to-equal-including-properties " child-suite\n"))) (describe "on the spec-started event" (it "should emit an indented spec description" (with-local-buttercup :color nil (buttercup-reporter-batch 'spec-started spec)) (expect (buttercup-output) :to-equal-including-properties " spec")) (it "should color-print an indented spec description with the default color" (with-local-buttercup :color t (buttercup-reporter-batch 'spec-started spec)) (expect (buttercup-output) :to-equal-including-properties " spec"))) (describe "on the spec-done event" (describe "for a passed spec" (before-each (buttercup--set-start-time spec) (setf (buttercup-spec-failure-description spec) "DONTSHOW") (buttercup--set-end-time spec)) (it "should print no status tag" (with-local-buttercup :color nil (buttercup-reporter-batch 'spec-started spec) (buttercup-reporter-batch 'spec-done spec)) (expect (buttercup-output) :to-equal-including-properties (format " spec (%s)\n" (buttercup-elapsed-time-string spec)))) (it "should color-print the description in green and no status tag" (with-local-buttercup :color t (buttercup-reporter-batch 'spec-started spec) (buttercup-reporter-batch 'spec-done spec)) (expect (buttercup-output) :to-equal-including-properties (ansi-color-apply (format "\e[32m spec\e[0m (%s)\n" (buttercup-elapsed-time-string spec))))) (it "should print multiline specs cleanly" (setf (buttercup-spec-description spec) "one\ntwo\vthree") (with-local-buttercup :color nil (buttercup-reporter-batch 'spec-started spec) (buttercup-reporter-batch 'spec-done spec)) (expect (buttercup-output) :to-equal-including-properties (format " one\ntwo\n three (%s)\n" (buttercup-elapsed-time-string spec)))) (it "should color-print multiline specs cleanly" (setf (buttercup-spec-description spec) "one\ntwo\vthree") (with-local-buttercup :color t (buttercup-reporter-batch 'spec-started spec) (buttercup-reporter-batch 'spec-done spec)) (expect (buttercup-output) :to-equal-including-properties (ansi-color-apply (format "\e[32m one\ntwo\n three\e[0m (%s)\n" (buttercup-elapsed-time-string spec)))))) (describe "for a failed spec" (before-each (buttercup--set-start-time spec) (setf (buttercup-spec-status spec) 'failed) (buttercup--set-end-time spec)) (it "should say FAILED" (with-local-buttercup :color nil (buttercup-reporter-batch 'spec-started spec) (buttercup-reporter-batch 'spec-done spec)) (expect (buttercup-output) :to-equal-including-properties (format " spec FAILED (%s)\n" (buttercup-elapsed-time-string spec)))) (it "should color-print the description in red and say FAILED" (with-local-buttercup :color t (buttercup-reporter-batch 'spec-started spec) (buttercup-reporter-batch 'spec-done spec)) (expect (buttercup-output) :to-equal-including-properties (ansi-color-apply (format "\e[31m spec FAILED\e[0m (%s)\n" (buttercup-elapsed-time-string spec)))))) (describe "for a pending spec" (before-each (buttercup--set-start-time spec) (setf (buttercup-spec-status spec) 'pending (buttercup-spec-failure-description spec) "DESCRIPTION") (buttercup--set-end-time spec)) (it "should output the failure-description" (with-local-buttercup :color nil (buttercup-reporter-batch 'spec-started spec) (buttercup-reporter-batch 'spec-done spec)) (expect (buttercup-output) :to-equal-including-properties (format " spec DESCRIPTION (%s)\n" (buttercup-elapsed-time-string spec)))) (it "should color-print the description and failure-description in yellow" (with-local-buttercup :color t (buttercup-reporter-batch 'spec-started spec) (buttercup-reporter-batch 'spec-done spec)) (expect (buttercup-output) :to-equal-including-properties (ansi-color-apply (format "\e[33m spec DESCRIPTION\e[0m (%s)\n" (buttercup-elapsed-time-string spec)))))) (describe "should throw an error for an unknown spec status" (before-each (setf (buttercup-spec-status spec) 'unknown)) (it "for plain output" (with-local-buttercup :color nil (expect (buttercup-reporter-batch 'spec-done spec) :to-throw))) (it "for colored output" (with-local-buttercup :color t (expect (buttercup-reporter-batch 'spec-done spec) :to-throw))))) (describe "on the suite-done event" (it "should emit a newline at the end of a top-level suite" (with-local-buttercup :color nil (buttercup-reporter-batch 'suite-done parent-suite)) (expect (buttercup-output) :to-equal-including-properties "\n")) (it "should color-print a newline at the end of a top-level suite" (with-local-buttercup :color t (buttercup-reporter-batch 'suite-done parent-suite)) (expect (buttercup-output) :to-equal-including-properties "\n")) (it "should not emit anything at the end of other suites" (with-local-buttercup :color nil (buttercup-reporter-batch 'suite-done child-suite)) (expect (buttercup-output) :to-equal-including-properties "")) (it "should not color-print anything at the end of other suites" (with-local-buttercup :color t (buttercup-reporter-batch 'suite-done child-suite)) (expect (buttercup-output) :to-equal-including-properties ""))) (describe "on the buttercup-done event" :var ((buttercup-reporter-batch--start-time (current-time)) defined-specs pending-specs failed-specs) (before-each (setq defined-specs 10 pending-specs 0 failed-specs 0) (spy-on 'buttercup-suites-total-specs-defined :and-call-fake (lambda (&rest _) defined-specs)) (spy-on 'buttercup-suites-total-specs-pending :and-call-fake (lambda (&rest _) pending-specs)) (spy-on 'buttercup-suites-total-specs-failed :and-call-fake (lambda (&rest _) failed-specs))) (it "should print a summary of run and failing specs" (setq failed-specs 6) (with-local-buttercup :color nil (buttercup-reporter-batch 'buttercup-done nil)) (expect (buttercup-output) :to-match "Ran 10 specs, 6 failed, in [0-9]+.[0-9]+[mu]?s.\n")) (it "should color-print `0 failed' specs in green" (with-local-buttercup :color t (buttercup-reporter-batch 'buttercup-done nil)) (expect (buttercup-output) :to-match "Ran 10 specs, 0 failed, in [0-9]+.[0-9]+[mu]?s.\n") (expect (substring (buttercup-output) 0 (length "Ran 10 specs, 0 failed, in")) :to-equal-including-properties (ansi-color-apply "Ran 10 specs, \e[32m0 failed\e[0m, in"))) (it "should color-print `X failed' specs in red" (setq failed-specs 6) (with-local-buttercup :color t (buttercup-reporter-batch 'buttercup-done nil)) (expect (buttercup-output) :to-match "Ran 10 specs, 6 failed, in [0-9]+.[0-9]+[mu]?s.\n") (expect (substring (buttercup-output) 0 (length "Ran 10 specs, 6 failed, in")) :to-equal-including-properties (ansi-color-apply "Ran 10 specs, \e[31m6 failed\e[0m, in"))) (it "should print a summary separating run and pending specs" (setq pending-specs 3) (with-local-buttercup :color nil (buttercup-reporter-batch 'buttercup-done nil)) (expect (buttercup-output) :to-match "Ran 7 out of 10 specs, 0 failed, in [0-9]+.[0-9]+[mu]?s.\n")) (it "should color-print pending spec count in default color" (setq pending-specs 3) (with-local-buttercup :color t (buttercup-reporter-batch 'buttercup-done nil)) (expect (buttercup-output) :to-match "Ran 7 out of 10 specs, 0 failed, in [0-9]+.[0-9]+[mu]?s.\n") (expect (substring (buttercup-output) 0 (length "Ran 7 out of 10 specs")) :to-equal-including-properties "Ran 7 out of 10 specs")) (it "should not raise any error even if a spec failed" (setf (buttercup-spec-status spec) 'failed) (with-local-buttercup :color nil (expect (buttercup-reporter-batch 'buttercup-done (list spec)) :not :to-throw))) ) (describe "on an unknown event" (it "should raise an error" (expect (buttercup-reporter-batch 'unknown-event nil) :to-throw))))) (describe "Backtraces" :var (print-buffer) ;; redirect output to a buffer (before-each (setq print-buffer (generate-new-buffer "*btrcp-reporter-test*")) (spy-on 'send-string-to-terminal :and-call-fake (apply-partially #'send-string-to-ansi-buffer print-buffer)) ;; Convenience function (spy-on 'buttercup-output :and-call-fake (lambda () "Return the text of print-buffer." (with-current-buffer print-buffer (buffer-string))))) (after-each (kill-buffer print-buffer) (setq print-buffer nil)) ;; define a buttercup-reporter-batch variant that only outputs on ;; buttercup-done, because that is where backtraces are printed (before-each (spy-on 'backtrace-reporter :and-call-fake (lambda (event arg) (if (eq event 'buttercup-done) (buttercup-reporter-batch event arg) (cl-letf (((symbol-function 'buttercup--print) #'ignore)) (buttercup-reporter-batch event arg)))))) ;; suppress the summary line (before-each (spy-on 'buttercup-reporter-batch--print-summary)) ;; define a known backtrace with a typical error (before-all (defun bc-bt-baz (a) (or (number-or-marker-p a) (signal 'wrong-type-argument `(number-or-marker-p ,a)))) (with-no-warnings (defun bc-bt-bar (a) (bc-bt-baz a)) (defun bc-bt-foo (a) (bc-bt-bar a)))) (after-all (fmakunbound 'bc-bt-foo) (fmakunbound 'bc-bt-bar) (fmakunbound 'bc-bt-baz)) (describe "should not be collected or printed for" :var (test-suites) (before-each (setq test-suites nil) (spy-on 'buttercup--backtrace :and-call-through) ) (it "failed specs" (with-local-buttercup :reporter #'backtrace-reporter (describe "suite" (it "expect 2" (expect (+ 1 2) :to-equal 2)) (it "expect nil" (expect nil))) (buttercup-run :noerror) (setq test-suites buttercup-suites)) (expect 'buttercup--backtrace :not :to-have-been-called) ;; Checking both if buttercup--backtrace have been called and ;; the failure-stack value might be overkill (expect (cl-every #'null (mapcar #'buttercup-spec-failure-stack (buttercup-suite-children (car test-suites))))) (expect (buttercup-output) :to-match (rx string-start (= 40 ?=) "\nsuite expect " "2" "\nFAILED: " (+ not-newline) "\n\n" (= 40 ?=) "\nsuite expect " "nil" "\nFAILED: " (+ not-newline) "\n\n" string-end))) (it "passed specs" (with-local-buttercup :reporter #'backtrace-reporter (describe "suite" (it "expect 2" (expect (+ 1 1) :to-equal 2)) (it "expect t" (expect t))) (buttercup-run :noerror) (setq test-suites buttercup-suites)) (expect 'buttercup--backtrace :not :to-have-been-called) ;; Checking both if buttercup--backtrace have been called and ;; the failure-stack value might be overkill (expect (cl-every #'null (mapcar #'buttercup-spec-failure-stack (buttercup-suite-children (car test-suites))))) (expect (buttercup-output) :to-equal "")) (it "skipped specs" (with-local-buttercup :reporter #'backtrace-reporter (describe "one description with" (it "one skipped spec" (buttercup-skip "skip")) (xit "one empty spec") (it "one un-assumed spec" (assume nil "A very unassuming spec"))) (buttercup-run :noerror) (setq test-suites buttercup-suites)) (expect 'buttercup--backtrace :not :to-have-been-called) ;; Checking both if buttercup--backtrace have been called and ;; the failure-stack value might be overkill (expect (cl-every #'null (mapcar #'buttercup-spec-failure-stack (buttercup-suite-children (car test-suites))))) (expect (buttercup-output) :to-equal ""))) (describe "should be collected for errors in" (it "matchers" (put :--failing-matcher 'buttercup-matcher (lambda (&rest _) (/ 1 0))) (with-local-buttercup :reporter #'backtrace-reporter (describe "One suite with" (it "a bad matcher" (expect 1 :--failing-matcher 1))) (buttercup-run :no-error)) (put :--failing-matcher 'buttercup-matcher nil) (expect (buttercup-output) :to-equal (concat (make-string 40 ?=) "\n" "One suite with a bad matcher\n" "\n" "Traceback (most recent call last):\n" " :--failing-matcher(1 1)\n" " /(1 0)\n" "error: (arith-error)\n\n" ))) ) (describe "with style" :var (test-suites long-string) ;; Set up tests to test (before-each (setq long-string ;; It's important that this string doesn't contain any ;; regex special characters, it's used in a `rx' `eval' ;; form that will escape them. Later Emacsen have ;; `literal' that is much easier to use. "a string that will be truncated in backtrace crop, at least 70 chars long") (with-local-buttercup (describe "suite" (it "bc-bt-backtrace" (expect (bc-bt-foo long-string) :to-be-truthy))) (setq test-suites buttercup-suites))) (after-each (setq test-suites nil)) (it "`crop' should print truncated lines" (with-local-buttercup :suites test-suites :reporter #'backtrace-reporter :frame-style 'crop (buttercup-run :noerror) (setq long-string (truncate-string-to-width long-string 63)) (expect (buttercup-output) :to-match (rx-to-string `(seq string-start (= 40 ?=) "\n" "suite bc-bt-backtrace\n" "\n" "Traceback (most recent call last):\n" " bc-bt-foo(\"" (eval ,long-string) "...\n" " bc-bt-bar(\"" (eval ,long-string) "...\n" " bc-bt-baz(\"" (eval ,long-string) "...\n" (* (seq " " (or (seq (= 74 not-newline) (= 3 ?.)) (seq (** 0 74 not-newline) (= 3 (not (any ?.))))) "\n")) "error: (" (* anything) ")\n\n" string-end))))) (it "`full' should print full lines" (with-local-buttercup :suites test-suites :reporter #'backtrace-reporter :frame-style 'full (buttercup-run :noerror) (expect (buttercup-output) :to-match (rx-to-string `(seq string-start (= 40 ?=) "\n" "suite bc-bt-backtrace\n" "\n" "Traceback (most recent call last):\n" " bc-bt-foo(\"" (eval ,long-string) "\")\n" " bc-bt-bar(\"" (eval ,long-string) "\")\n" " bc-bt-baz(\"" (eval ,long-string) "\")\n" (* (seq " " (* not-newline) (= 3 (not (any ?.))) "\n")) "error: (" (* anything) ")\n\n" string-end))))) (it "`pretty' should pretty-print frames" (with-local-buttercup :suites test-suites :reporter #'backtrace-reporter :frame-style 'pretty (buttercup-run :noerror) (expect (buttercup-output) :to-match (rx-to-string `(seq string-start (= 40 ?=) "\n" "suite bc-bt-backtrace\n" "\n" "Traceback (most recent call last):\n" "λ (bc-bt-foo" (+ (or blank ?\n)) "\"" (regex ,long-string) "\")\n" "λ (bc-bt-bar" (+ (or blank ?\n)) "\"" (regex ,long-string) "\")\n" "λ (bc-bt-baz" (+ (or blank ?\n)) "\"" (regex ,long-string) "\")\n" (* (seq (or ?M ?λ) " (" (* not-newline) ; frame start (*? (seq "\n " (* not-newline))) ; any number of pp lines (* not-newline) ")\n")) ;; frame end "error: (" (* anything) ")\n\n" string-end))))) (it "`omit' should print nothing" (with-local-buttercup :suites test-suites :reporter #'backtrace-reporter :frame-style 'omit (buttercup-run :noerror) (expect (buttercup-output) :to-equal "")))) (it "should signal an error for unknown styles" (let ((buttercup-stack-frame-style 'not-a-valid-style)) (expect (buttercup--format-stack-frame '(t myfun 1 2)) :to-throw 'error '("Unknown stack trace style: not-a-valid-style")))) (describe "should generate correct backtrace for" (cl-macrolet ((matcher-spec (description &rest matcher) `(it ,description (with-local-buttercup :reporter #'backtrace-reporter (describe "backtrace for" (it "matcher" (expect (bc-bt-baz "text") ,@matcher))) (buttercup-run :noerror) (expect (buttercup-output) :to-equal ,(mapconcat #'identity `(,(make-string 40 ?=) "backtrace for matcher" "" "Traceback (most recent call last):" " bc-bt-baz(\"text\")" ,(concat " (or (number-or-marker-p a) (signal " (if (< emacs-major-version 27) "(quote wrong-type-argument) (list (quot..." "'wrong-type-argument (list 'number-or-m...")) " signal(wrong-type-argument (number-or-marker-p \"text\"))" "error: (wrong-type-argument number-or-marker-p \"text\")" "" "") "\n")))))) (matcher-spec "no matcher") (matcher-spec ":to-be-truthy" :to-be-truthy) (matcher-spec ":not :to-be-truthy" :not :to-be-truthy) (matcher-spec ":to-be" :to-be 3) (matcher-spec ":not :to-be" :not :to-be 3) (matcher-spec ":to-equal" :to-equal 3) (matcher-spec ":not :to-equal" :not :to-equal 3) (matcher-spec ":to-have-same-items-as" :to-have-same-items-as '(3)) (matcher-spec ":not :to-have-same-items-as" :not :to-have-same-items-as '(3)) (matcher-spec ":to-match" :to-match ".") (matcher-spec ":not :to-match" :not :to-match ".") (matcher-spec ":to-be-in" :to-be-in '(2)) (matcher-spec ":not :to-be-in" :not :to-be-in '(2)) (matcher-spec ":to-contain" :to-contain 2) (matcher-spec ":not :to-contain" :not :to-contain 2) (matcher-spec ":to-be-less-than" :to-be-less-than 2) (matcher-spec ":not :to-be-less-than" :not :to-be-less-than 2) (matcher-spec ":to-be-greater-than" :to-be-greater-than 2) (matcher-spec ":not :to-be-greater-than" :not :to-be-greater-than 2) (matcher-spec ":to-be-weakly-less-than" :to-be-weakly-less-than 2) (matcher-spec ":not :to-be-weakly-less-than" :not :to-be-weakly-less-than 2) (matcher-spec ":to-be-weakly-greater-than" :to-be-weakly-greater-than 2) (matcher-spec ":not :to-be-weakly-greater-than" :not :to-be-weakly-greater-than 2) (matcher-spec ":to-be-close-to" :to-be-close-to 2 0.3) (matcher-spec ":not :to-be-close-to" :not :to-be-close-to 2 0.2) ;; (matcher-spec ":to-throw" :to-throw) ;; (matcher-spec ":not :to-throw" :not :to-throw) (matcher-spec ":to-have-been-called" :to-have-been-called) (matcher-spec ":not :to-have-been-called" :not :to-have-been-called) (matcher-spec ":to-have-been-called-with" :to-have-been-called-with 2) (matcher-spec ":not :to-have-been-called-with" :not :to-have-been-called-with 2) (matcher-spec ":to-have-been-called-times" :to-have-been-called-times 2) (matcher-spec ":not :to-have-been-called-times" :not :to-have-been-called-times 2) (matcher-spec "function matcher" (lambda (_) t)) (matcher-spec ":not function matcher" :not (lambda (_) nil))))) (describe "When using quiet specs in the batch reporter" :var (print-buffer spytime) (before-each ;; Make sure each fake spec is reporting exactly 1 second elapsed time (setq spytime (current-time)) (spy-on 'current-time :and-call-fake (lambda () (setq spytime (time-add spytime (seconds-to-time 1.0)))))) (before-each ;; Collect output in a buffer instead of printing to terminal (setq print-buffer (generate-new-buffer "*btrcp-reporter-test*")) (spy-on 'send-string-to-terminal :and-call-fake (apply-partially #'send-string-to-ansi-buffer print-buffer)) ;; Convenience function (spy-on 'buttercup-output :and-call-fake (lambda () "Return the text of `print-buffer'." (with-current-buffer print-buffer (buffer-string))))) (after-each (kill-buffer print-buffer) (setq print-buffer nil)) (describe "it should print nothing if all specs are quiet" :var (test-suites) (before-each (with-local-buttercup (describe "top" (it "spec 1") (describe "second" (it "spec 2") (it "spec 3"))) (describe "empty") (setq test-suites buttercup-suites))) (after-each (setq test-suites nil)) (it "and color is disabled" (with-local-buttercup :color nil :quiet '(pending) :reporter #'buttercup-reporter-batch :suites test-suites (buttercup-run)) (expect (buttercup-output) :to-equal "Running 0 out of 3 specs.\n\nRan 0 out of 3 specs, 0 failed, in 13.00s.\n")) (it "and color is enabled" (with-local-buttercup :color t :quiet '(pending) :reporter #'buttercup-reporter-batch :suites test-suites (buttercup-run)) (expect (buttercup-output) :to-equal "Running 0 out of 3 specs.\n\nRan 0 out of 3 specs, 0 failed, in 13.00s.\n"))) (describe "should print the containing suites for non-quiet specs" :var (test-suites) (before-each (with-local-buttercup (describe "top" (it "spec 1" (ignore)) (describe "second" (it "spec 2") (it "spec 3" (ignore)) (describe "third" (it "spec 4")))) (describe "empty") (setq test-suites buttercup-suites))) (after-each (setq test-suites nil)) (it "and color is disabled" (with-local-buttercup :color nil :quiet '(pending) :reporter #'buttercup-reporter-batch :suites test-suites (buttercup-run)) (expect (buttercup-output) :to-equal (concat "Running 2 out of 4 specs.\n\n" "top\n" " spec 1 (1.00s)\n" " second\n" " spec 3 (1.00s)\n\n" "Ran 2 out of 4 specs, 0 failed, in 19.00s.\n"))) (it "and color is enabled" (with-local-buttercup :color t :quiet '(pending) :reporter #'buttercup-reporter-batch :suites test-suites (buttercup-run)) (expect (buttercup-output) :to-equal (concat "Running 2 out of 4 specs.\n\n" "top\n" " spec 1 (1.00s)\n" " second\n" " spec 3 (1.00s)\n\n" "Ran 2 out of 4 specs, 0 failed, in 19.00s.\n")))) (describe "should quiet all of the given spec statuses" :var (test-suites) (before-each (with-local-buttercup (describe "passed" (it "passed" (ignore))) (describe "failed" (it "failed" (buttercup-fail "because"))) (describe "pending" (it "pending")) (setq test-suites buttercup-suites))) (after-each (setq test-suites nil)) (it "and color is disabled" ;; suppress stacktraces printed at buttercup-done (spy-on 'buttercup-reporter-batch--print-failed-spec-report) (with-local-buttercup :color nil :quiet '(pending passed failed) :reporter #'buttercup-reporter-batch :suites test-suites (buttercup-run t)) (expect (buttercup-output) :to-equal "Running 2 out of 3 specs.\n\nRan 2 out of 3 specs, 1 failed, in 13.00s.\n")) (it "and color is enabled" ;; suppress stacktraces printed at buttercup-done (spy-on 'buttercup-reporter-batch--print-failed-spec-report) (with-local-buttercup :color t :quiet '(pending passed failed) :reporter #'buttercup-reporter-batch :suites test-suites (buttercup-run t)) (expect (buttercup-output) :to-equal "Running 2 out of 3 specs.\n\nRan 2 out of 3 specs, 1 failed, in 13.00s.\n"))) (it "should handle `skipped' virtual status in quiet list" ;; suppress stacktraces printed at buttercup-done (spy-on 'buttercup-reporter-batch--print-failed-spec-report) (with-local-buttercup :color nil :quiet '(skipped) :reporter #'buttercup-reporter-batch (describe "passed" (it "passed" (ignore))) (describe "failed" (it "failed" (buttercup-fail "because"))) (describe "pending" (it "pending")) (describe "skipped" (it "skipped" (ignore))) (buttercup-mark-skipped "skipped") (buttercup-run t)) (expect (buttercup-output) :to-equal (concat "Running 2 out of 4 specs.\n\n" "passed\n passed (1.00s)\n\n" "failed\n failed because (1.00s)\n\n" "pending\n pending PENDING (1.00s)\n\n" "Ran 2 out of 4 specs, 1 failed, in 20.00s.\n"))) (it "should handle `disabled' virtual status in quiet list" ;; suppress stacktraces printed at buttercup-done (spy-on 'buttercup-reporter-batch--print-failed-spec-report) (with-local-buttercup :color nil :quiet '(disabled) :reporter #'buttercup-reporter-batch (describe "passed" (it "passed" (ignore))) (describe "failed" (it "failed" (buttercup-fail "because"))) (describe "pending" (it "pending")) (describe "skipped" (it "skipped" (ignore))) (buttercup-mark-skipped "skipped") (buttercup-run t)) (expect (buttercup-output) :to-equal (concat "Running 2 out of 4 specs.\n\n" "passed\n passed (1.00s)\n\n" "failed\n failed because (1.00s)\n\n" "skipped\n skipped SKIPPED (1.00s)\n\n" "Ran 2 out of 4 specs, 1 failed, in 20.00s.\n")))) ;;;;;;;;;;;;;;;;;;;;; ;;; buttercup-run (describe "The `buttercup-run' function" :var (parent-suite child-suite spec) (before-each (setq parent-suite (make-buttercup-suite :description "parent-suite") child-suite (make-buttercup-suite :description "child-suite") spec (make-buttercup-spec :description "spec")) (buttercup-suite-add-child parent-suite child-suite) (buttercup-suite-add-child child-suite spec) (spy-on 'reporter) (spy-on 'buttercup--run-suite)) (it "should signal an error if no suites are defined" (with-local-buttercup (expect (buttercup-run) :to-throw 'error '("No suites defined")))) (it "should return :no-suites for no suites and noerror" (with-local-buttercup (expect (buttercup-run t) :to-equal :no-suites))) (it "should raise an error if at least one spec failed" (setf (buttercup-spec-status spec) 'failed) (with-local-buttercup :suites (list parent-suite) (expect (buttercup-run) :to-throw 'buttercup-run-specs-failed '("")))) (it "should return nil for failing specs and noerror" (setf (buttercup-spec-status spec) 'failed) (with-local-buttercup :suites (list parent-suite) (expect (buttercup-run t) :not :to-be-truthy))) (it "should return t for passing specs" (with-local-buttercup :suites (list parent-suite) (expect (buttercup-run) :to-be-truthy) (expect (buttercup-run t) :to-be-truthy))) (it "should call the reporter twice with events buttercup-started and -done" (with-local-buttercup :suites (list parent-suite) :reporter 'reporter (expect (buttercup-run) :not :to-throw) (expect 'reporter :to-have-been-called-times 2) (expect 'reporter :to-have-been-called-with 'buttercup-started buttercup-suites) (expect 'reporter :to-have-been-called-with 'buttercup-done buttercup-suites))) (it "should call `buttercup--run-suite' once per suite" (with-local-buttercup :reporter 'reporter :suites (make-list 5 parent-suite) (expect (buttercup-run) :not :to-throw) (expect 'buttercup--run-suite :to-have-been-called-times 5)))) (describe "The `buttercup--print' function" (before-each (spy-on 'send-string-to-terminal)) (it "should send a formatted string to the terminal" (buttercup--print "Hello, %s" "world") (expect 'send-string-to-terminal :to-have-been-called-with "Hello, world"))) (describe "The `buttercup-mark-skipped' function" :var (suites) (before-each (with-local-buttercup (describe "first suite" (describe "inner suite" (it "1-1-1 spec" (ignore)) (it "1-1-2 spec" (ignore)) (it "1-1-3 spec" (ignore)) (it "1-1-4 spec" (ignore)) (it "1-1-5 spec" (ignore)) (xit "1-1-6 spec" (ignore))) (it "1-1 spec" (ignore))) (xdescribe "second suite" (it "2-1 spec" (ignore)) (it "2-2 spec" (ignore)) (it "2-3 spec" (ignore)) (it "2-4 spec" (ignore))) (setq suites buttercup-suites))) (it "should do nothing with a reversed match-all pattern" (expect (buttercup-suites-total-specs-defined suites) :to-equal 11) (expect (buttercup-suites-total-specs-pending suites) :to-equal 5) (with-local-buttercup :suites suites (buttercup-mark-skipped "." t)) (expect (buttercup-suites-total-specs-defined suites) :to-equal 11) (expect (buttercup-suites-total-specs-pending suites) :to-equal 5) (with-local-buttercup :suites suites (buttercup-run)) (expect (buttercup-suites-total-specs-pending suites) :to-equal 5) (expect (cl-count "SKIPPED" (buttercup--specs suites) :key #'buttercup-spec-failure-description) :to-equal 0)) (it "should mark all specs as pending with a reversed match none pattern" (with-local-buttercup :suites suites (buttercup-mark-skipped "[z-a]" t)) (expect (buttercup-suites-total-specs-defined suites) :to-equal 11) (expect (buttercup-suites-total-specs-pending suites) :to-equal 11)) (it "should handle multiple patterns" (with-local-buttercup :suites suites (buttercup-mark-skipped '("1-1-1" "1-1-2" "1-4" "2-4") t)) (expect (buttercup-suites-total-specs-defined suites) :to-equal 11) (expect (buttercup-suites-total-specs-pending suites) :to-equal 8)) (it "should support predicates" (with-local-buttercup :suites suites (buttercup-mark-skipped (lambda (spec) (= 2 (cl-count ?- (buttercup-spec-full-name spec)))))) (expect (buttercup-suites-total-specs-defined suites) :to-equal 11) (expect (buttercup-suites-total-specs-pending suites) :to-equal 10)) (it "should support reversed predicates" (with-local-buttercup :suites suites (buttercup-mark-skipped (lambda (spec) (= 2 (cl-count ?- (buttercup-spec-full-name spec)))) t)) (expect (buttercup-suites-total-specs-defined suites) :to-equal 11) (expect (buttercup-suites-total-specs-pending suites) :to-equal 6)) (it "should signal an error for invalid matchers" (with-local-buttercup (expect (buttercup-mark-skipped 4) :to-throw)) (with-local-buttercup (expect (buttercup-mark-skipped (list "re" "re" 5 "re")) :to-throw))) ) ;;;;;;;;;;;;;;;;;;;;; ;;; ERT Compatibility (describe "Buttercup's ERT compatibility wrapper" (it "should convert `ert-test-failed' into `buttercup-failed'" (expect (buttercup-with-converted-ert-signals (should (equal 1 2))) :to-throw 'buttercup-failed)) (it "should convert `ert-test-skipped' into `buttercup-pending'" (assume (functionp 'ert-skip) "Loaded ERT version does not provide `ert-skip'") (expect (buttercup-with-converted-ert-signals (ert-skip "Skipped this test")) :to-throw 'buttercup-pending))) ;;;;;;;;;;;;;;;;;; ;;; test discovery (describe "`buttercup-run-discover' should" (describe "parse command line arguments" (before-each (spy-on 'buttercup-run) (spy-on 'buttercup-mark-skipped) (spy-on 'directory-files-recursively) (spy-on 'buttercup-error-on-stale-elc)) (it "ignoring `--'" (let ((command-line-args-left '("--"))) (buttercup-run-discover) (expect command-line-args-left :to-equal nil))) (it "requiring an extra argument for `--traceback'" (let ((command-line-args-left '("--traceback"))) (expect (buttercup-run-discover) :to-throw 'error '("Option requires argument: --traceback")))) (it "checking `--traceback' argument for validity" (let ((command-line-args-left '("--traceback" "unknown"))) (with-local-buttercup (expect (buttercup-run-discover) :to-throw 'error '("Unknown stack trace style: unknown"))))) (it "setting `buttercup-stack-frame-style' from `--traceback' arg" (let ((command-line-args-left '("--traceback" "full"))) (with-local-buttercup (buttercup-run-discover) (expect buttercup-stack-frame-style :to-equal 'full)) (expect command-line-args-left :to-equal nil))) (it "requiring an extra argument for `--pattern' or `-p'" (let ((command-line-args-left '("--pattern"))) (expect (buttercup-run-discover) :to-throw 'error '("Option requires argument: --pattern")) (setq command-line-args-left '("-p")) (expect (buttercup-run-discover) :to-throw 'error '("Option requires argument: -p")))) (it "collecting `--pattern' and `-p' args and send to `buttercup-mark-skipped'" (let ((command-line-args-left '("--pattern" "foo" "-p" "bar" "--pattern" "baz")) buttercup-mark-skipped-args) (buttercup-run-discover) (expect command-line-args-left :to-equal nil) (expect 'buttercup-mark-skipped :to-have-been-called-times 1) (setq buttercup-mark-skipped-args (car (spy-calls-args-for 'buttercup-mark-skipped 0))) (expect buttercup-mark-skipped-args :to-have-same-items-as '("foo" "bar" "baz")))) (it "clearing `buttercup-color' if `--no-color' is given" (let ((command-line-args-left '("--no-color")) (buttercup-color t)) (buttercup-run-discover) (expect buttercup-color :to-equal nil) (expect command-line-args-left :to-equal nil) (setq command-line-args-left '("-c") buttercup-color t) (buttercup-run-discover) (expect buttercup-color :to-equal nil) (expect command-line-args-left :to-equal nil))) (it "adding `skipped' and `disabled' to quiet statuses if `--no-skip' is given" (let ((command-line-args-left '("--no-skip"))) (with-local-buttercup (buttercup-run-discover) (expect buttercup-reporter-batch-quiet-statuses :to-contain 'skipped) (expect buttercup-reporter-batch-quiet-statuses :to-contain 'disabled)) (expect command-line-args-left :to-equal nil))) (it "adding `pending' and `passed' to quiet statuses if `--only-error' is given" (let ((command-line-args-left '("--only-error"))) (with-local-buttercup (buttercup-run-discover) (expect buttercup-reporter-batch-quiet-statuses :to-contain 'pending) (expect buttercup-reporter-batch-quiet-statuses :to-contain 'passed)) (expect command-line-args-left :to-equal nil))) (it "calling `buttercup-error-on-stale-elc' if `--stale-file-error' is given" (let ((command-line-args-left '("--stale-file-error"))) (with-local-buttercup (buttercup-run-discover) (expect 'buttercup-error-on-stale-elc :to-have-been-called-times 1) (expect command-line-args-left :to-equal nil)))) (it "search any unknown args for test files" (let ((command-line-args-left '("foo" "--traceback" "full" "bar" "--strange" "baz"))) (with-local-buttercup (buttercup-run-discover) (expect 'directory-files-recursively :to-have-been-called-times 4) (expect 'directory-files-recursively :to-have-been-called-with "foo" "\\`test-.*\\.el\\'\\|-tests?\\.el\\'") (expect 'directory-files-recursively :to-have-been-called-with "bar" "\\`test-.*\\.el\\'\\|-tests?\\.el\\'") (expect 'directory-files-recursively :to-have-been-called-with "--strange" "\\`test-.*\\.el\\'\\|-tests?\\.el\\'") (expect 'directory-files-recursively :to-have-been-called-with "baz" "\\`test-.*\\.el\\'\\|-tests?\\.el\\'")) (expect command-line-args-left :to-equal nil))) ) (describe "find and load files" (before-each (spy-on 'buttercup-run) (spy-on 'buttercup-mark-skipped) (spy-on 'load) (spy-on 'relative-load-path :and-call-fake (lambda (args) "Return `car' of args relative to `default-directory'." (replace-regexp-in-string (format "^\\(\\./\\|%s\\)" (regexp-quote default-directory)) "" (car args)))) ) (it "named test-*.el and *-tests?.el but no other files" (buttercup--test-with-tempdir '("test.el" "tests.el" "test-actually.el" "foo/test-foo.el" "foo/bar/bar-test.el" "baz/no-test-here.el" "baz/baz-tests.el") (buttercup-run-discover) (expect 'load :to-have-been-called-times 4) (let ((loaded-files (mapcar #'relative-load-path (spy-calls-all-args 'load)))) (expect loaded-files :to-have-same-items-as '("test-actually.el" "foo/test-foo.el" "foo/bar/bar-test.el" "baz/baz-tests.el"))))) (it "only in given directories" (buttercup--test-with-tempdir '("root-tests.el" "a/a-tests.el" "a/b/ab-tests.el" "b/b-tests-el" "b/a/ba-tests.el") (let ((command-line-args-left '("a"))) (buttercup-run-discover)) (expect 'load :to-have-been-called-times 2) (let ((loaded-files (mapcar #'relative-load-path (spy-calls-all-args 'load)))) (expect loaded-files :to-have-same-items-as '("a/a-tests.el" "a/b/ab-tests.el"))))))) ;; The nested debuggers of running buttercup specs inside other ;; buttercup specs does not do the right thing. Write out-of-framework ;; tests for now. (buttercup--test-with-tempdir '("ok-test.el" ("test-a.el" ";;; -*- lexical-binding: t; -*-\n(describe \"foo\"") ("test-b.el" ";;; -*- lexical-binding: t; -*-\n(describe \"bar\" (it \"baz\" (ignore)))")) (let ((load-path (cons default-directory load-path)) buttercup-status-error-caught) (with-local-buttercup (condition-case _condition (buttercup-run-discover) (buttercup-run-specs-failed (setq buttercup-status-error-caught t))) (unless buttercup-status-error-caught (error "Expected buttercup-run-discover to signal a buttercup-run-specs-failed error")) (unless (equal 2 (length buttercup-suites)) (error "Expected suites from test-b.el to be in buttercup-suites")) ))) ;;;;;;;;;;;;; ;;; Utilities ;; We can't test `buttercup--funcall' with buttercup, because the way ;; we get the backtrace from Emacs does not nest. (let ((res (buttercup--funcall (lambda () (+ 2 3)))) (expected '(passed 5 nil))) (when (not (equal res expected)) (error "Expected passing buttercup--funcall to return `%S', not `%S'" expected res))) (let ((res (buttercup--funcall (lambda () (/ 1 0))))) (when (not (and (equal (car res) 'failed) (equal (cadr res) '(error (arith-error))))) (error "Expected erroring buttercup--funcall not to return `%S'" res))) ;;;;;;;;;;;;; ;;; Buttercup-minor-mode (describe "butter-minor-mode" (it "should fontify `describe' special form" (with-temp-buffer (emacs-lisp-mode) (buttercup-minor-mode 1) (font-lock-mode) (insert "(describe \"A test suite\" (it \"should fontify special keywords\"))") (font-lock-fontify-region (point-min) (point-max)) (expect (text-property-any (point-min) (point-max) 'face 'font-lock-keyword-face) :to-equal 2))) (it "should fontify `it' special form" (with-temp-buffer (emacs-lisp-mode) (buttercup-minor-mode 1) (font-lock-mode) (insert "(describe \"A test suite\" (it \"should fontify special keywords\"))") (font-lock-fontify-region (point-min) (point-max)) (expect (text-property-any 15 (point-max) 'face 'font-lock-keyword-face) :to-equal 27))) (it "should add special forms to `imenu'" (with-temp-buffer (require 'imenu) (emacs-lisp-mode) (buttercup-minor-mode 1) (insert "(describe \"A test suite\" (it \"should fontify special keywords\"))") (imenu--make-index-alist) (let ((suites (assoc "Test Suites" imenu--index-alist)) (specs (assoc "Spec" imenu--index-alist))) (expect suites :to-be-truthy) (expect (length (cdr suites)) :to-equal 1) (expect (cl-caadr suites) :to-equal "A test suite") (expect specs :to-be-truthy) (expect (length (cdr specs)) :to-equal 1) (expect (cl-caadr specs) :to-equal "should fontify special keywords")))) (it "should define `buttercup-minor-mode-map'" (expect (boundp 'buttercup-minor-mode-map)))) ;;;;;;;;;;;;;;;;;;; ;;; Stale elc files (describe "For stale `elc' file checks" (describe "`buttercup-check-for-stale-elc'" :var (el-time elc-time) (before-each (spy-on 'file-attributes :and-call-fake (lambda (filename &optional _id-format) (make-list 10 (make-list 4 (pcase (file-name-extension filename) ("elc" elc-time) ("el" el-time))))))) (it "should do nothing for `el' files" (setq el-time 2 ;; elc is older than el elc-time 1) (expect (buttercup-check-for-stale-elc "buttercup.el") :not :to-throw)) (it "should signal error when `elc' is older than `el'" (setq el-time 2 ;; elc is older than el elc-time 1) (expect (buttercup-check-for-stale-elc "buttercup.elc") :to-throw)) (it "should not signal error when `elc' is newer than `el'" (setq el-time 2 ;; elc is older than el elc-time 3) (expect (buttercup-check-for-stale-elc "buttercup.elc") :not :to-throw)) (it "should do nothing if the `el' file does not exist" (setq el-time 3 ;; el is older than elc elc-time 2) (spy-on 'file-exists-p) (expect (buttercup-check-for-stale-elc "buttercup.elc") :not :to-throw))) (describe "`buttercup-error-on-stale-elc'" (it "should activate with no argument" (let (after-load-functions) (buttercup-error-on-stale-elc) (expect after-load-functions :to-contain 'buttercup-check-for-stale-elc))) (it "should deactivate with almost any argument" (let ((after-load-functions '(buttercup-check-for-stale-elc))) (buttercup-error-on-stale-elc 2) (expect after-load-functions :not :to-contain 'buttercup-check-for-stale-elc))) (it "should toggle when given `toggle' as argument" (let (after-load-functions) (buttercup-error-on-stale-elc 'toggle) (expect after-load-functions :to-contain 'buttercup-check-for-stale-elc) (buttercup-error-on-stale-elc 'toggle) (expect after-load-functions :not :to-contain 'buttercup-check-for-stale-elc))))) ;; Local Variables: ;; indent-tabs-mode: nil ;; sentence-end-double-space: nil ;; eval: (buttercup-minor-mode) ;; tab-width: 8 ;; End: (provide 'test-buttercup) ;;; test-buttercup.el ends here