pax_global_header00006660000000000000000000000064125544632720014524gustar00rootroot0000000000000052 comment=aff95243812a9fed0a9c6df79d3557ec01ade18d erlang-proper-1.1+gitfa58f82bdc+dfsg/000077500000000000000000000000001255446327200173155ustar00rootroot00000000000000erlang-proper-1.1+gitfa58f82bdc+dfsg/.gitignore000066400000000000000000000002051255446327200213020ustar00rootroot00000000000000*~ \#*\# *.app *.beam *.dump *.tar.gz deps/ doc/*.css doc/*.html doc/*.png doc/edoc-info include/compile_flags.hrl .directory .eunit erlang-proper-1.1+gitfa58f82bdc+dfsg/.travis.yml000066400000000000000000000003501255446327200214240ustar00rootroot00000000000000language: erlang script: "make all" before_install: dialyzer --build_plt --apps erts kernel stdlib compiler crypto otp_release: - 17.4 - 17.1 - 17.0 - R16B03-1 - R16B03 - R16B02 - R16B01 - R15B03 - R15B02 erlang-proper-1.1+gitfa58f82bdc+dfsg/COPYING000066400000000000000000001045131255446327200203540ustar00rootroot00000000000000 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 . erlang-proper-1.1+gitfa58f82bdc+dfsg/Makefile000066400000000000000000000033431255446327200207600ustar00rootroot00000000000000# Copyright 2010-2013 Manolis Papadakis , # Eirini Arvaniti # and Kostis Sagonas # # This file is part of PropEr. # # PropEr 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. # # PropEr 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 PropEr. If not, see . # Author(s): Manolis Papadakis, Kostis Sagonas # Description: Instructions for make .PHONY: default fast all get-deps compile dialyzer check_escripts tests doc clean distclean rebuild retest ifneq (,$(findstring Windows,$(OS))) SEP := $(strip \) else SEP := $(strip /) endif REBAR := .$(SEP)rebar default: fast fast: get-deps compile all: fast dialyzer doc tests include/compile_flags.hrl: write_compile_flags ./write_compile_flags $@ get-deps: $(REBAR) get-deps compile: $(REBAR) compile dialyzer: compile dialyzer -n -nn -Wunmatched_returns ebin $(find . -path 'deps/*/ebin/*.beam') check_escripts: ./check_escripts.sh make_doc write_compile_flags tests: compile $(REBAR) eunit doc: ./make_doc clean: ./clean_temp.sh distclean: clean rm -f include/compile_flags.hrl $(REBAR) clean rebuild: distclean include/compile_flags.hrl $(REBAR) compile retest: compile rm -rf .eunit $(REBAR) eunit erlang-proper-1.1+gitfa58f82bdc+dfsg/README.md000066400000000000000000000163411255446327200206010ustar00rootroot00000000000000[![Build Status](https://travis-ci.org/manopapad/proper.svg?branch=master)](https://travis-ci.org/manopapad/proper) Contact information and license ------------------------------- PropEr (PROPerty-based testing tool for ERlang) is a QuickCheck-inspired open-source property-based testing tool for Erlang, developed by Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas. The base PropEr system was written mainly by Manolis Papadakis, and the stateful code testing subsystem by Eirini Arvaniti. You can reach PropEr's developers in the following ways: * on the web: at [the project's home page](http://proper.softlab.ntua.gr) or [the project's github page](https://github.com/manopapad/proper) * by email: take the project's home page URL, remove the `http://` prefix and replace the first dot with a @ We welcome user contributions and feedback (comments, suggestions, feature requests, bug reports, patches etc.). Copyright 2010-2015 by Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas. This program is distributed under the [GPL](http://www.gnu.org/licenses/gpl.html), version 3 or later. Please see the COPYING file for details. Introduction ------------ Traditional testing methodologies essentially involve software testers writing a series of test inputs for their programs, along with their corresponding expected outputs, then running the program with these inputs and observing whether it behaves as expected. This method of testing, while simple and easy to automate, suffers from a few problems, such as: * Writing test cases by hand is tedious and time consuming. * It is hard to know whether the test suite covers all aspects of the software under test. Property-based testing is a novel approach to software testing, where the tester needs only specify the generic structure of valid inputs for the program under test, plus certain properties (regarding the program's behaviour and the input-output relation) which are expected to hold for every valid input. A property-based testing tool, when supplied with this information, should randomly produce progressively more complex valid inputs, then apply those inputs to the program while monitoring its execution, to ensure that it behaves according to its specification, as outlined in the supplied properties. Here are a few examples of simple properties a user may wish to test, expressed in natural language: * The program should accept any character string and convert all lowercase letters inside the string to uppercase. * The program should accept any list of integers. If the input list is at least 4 elements long, the program should return the 4th largest integer in the list, else it should throw an exception. PropEr is such a property-based testing tool, designed to test programs written in the Erlang programming language. Its focus is on testing the behaviour of pure functions. On top of that, it is equipped with two library modules that can be used for testing stateful code. The input domain of functions is specified through the use of a type system, modeled closely after the type system of the language itself. Properties are written using Erlang expressions, with the help of a few predefined macros. PropEr is also tightly integrated with Erlang's type language: * Types expressed in the Erlang type language can be used instead of generators written in PropEr's own type system as input data specifications. * Generators for ADTs can be constructed automatically using the ADTs' API functions. * PropEr can test functions automatically, based solely on information provided in their specs. Quickstart guide ---------------- * Obtain a copy of PropEr's sources. You can either get a tagged version of the tool (look under `Tags` on github) or you can clone the current code base: git clone git://github.com/manopapad/proper.git * Compile PropEr: Run `make` if you just want to build PropEr, optionally followed by a `make tests` to run its unit tests and a `make dialyzer` call to also run dialyzer on PropEr's code base; the latter requires having a dialyzer PLT. To do the above but also build PropEr's documentation issue a `make all` call; in that case, you are going to need the `syntax_tools` application and a recent version of `EDoc`). Optionally, sfmt-erlang can be selected as an alternative random number generator using `./configure --use-sfmt` before running `make`. * Add PropEr's base directory to your Erlang library path, using one of the following methods: 1. `ERL_LIBS` environment variable: Add the following line to your shell startup file (`~/.bashrc` in the case of the Bash shell): export ERL_LIBS=/full/path/to/proper 2. Erlang resource file: Add the following line to your `~/.erlang` file: code:load_abs("/full/path/to/proper"). If using the sfmt RNG be sure to add /full/path/to/proper/deps/sfmt too. * Add the following include line to all source files that contain properties: -include_lib("proper/include/proper.hrl"). * Compile those source files, preferably with `debug_info` enabled. * For each property, run: proper:quickcheck(your_module:some_property()). See also the section common problems below if you want to run PropEr from EUnit. Where to go from here --------------------- To get started on using PropEr, see the tutorials and testing tips provided on [PropEr's home page](http://proper.softlab.ntua.gr). On the same site you can find a copy of PropEr's API documentation (you can also build this from source if you prefer, by running `make doc`), as well as links to more resources on property-based testing. Common problems --------------- ### Using PropEr in conjunction with EUnit The main issue is that both systems define a `?LET` macro. To avoid a potential clash, simply include PropEr's header file before EUnit's. That way, any instance of `?LET` will count as a PropEr `?LET`. Another issue is that [EUnit captures standard output][eunit stdout], so normally PropEr output is not visible when `proper:quickcheck()` is invoked from EUnit. You can work around this by passing the option `{to_file, user}` to `proper:quickcheck/2`. For example: ?assertEqual(true, proper:quickcheck(your_mod:some_prop(), [{to_file, user}])). This will make PropEr properties visible also when invoked from EUnit. Incompatibilities with QuviQ's QuickCheck ----------------------------------------- PropEr's notation and output format has been kept quite similar to that of QuviQ's QuickCheck in order to ease the reuse of existing testing code written for that tool. However, incompatibilities are to be expected, since we never run or owned a copy of QuviQ's QuickCheck and the two programs probably bear little resemblance under the hood. Here we provide a nonexhaustive list of known incompatibilities: * `?SUCHTHATMAYBE` behaves differently in PropEr. * `proper_gen:pick/1` differs from `eqc_gen:pick/1` in return value format. * PropEr handles `size` differently from QuickCheck. * `proper:module/2` accepts options in the second argument instead of the first; this is for consistency with other `module/2` functions in Erlang/OTP. [eunit stdout]: http://erlang.org/doc/apps/eunit/chapter.html#Running_EUnit erlang-proper-1.1+gitfa58f82bdc+dfsg/THANKS000066400000000000000000000016241255446327200202330ustar00rootroot00000000000000The following people, in chronological order, have sent us patches or pull requests that have been incorporated in PropEr's code base: 1. Joseph Wayne Norton 2. Yurii Rashkovskii 3. Ryosuke Nakai 4. Krzysiek Goj 5. Thomas Charbonnel 6. Samuel Rivas 7. Motiejus Jakštys 8. Dave Cottlehuber 9. Fredrik Linder 10. Jeff Hlywa 11. Ingo Struck 12. Giacomo Olgeni 13. Hynek Vychodil 14. Zaiming Shi 15. Pino Toscano We sincerely thank them for making PropEr a better tool. In addition to code contributors, the following people have sent us bug reports that have also improved the quality of PropEr. 1. Geoff Cant 2. Jorge Diz Pico 3. Adam Rutkowski ... N. Matyas Markovics Apologies to those who we forgot to mention; we can assure you it's not intentional, we are simply getting older... If you want to be mentioned here, simply report another bug! (There are probably many.) erlang-proper-1.1+gitfa58f82bdc+dfsg/check_escripts.sh000077500000000000000000000024611255446327200226500ustar00rootroot00000000000000#!/bin/sh # Copyright 2010-2011 Manolis Papadakis , # Eirini Arvaniti # and Kostis Sagonas # # This file is part of PropEr. # # PropEr 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. # # PropEr 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 PropEr. If not, see . # Author: Manolis Papadakis # Description: Script for testing the validity of escript files for ESCRIPT_NAME in "$@"; do SRC_FILE="$ESCRIPT_NAME".erl BIN_FILE="$ESCRIPT_NAME".beam > $SRC_FILE echo "-module($ESCRIPT_NAME)." >> $SRC_FILE echo "-export([main/1])." >> $SRC_FILE echo -n "%" >> $SRC_FILE cat $ESCRIPT_NAME >> $SRC_FILE erlc +debug_info $SRC_FILE; true dialyzer -Wunmatched_returns $BIN_FILE; true rm -f $SRC_FILE $BIN_FILE done erlang-proper-1.1+gitfa58f82bdc+dfsg/clean_doc.sh000077500000000000000000000017631255446327200215720ustar00rootroot00000000000000#!/bin/sh # Copyright 2010-2011 Manolis Papadakis , # Eirini Arvaniti # and Kostis Sagonas # # This file is part of PropEr. # # PropEr 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. # # PropEr 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 PropEr. If not, see . # Author: Manolis Papadakis # Description: Cleanup script for EDoc-generated documentation files rm -f doc/*.html doc/stylesheet.css doc/erlang.png doc/edoc-info erlang-proper-1.1+gitfa58f82bdc+dfsg/clean_temp.sh000077500000000000000000000017421255446327200217670ustar00rootroot00000000000000#!/bin/sh # Copyright 2010-2011 Manolis Papadakis , # Eirini Arvaniti # and Kostis Sagonas # # This file is part of PropEr. # # PropEr 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. # # PropEr 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 PropEr. If not, see . # Author: Manolis Papadakis # Description: Cleanup script for temporary files find . \( -name '*~' -or -name '#*#' -or -name '*.dump' \) -delete erlang-proper-1.1+gitfa58f82bdc+dfsg/configure000077500000000000000000000040651255446327200212310ustar00rootroot00000000000000#! /bin/sh # -------------------------------------------------------------------- # Copyright 2010-2013 Manolis Papadakis , # Eirini Arvaniti # and Kostis Sagonas # # This file is part of PropEr. # # PropEr 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. # # PropEr 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 PropEr. If not, see . usage() { echo "usage: $0 [--use-sfmt | --help]" exit 1 } sfmt() { echo "Using the sfmt-erlang random module" grep -q sfmt rebar.config || cat >> rebar.config <, Eirini Arvaniti and Kostis Sagonas This file is part of PropEr. PropEr 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. PropEr 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 PropEr. If not, see . This is the source for PropEr's overview page. @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas @version {@version} @author Manolis Papadakis @title PropEr: A QuickCheck-inspired property-based testing tool for Erlang @doc This is PropEr's Reference Manual. If you are new to PropEr, you should first read the User Guide (available online at PropEr's website, and also in PropEr's README file). The bulk of the PropEr API is contained in the documentation for the following modules:
{@link proper}
how to write properties, how to invoke PropEr, different modes of operation
{@link proper_types}
how to write input data generators for properties
{@link proper_symb}
writing generators for ADTs, both manually and automatically
{@link proper_typeserver}
more information on PropEr's integration with the Erlang type language
{@link proper_fsm}
using PropEr to test stateful systems modeled as finite state machines
{@link proper_statem}
using PropEr to test stateful reactive systems specified via an abstract state machine
{@link proper_unicode}
generating unicode strings and binaries
erlang-proper-1.1+gitfa58f82bdc+dfsg/ebin/000077500000000000000000000000001255446327200202325ustar00rootroot00000000000000erlang-proper-1.1+gitfa58f82bdc+dfsg/ebin/.gitignore000066400000000000000000000000721255446327200222210ustar00rootroot00000000000000# This file is here in order to keep its directory alive. erlang-proper-1.1+gitfa58f82bdc+dfsg/examples/000077500000000000000000000000001255446327200211335ustar00rootroot00000000000000erlang-proper-1.1+gitfa58f82bdc+dfsg/examples/b64.erl000066400000000000000000000026161255446327200222370ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Kostis Sagonas %%% @doc PropEr usage example: Some simple testcases for stdlib's base64 -module(b64). -export([prop_enc_dec/0]). -include_lib("proper/include/proper.hrl"). prop_enc_dec() -> ?FORALL(Msg, union([binary(), list(range(1,255))]), begin EncDecMsg = base64:decode(base64:encode(Msg)), case is_binary(Msg) of true -> EncDecMsg =:= Msg; false -> EncDecMsg =:= list_to_binary(Msg) end end). erlang-proper-1.1+gitfa58f82bdc+dfsg/examples/elevator_fsm.erl000066400000000000000000000167131255446327200243350ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Eirini Arvaniti -module(elevator_fsm). -behaviour(gen_fsm). -behaviour(proper_fsm). -include_lib("proper/include/proper.hrl"). -export([init/1, handle_event/3, handle_sync_event/4, handle_info/3, terminate/3, code_change/4]). -export([initial_state/0, initial_state_data/0, precondition/4, next_state_data/5, postcondition/5]). -compile(export_all). -record(state, {floor = 0 :: non_neg_integer(), %% current floor people = 0 :: non_neg_integer(), %% people inside the elevator num_floors :: non_neg_integer(), %% number of floors in the building limit :: pos_integer()}). %% max number of people allowed -record(test_state, {people = 0 :: non_neg_integer(), num_floors = 5 :: non_neg_integer(), max_people = 10 :: pos_integer()}). %%-------------------------------------------------------------------- %%% API %%-------------------------------------------------------------------- test() -> test(100). test(Tests) -> proper:quickcheck(?MODULE:prop_elevator(), [{numtests,Tests}]). start_link(Info) -> gen_fsm:start_link({local,elevator}, ?MODULE, Info, []). stop() -> gen_fsm:sync_send_all_state_event(elevator, stop). up() -> gen_fsm:send_event(elevator, up). down() -> gen_fsm:send_event(elevator, down). which_floor() -> gen_fsm:sync_send_event(elevator, which_floor). %% N people try to get on the elevator get_on(N) -> gen_fsm:sync_send_event(elevator, {get_on,N}). %% N people get off the elevator (assuming at least N people are inside) get_off(N) -> gen_fsm:send_event(elevator, {get_off,N}). %%-------------------------------------------------------------------- %%% Gen_fsm callbacks %%-------------------------------------------------------------------- init(Info) -> {NumFloors, Limit} = Info, {ok, basement, #state{num_floors = NumFloors, limit = Limit}}. basement(up, S) -> case S#state.num_floors > 0 of true -> {next_state, floor, S#state{floor = 1}}; false -> {next_state, basement, S} end; basement(down, S) -> {next_state, basement, S}; basement({get_off,N}, S) -> People = S#state.people, {next_state, basement, S#state{people = People-N}}. floor(up, S) -> Floor = S#state.floor, NumFloors = S#state.num_floors, case NumFloors > Floor of true -> {next_state, floor, S#state{floor = Floor+1}}; false -> {next_state, floor, S} end; floor(down, S) -> case S#state.floor of 1 -> {next_state, basement, S#state{floor = 0}}; Floor when Floor > 1 -> {next_state, floor, S#state{floor = Floor-1}} end; floor({get_off,N}, S) -> People = S#state.people, {next_state, floor, S#state{people = People-N}}. basement(which_floor, From, S) -> gen_fsm:reply(From, S#state.floor), {next_state, basement, S}; basement({get_on,N}, From, S) -> People = S#state.people, case People+N =< S#state.limit of true -> gen_fsm:reply(From, People+N), {next_state, basement, S#state{people = People+N}}; false -> gen_fsm:reply(From, People), {next_state, basement, S} end. floor(which_floor, From, S) -> gen_fsm:reply(From, S#state.floor), {next_state, floor, S}. handle_event(_Event, StateName, State) -> {next_state, StateName, State}. handle_sync_event(stop, _, _, _) -> {stop,normal,ok,[]}. handle_info(_Info, StateName, State) -> {next_state, StateName, State}. terminate(_Reason, _StateName, _State) -> ok. code_change(_OldVsn, StateName, State, _Extra) -> {ok, StateName, State}. %%-------------------------------------------------------------------- %%% PropEr elevator specification %%-------------------------------------------------------------------- initial_state() -> fsm_basement. initial_state_data() -> #test_state{}. fsm_basement(S) -> [{history,{call,?MODULE,down,[]}}, {history,{call,?MODULE,which_floor,[]}}, {history,{call,?MODULE,get_on,[people(S)]}}, {history,{call,?MODULE,get_off,[people(S)]}}, {{fsm_floor,1},{call,?MODULE,up,[]}}, {history,{call,?MODULE,up,[]}}]. fsm_floor(N, S) -> [{{fsm_floor,N-1},{call,?MODULE,down,[]}} || N > 1] ++ [{fsm_basement,{call,?MODULE,down,[]}} || N =:= 1] ++ [{history,{call,?MODULE,which_floor,[]}}, {history,{call,?MODULE,get_off,[people(S)]}}, {{fsm_floor,N+1},{call,?MODULE,up,[]}}, {history,{call,?MODULE,up,[]}}]. precondition(fsm_basement, {fsm_floor,1}, S, {call,_,up,[]}) -> S#test_state.num_floors > 0; precondition(fsm_basement, fsm_basement, S, {call,_,up,[]}) -> S#test_state.num_floors =:= 0; precondition({fsm_floor,N}, {fsm_floor,M}, S, {call,_,up,[]}) when M =:= N + 1 -> S#test_state.num_floors > N; precondition({fsm_floor,N}, {fsm_floor,N}, S, {call,_,up,[]}) -> S#test_state.num_floors =:= N; precondition({fsm_floor,_}, {fsm_floor,_}, _S, {call,_,up,[]}) -> false; precondition(_, _, S, {call,_,get_off,[N]}) -> N =< S#test_state.people; precondition(_, _, _, _) -> true. next_state_data(_, _, S, _, {call,_,get_off,[N]}) -> S#test_state{people = S#test_state.people - N}; next_state_data(_, _, S, _, {call,_,get_on,[N]}) -> People = S#test_state.people, case S#test_state.max_people < People + N of true -> S; false -> S#test_state{people = People + N} end; next_state_data(_, _, S, _, _) -> S. postcondition(_, _, S, {call,_,get_on,[N]}, R) -> People = S#test_state.people, case S#test_state.max_people < People + N of true -> R =:= People; false -> R =:= N + People end; postcondition(fsm_basement, fsm_basement, _, {call,_,which_floor,[]}, 0) -> true; postcondition({fsm_floor,N}, {fsm_floor,N}, _, {call,_,which_floor,[]}, N) -> true; postcondition(_, _, _, {call,_,which_floor,[]}, _) -> false; postcondition(_, _, _, _, R) -> R == ok. prop_elevator() -> ?FORALL( {NumFloors,MaxPeople}, {num_floors(), max_people()}, begin Initial = {fsm_basement, #test_state{num_floors = NumFloors, max_people = MaxPeople, people = 0}}, ?FORALL( Cmds, more_commands(5, proper_fsm:commands(?MODULE, Initial)), begin ?MODULE:start_link({NumFloors,MaxPeople}), {H,S,Res} = proper_fsm:run_commands(?MODULE, Cmds), ?MODULE:stop(), ?WHENFAIL( io:format("H: ~w\nS: ~w\nR: ~w\n", [H,S,Res]), aggregate(zip(proper_fsm:state_names(H), command_names(Cmds)), Res == ok)) end) end). people(S) -> ?SUCHTHAT(X, pos_integer(), X =< S#test_state.max_people). max_people() -> noshrink(integer(5, 20)). num_floors() -> noshrink(integer(1, 4)). erlang-proper-1.1+gitfa58f82bdc+dfsg/examples/ets_statem.erl000066400000000000000000000161651255446327200240200ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Eirini Arvaniti %%% @doc Simple statem test for ets tables -module(ets_statem). -behaviour(proper_statem). -export([initial_state/0, initial_state/1, initial_state/2, command/1, precondition/2, postcondition/3, next_state/3]). -export([sample_commands/0]). -include_lib("proper/include/proper.hrl"). -type object() :: tuple(). -type table_type() :: 'set' | 'ordered_set' | 'bag' | 'duplicate_bag'. -record(state, {tids = [] :: [ets:tid()], stored = [] :: [object()], %% list of objects stored in %% ets table type = set :: table_type()}). %% type of ets table -define(INT_KEYS, lists:seq(0, 2)). -define(FLOAT_KEYS, [float(Key) || Key <- ?INT_KEYS]). %%% Generators key() -> frequency([{2, elements(?INT_KEYS)}, {1, elements(?FLOAT_KEYS)}]). value() -> frequency([{5, int()}, {1, elements([a, b, c, d])}]). object() -> {key(), value()}. object(S) -> elements(S#state.stored). key(S) -> ?LET(Object, object(S), element(1, Object)). tid(S) -> elements(S#state.tids). %%% Abstract state machine for ets table initial_state() -> #state{type = set}. initial_state(Type) -> #state{type = Type}. initial_state(Type, parallel) -> #state{tids = [tab], type = Type}. command(#state{tids = [], type = Type}) -> {call,ets,new,[tab, [Type]]}; command(S) -> oneof([{call,ets,insert,[tid(S), object()]}, {call,ets,delete,[tid(S), key()]}] ++ [{call,ets,lookup_element,[tid(S), key(S), range(1, 2)]} || S#state.stored =/= []] ++ [{call,ets,update_counter,[tid(S), key(S), int()]} || S#state.stored =/= [], S#state.type =:= set orelse S#state.type =:= ordered_set]). precondition(S, {call,_,lookup_element,[_, Key, _]}) -> proplists:is_defined(Key, S#state.stored); precondition(S, {call,_,update_counter,[_, Key, _Incr]}) -> proplists:is_defined(Key, S#state.stored) andalso case S#state.type of set -> Obj = proplists:lookup(Key, S#state.stored), is_integer(element(2, Obj)); ordered_set -> Obj = lists:keyfind(Key, 1, S#state.stored), is_integer(element(2, Obj)); _ -> false end; precondition(_S, {call,_,_,_}) -> true. next_state(S, V, {call,_,new,[_Tab, _Opts]}) -> S#state{tids = [V|S#state.tids]}; next_state(S, _V, {call,_,update_counter,[_Tab, Key, Incr]}) -> case S#state.type of set -> Object = proplists:lookup(Key, S#state.stored), Value = element(2, Object), NewObj = setelement(2, Object, Value + Incr), S#state{stored=keyreplace(Key, 1, S#state.stored, NewObj)}; ordered_set -> Object = lists:keyfind(Key, 1, S#state.stored), Value = element(2, Object), NewObj = setelement(2, Object, Value + Incr), S#state{stored=lists:keyreplace(Key, 1, S#state.stored, NewObj)} end; next_state(S, _V, {call,_,insert,[_Tab, Object]}) -> case S#state.type of set -> Key = element(1, Object), case proplists:is_defined(Key, S#state.stored) of false -> S#state{stored = S#state.stored ++ [Object]}; true -> %% correct model S#state{stored=keyreplace(Key, 1, S#state.stored, Object)} %% error model, run {numtests, 3000} to discover the bug %% S#state{stored=lists:keyreplace(Key, 1, S#state.stored, %% Object)} end; ordered_set -> Key = element(1, Object), case lists:keymember(Key, 1, S#state.stored) of false -> S#state{stored = S#state.stored ++ [Object]}; true -> S#state{stored=lists:keyreplace(Key, 1, S#state.stored, Object)} end; bag -> case lists:member(Object, S#state.stored) of false -> S#state{stored = S#state.stored ++ [Object]}; true -> S end; duplicate_bag -> S#state{stored = S#state.stored ++ [Object]} end; next_state(S, _V, {call,_,delete,[_Tab, Key]}) -> case S#state.type of ordered_set -> S#state{stored=lists:keydelete(Key, 1, S#state.stored)}; _ -> S#state{stored=proplists:delete(Key, S#state.stored)} end; next_state(S, _V, {call,_,_,_}) -> S. postcondition(_S, {call,_,new,[_Tab, _Opts]}, _Res) -> true; postcondition(S, {call,_,update_counter,[_Tab, Key, Incr]}, Res) -> Object = case S#state.type of set -> proplists:lookup(Key, S#state.stored); ordered_set -> lists:keyfind(Key, 1, S#state.stored) end, Value = element(2, Object), Res =:= Value + Incr; postcondition(_S, {call,_,delete,[_Tab, _Key]}, Res) -> Res =:= true; postcondition(_S, {call,_,insert,[_Tab, _Object]}, Res) -> Res =:= true; postcondition(S, {call,_,lookup_element,[_Tab, Key, Pos]}, Res) -> case S#state.type of ordered_set -> Res =:= element(Pos, lists:keyfind(Key, 1, S#state.stored)); set -> Res =:= element(Pos, proplists:lookup(Key, S#state.stored)); _ -> Res =:= [element(Pos, Tuple) || Tuple <- proplists:lookup_all(Key, S#state.stored)] end. %%% Sample properties prop_ets() -> ?FORALL(Type, noshrink(table_type()), ?FORALL(Cmds, commands(?MODULE, initial_state(Type)), begin {H,S,Res} = run_commands(?MODULE, Cmds), [ets:delete(Tab) || Tab <- S#state.tids], ?WHENFAIL( io:format("History: ~p\nState: ~p\nRes: ~p\n", [H,S,Res]), collect(Type, Res =:= ok)) end)). prop_parallel_ets() -> ?FORALL(Type, noshrink(table_type()), ?FORALL(Cmds, commands(?MODULE, initial_state(Type, parallel)), begin ets:new(tab, [named_table, public, Type]), {Seq,P,Res} = run_commands(?MODULE, Cmds), ets:delete(tab), ?WHENFAIL( io:format("Sequential: ~p\nParallel: ~p\nRes: ~p\n", [Seq,P,Res]), collect(Type, Res =:= ok)) end)). %%% Demo commands sample_commands() -> proper_gen:sample( ?LET(Type, oneof([set, ordered_set, bag, duplicate_bag]), commands(?MODULE, initial_state(Type)))). %%% Utility Functions keyreplace(Key, Pos, List, NewTuple) -> keyreplace(Key, Pos, List, NewTuple, []). keyreplace(_Key, _Pos, [], _NewTuple, Acc) -> lists:reverse(Acc); keyreplace(Key, Pos, [Tuple|Rest], NewTuple, Acc) -> case element(Pos, Tuple) =:= Key of true -> lists:reverse(Acc) ++ [NewTuple|Rest]; false -> keyreplace(Key, Pos, Rest, NewTuple, [Tuple|Acc]) end. erlang-proper-1.1+gitfa58f82bdc+dfsg/examples/mm.erl000066400000000000000000000563201255446327200222560ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc PropEr usage example: Static mastermind solver -module(mm). -export([mastermind/3, mastermind/4]). -export([prop_all_combinations_are_produced/0, prop_all_selections_are_produced/0, prop_remove_insert_symmetry/0, prop_delete_insert_all_symmetry/0, prop_compatible_works/0, prop_io_filters_are_symmetric/0, prop_next_comb_produces_all_combinations_in_order/0, prop_all_compatibles_are_produced/0, prop_all_produced_solutions_are_valid/1, prop_secret_combination_is_not_discarded/1, prop_invalidated_instances_reject_original_secret/1]). -include_lib("proper/include/proper.hrl"). %% ----------------------------------------------------------------------------- %% Problem statement %% ----------------------------------------------------------------------------- %% Given a list of guesses for the secret combination in a game of Mastermind %% and their corresponding score of black and white pegs, find the first %% combination that is compatible with all the guess-score pairs (the order of %% combinations is derived lexicographically from the order of colors). %% Colors are represented as hex digits, but we allow the use of letters up to %% 'z' - thus, there may be up to 36 colors ('0' - '9' and 'a' - 'z'). The %% combinations are represented as strings of such characters. That is also the %% expected format for the answer. If there is no combination compatible with %% all the guesses, the program should return the string "-1". %% The module should export a function mastermind/3, that takes the following %% arguments: %% 1) the length of the combinations (> 1) %% 2) the number of colors (1..36) %% 3) the list of guess-score pairs, in the format: %% {guess, num_black_pegs, num_white_pegs} %% Expected output: %% mm:mastermind(4, 10, [{"3157",1,2},{"1350",2,1},{"6120",0,2},{"2381",3,0}]). %% "2351" %% mm:mastermind(4, 10, [{"3557",1,2},{"1350",2,1},{"6120",0,2},{"2381",3,0}]). %% "-1" %% mm:mastermind(4, 10, [{"3557",1,2},{"1350",0,1},{"2575",2,1},{"5574",3,0}]). %% "5576" %% mm:mastermind(5, 10, [{"12345",1,0},{"02789",1,2},{"82900",3,0}]). %% "22902" %% mm:mastermind(5, 10, [{"23543",0,2},{"45674",1,2},{"67242",2,0}]). %% "67375" %% mm:mastermind(5, 10, [{"74562",0,0},{"11300",1,0}]). %% "18888" %% mm:mastermind(4, 10, [{"1234",1,0},{"0004",1,0},{"0222",0,0},{"4444",1,0}, %% {"5554",1,0},{"6664",2,0},{"6784",2,2}]). %% "6874" %% mm:mastermind(6, 10, [{"353523",0,5},{"294333",3,2},{"254672",2,1}]). %% "534332" %% mm:mastermind(6, 10, [{"097654",1,3},{"000465",1,1},{"011579",0,2}, %% {"227496",1,3},{"347963",4,1}]). %% "467963" %% mm:mastermind(6, 10, [{"006892",0,2},{"115258",2,2},{"357368",2,1}]). %% "112365" %% mm:mastermind(7, 10, [{"2104767",1,3},{"3541285",3,1},{"7567128",1,4}, %% {"0117285",1,4},{"1521775",2,2},{"3261781",4,0}]). %% "3570781" %% mm:mastermind(8, 10, [{"11244556",0,2},{"66756572",1,4},{"00026667",1,3}, %% {"03663775",1,3},{"22677262",0,3},{"67568688",7,0}]). %% "67568689" %% mm:mastermind(8, 10, [{"21244767",3,0},{"35455685",3,1},{"75687658",2,4}]). %% "05258667" %% mm:mastermind(8, 10, [{"76897034",5,0},{"76284933",3,2}]). %% "06097033" %% mm:mastermind(9, 10, [{"345352352",0,5},{"287639433",3,2},{"276235467",5,2}, %% {"523459878",0,5}]). %% "082235466" %% mm:mastermind(10, 10, [{"3476453523",0,5},{"2876394333",3,2}, %% {"2762354672",5,2},{"5234598781",0,5}]). %% "0122374372" %% ----------------------------------------------------------------------------- %% Utility functions %% ----------------------------------------------------------------------------- %% Function: all_combinations/2 %% Produces all 'Len'-length combinations made up of colors selected from %% 'ColorsList'. all_combinations(Len, ColorsList) -> all_combinations_tr(Len, ColorsList, [[]]). all_combinations_tr(0, _ColorsList, Acc) -> Acc; all_combinations_tr(Left, ColorsList, Acc) -> NewAcc = [[Color|Rest] || Color <- ColorsList, Rest <- Acc], all_combinations_tr(Left - 1, ColorsList, NewAcc). %% Function: all_selections/2 %% Returns all possible selections of 'N' elements from list 'List'. all_selections(0, _List) -> [[]]; all_selections(N, List) when N >= 1 -> Len = length(List), case N > Len of true -> erlang:error(badarg); false -> all_selections(N, List, Len) end. all_selections(1, List, _Len) -> [[X] || X <- List]; all_selections(_Len, List, _Len) -> [List]; all_selections(Take, [Head|Tail], Len) -> [[Head|Rest] || Rest <- all_selections(Take - 1, Tail, Len - 1)] ++ all_selections(Take, Tail, Len - 1). %% Function: all_selection_pos/2 %% Returns all possible selections of 'N' positions from a 'Len'-length list. all_selection_pos(N, Len) -> all_selections(N, lists:seq(1,Len)). %% Function: remove/2 %% Removes from a list, 'List', the elements at positions 'Positions'. Returns %% both the resulting list and a list of the removed elements, in the same %% order they were removed. %% Note that the positions must be given in order. remove(Positions, List) -> remove_tr(Positions, List, 1, [], []). remove_tr([], List, _CurrPos, Kept, Removed) -> {lists:reverse(Kept) ++ List, lists:reverse(Removed)}; remove_tr([CurrPos|PosTail], [X|ListTail], CurrPos, Kept, Removed) -> remove_tr(PosTail, ListTail, CurrPos + 1, Kept, [X|Removed]); remove_tr(Positions, [X|ListTail], CurrPos, Kept, Removed) -> remove_tr(Positions, ListTail, CurrPos + 1, [X|Kept], Removed). %% Function: insert/3 %% Inserts into a list, 'List', the elements of 'ToInsert', in the corresponding %% positions, 'Positions'. %% Note that the positions must be given in order. insert(Positions, ToInsert, List) -> insert_tr(Positions, ToInsert, List, 1, []). insert_tr([], [], List, _CurrPos, Acc) -> lists:reverse(Acc) ++ List; insert_tr([CurrPos|PosTail], [X|ToInsertTail], List, CurrPos, Acc) -> insert_tr(PosTail, ToInsertTail, List, CurrPos + 1, [X|Acc]); insert_tr(Positions, ToInsert, [X|ListTail], CurrPos, Acc) -> insert_tr(Positions, ToInsert, ListTail, CurrPos + 1, [X|Acc]). %% Function: delete/2 %% Removes from a list, 'List', a subsequence of that list, 'ToDelete'. delete(List, ToDelete) -> delete_tr(List, ToDelete, []). delete_tr(List, [], Acc) -> lists:reverse(Acc) ++ List; delete_tr([_Same|ListTail], [_Same|ToDeleteTail], Acc) -> delete_tr(ListTail, ToDeleteTail, Acc); delete_tr([X|Rest], ToDelete, Acc) -> delete_tr(Rest, ToDelete, [X|Acc]). %% Function: insert_all/2 %% Returns all possible insertions of the elements of the first list inside the %% second list. insert_all([], List) -> [List]; insert_all([X|Rest], List) -> [L2 || L1 <- insert_all(Rest, List), L2 <- all_insertions(X, L1)]. %% Function: all_insertions/2 %% Returns all possible insertions of 'X' inside 'List'. all_insertions(X, List) -> all_insertions_tr(X, [], List, []). all_insertions_tr(X, Front, [], Acc) -> [Front ++ [X] | Acc]; all_insertions_tr(X, Front, Back = [BackHead|BackTail], Acc) -> all_insertions_tr(X, Front ++ [BackHead], BackTail, [Front ++ [X] ++ Back | Acc]). %% Function true_permutation/2 %% Returns true iff two permutations of the same list have no element in the %% same position. true_permutation([], []) -> true; true_permutation([_Same|_NewTail], [_Same|_OldTail]) -> false; true_permutation([_NewHead|NewTail], [_OldHead|OldTail]) -> true_permutation(NewTail, OldTail). %% ----------------------------------------------------------------------------- %% Solver code %% ----------------------------------------------------------------------------- %% Function: compatible/4 %% Tests whether combination A produces the given score when compared against %% combination B. This is always the same as when combination B is compared %% against combination A. compatible(A, B, {Blacks,Whites}, Colors) -> correct_blacks(A, B, Blacks) andalso correct_sum(A, B, Blacks + Whites, Colors). correct_blacks([], [], 0) -> true; correct_blacks([], [], _N) -> false; correct_blacks([_Same|_At], [_Same|_Bt], 0) -> false; correct_blacks([_Same|At], [_Same|Bt], N) -> correct_blacks(At, Bt, N - 1); correct_blacks([_Ah|At], [_Bh|Bt], N) -> correct_blacks(At, Bt, N). correct_sum(A, B, N, Colors) -> AFreqs = collect_freqs(A, Colors), BFreqs = collect_freqs(B, Colors), Common = lists:zipwith(fun erlang:min/2, AFreqs, BFreqs), lists:sum(Common) =:= N. collect_freqs(Combination, Colors) -> lists:foldl(fun(C,F) -> inc_freq(C,F) end, lists:duplicate(Colors,0), Combination). inc_freq(Color, Freqs) -> {H,[OldFreq | T]} = lists:split(Color, Freqs), H ++ [OldFreq + 1] ++ T. %% Function: score/2 %% Compares two combinations A and B and calculates the corresponding score. %% A and B must be of the same length and color number. The order of the %% arguments is not important (i.e. it is always score(A,B) = score(B,A)). %% This implementation is sub-optimal on purpose. score(A, B) -> {Blacks,AA,BB} = remove_sames(A, B), Whites = get_whites(AA, BB), {Blacks, Whites}. remove_sames(A, B) -> remove_sames_tr(A, B, 0, [], []). remove_sames_tr([], [], N, AccA, AccB) -> {N, AccA, AccB}; remove_sames_tr([_Same|At], [_Same|Bt], N, AccA, AccB) -> remove_sames_tr(At, Bt, N + 1, AccA, AccB); remove_sames_tr([Ah|At], [Bh|Bt], N, AccA, AccB) -> remove_sames_tr(At, Bt, N, [Ah|AccA], [Bh|AccB]). get_whites(A, B) -> SA = lists:sort(A), SB = lists:sort(B), get_whites_tr(SA, SB, 0). get_whites_tr([], _B, N) -> N; get_whites_tr(_A, [], N) -> N; get_whites_tr([_Same|At], [_Same|Bt], N) -> get_whites_tr(At, Bt, N + 1); get_whites_tr([Ah|At], B = [Bh|_Bt], N) when Ah < Bh -> get_whites_tr(At, B, N); get_whites_tr(A = [Ah|_At], [Bh|Bt], N) when Ah > Bh -> get_whites_tr(A, Bt, N). %% Function: mastermind/3 %% Main entry function, serves as input/output filter for an actual solver %% function, which must return a list of combinations that are compatible with %% every guess-score pair provided. Such a list needn't be sorted - actually, %% it needn't even be complete (i.e. containing all plausible secret %% combinations), but it must contain the minimum combination compatible with %% the input, if such a combination exists (being complete, however, helps with %% testing). mastermind(Len, Colors, RawGuesses) -> mastermind(Len, Colors, RawGuesses, heur). %% Function: mastermind/4 %% The last argument is used to select a particular solver - valid solvers are %% 'simple', 'stream' and 'heur', default is 'heur'. mastermind(Len, Colors, RawGuesses, SolverName) -> Guesses = [{parse(RawComb),{B,W}} || {RawComb,B,W} <- RawGuesses], case valid_input(Len, Colors, Guesses) of true -> ok; false -> erlang:error(badarg) end, Solver = get_solver(SolverName), Result = case Solver(Len, Colors, Guesses) of [] -> error; L -> lists:min(L) end, export(Result). parse(RawComb) -> [digit_to_integer(X) || X <- RawComb]. export(error) -> "-1"; export(Comb) -> [integer_to_digit(X) || X <- Comb]. digit_to_integer(X) when X >= $0, X =< $9 -> X - $0; digit_to_integer(X) when X >= $a, X =< $z -> X - $a + 10; digit_to_integer(X) when X >= $A, X =< $Z -> X - $A + 10. integer_to_digit(X) when X >= 0, X =< 9 -> X + $0; integer_to_digit(X) when X >= 10, X =< 35 -> X - 10 + $a. valid_input(Len, Colors, Guesses) -> Len > 0 andalso Colors > 0 andalso lists:all(fun(G) -> valid_guess(Len, Colors, G) end, Guesses). valid_guess(Len, Colors, {Comb,{Blacks,Whites}}) -> Blacks >= 0 andalso Whites >= 0 andalso (Blacks + Whites < Len orelse Blacks + Whites =:= Len andalso Whites =/= 1) andalso length(Comb) =:= Len andalso lists:all(fun(X) -> X >= 0 andalso X =< Colors end, Comb). get_solver(SolverName) -> case SolverName of simple -> fun simple_solver/3; stream -> fun stream_solver/3; heur -> fun heur_solver/3 end. %% Function: simple_solver/3 %% Simple way to produce all combinations which are compatible with a given %% list of guess-score pairs: %% * create a list of all possible 'Len'-length combinations of 'Colors' colors %% * filter the list with all provided guess-score pairs (for each pair, we %% remove from the list those combinations that are incompatible with it) %% Note that the resulting list is always complete and sorted. simple_solver(Len, Colors, Guesses) -> Combs = all_combinations(Len, lists:seq(0,Colors-1)), filter_guesses(Colors, Guesses, Combs). filter_guesses(_Colors, _Guesses, []) -> []; filter_guesses(_Colors, [], Combs) -> Combs; filter_guesses(Colors, [{Guess,Score} | Rest], Combs) -> IsCompatible = fun(C) -> compatible(Guess, C, Score, Colors) end, NewCombs = lists:filter(IsCompatible, Combs), filter_guesses(Colors, Rest, NewCombs). %% Function: stream_solver/3 %% Low-memory solver: lazily produces and checks all possible combinations in %% order until it finds one that is compatible with all guess-score pairs. %% Note that the resulting list is almost certainly incomplete, since we only %% return the first instance we find. stream_solver(Len, Colors, Guesses) -> stream_solver_tr(Colors, Guesses, lists:duplicate(Len,0)). stream_solver_tr(_Colors, _Guesses, done) -> []; stream_solver_tr(Colors, Guesses, Comb) -> case lists:all(fun({C,S}) -> compatible(C,Comb,S,Colors) end, Guesses) of true -> [Comb]; false -> stream_solver_tr(Colors, Guesses, next_comb(Colors,Comb)) end. next_comb(Colors, Comb) -> next_comb_tr(Colors - 1, lists:reverse(Comb), []). next_comb_tr(_MaxColor, [], _Acc) -> done; next_comb_tr(MaxColor, [MaxColor | Rest], Acc) -> next_comb_tr(MaxColor, Rest, [0 | Acc]); next_comb_tr(_MaxColor, [X | Rest], Acc) -> lists:reverse(Rest) ++ [X+1] ++ Acc. %% Function: heur_solver/3 %% More sophisticated solver (avoids the construction of all possible %% combinations): %% * if the guess list is empty, return [[0,0,...,0]], else: %% * sort the guesses by applying a selectivity heuristic (guesses whose %% score will result in more combinations being rejected are prefered) %% * take the first guess-score pair and produce all the combinations it's %% compatible with %% * filter the list with the rest of the pairs %% Note that the resulting list is always complete (except for the special case %% when Guesses =:= []) but is not necessarily sorted. heur_solver(Len, _Colors, []) -> [lists:duplicate(Len, 0)]; heur_solver(Len, Colors, Guesses) -> [First|Rest] = lists:sort(fun(A,B) -> more_selective(A,B,Colors) end, Guesses), Combs = all_compatibles(Len, Colors, First), filter_guesses(Colors, Rest, Combs). %% Function: more_selective/2 %% Selectivity heuristic used to sort guess-score pairs. We suspect that %% guess-score pair A is more selective than B if: %% 1) it has a greater total score %% 2) it has more black pegs %% 3) it has fewer distinct colors %% The above criteria are processed in that exact order. more_selective({CombA,{BlacksA,WhitesA}}, {CombB,{BlacksB,WhitesB}}, Colors) -> case sign((BlacksA + WhitesA) - (BlacksB + WhitesB)) of +1 -> true; -1 -> false; 0 -> case sign(BlacksA - BlacksB) of +1 -> true; -1 -> false; 0 -> distinct_colors(CombA, Colors) =< distinct_colors(CombB, Colors) end end. sign(0) -> 0; sign(X) when X > 0 -> +1; sign(X) when X < 0 -> -1. distinct_colors(Comb, Colors) -> lists:foldl(fun(F,S) -> sign(F) + S end, 0, collect_freqs(Comb, Colors)). %% Function: all_compatibles/3 %% Runs the 'all_whites' function for all possible selections of 'Blacks' %% positions in the given combination. all_compatibles(Len, Colors, {Comb,{Blacks,Whites}}) -> NonFixedLen = Len - Blacks, [C || BlackSelPos <- all_selection_pos(Blacks, Len), C <- all_whites(NonFixedLen, Whites, Colors, Comb, BlackSelPos)]. all_whites(NonFixedLen, Whites, Colors, Comb, BlackSelPos) -> RejectedLen = NonFixedLen - Whites, {NonFixed,Fixed} = remove(BlackSelPos, Comb), UnsortedWhiteSels = [{Sel,lists:sort(Sel)} || Sel <- all_selections(Whites, NonFixed)], WhiteSels = lists:ukeysort(2, UnsortedWhiteSels), [insert(BlackSelPos, Fixed, C) || {WhiteSel,_} <- WhiteSels, C <- all_moves(NonFixed, WhiteSel, RejectedLen, Colors)]. all_moves(NonFixed, WhiteSel, RejectedLen, Colors) -> Rejected = delete(NonFixed, WhiteSel), RemainingColors = lists:seq(0,Colors-1) -- Rejected, AllCombs = all_combinations(RejectedLen, RemainingColors), UnsortedAllMoves = [L || C <- AllCombs, L <- insert_all(WhiteSel, C), true_permutation(L, NonFixed)], lists:usort(UnsortedAllMoves). %% ----------------------------------------------------------------------------- %% Properties to check %% ----------------------------------------------------------------------------- prop_all_combinations_are_produced() -> ?FORALL({Len, ColorsList}, {range(0,5), short_nd_list(integer())}, begin AllCombs = all_combinations(Len, ColorsList), NumAllCombs = pow(length(ColorsList), Len), lofl_check(AllCombs, NumAllCombs, Len, ColorsList) andalso no_duplicates(AllCombs) end). short_nd_list(ElemType) -> ?LET(L, resize(7, list(ElemType)), lists:usort(L)). lofl_check(Lofl, NumLists, ListLen, ListElems) -> lofl_check(Lofl, NumLists, ListLen, ListElems, 0). lofl_check([], NumLists, _ListLen, _ListElems, Acc) -> Acc =:= NumLists; lofl_check([List|Rest], NumLists, ListLen, ListElems, Acc) -> list_check(List, ListLen, ListElems) andalso lofl_check(Rest, NumLists, ListLen, ListElems, Acc + 1). list_check([], 0, _Elems) -> true; list_check([], _Left, _Elems) -> false; list_check([X|Rest], Left, Elems) -> lists:member(X, Elems) andalso list_check(Rest, Left - 1, Elems). pow(X, Y) -> pow_tr(X, Y, 1). pow_tr(_X, 0, Acc) -> Acc; pow_tr(X, Y, Acc) -> pow_tr(X, Y - 1, X * Acc). no_duplicates(L) -> length(L) =:= length(lists:usort(L)). prop_all_selections_are_produced() -> ?FORALL(List, short_ne_list(integer()), begin Len = length(List), ?FORALL(N, range(0,Len), begin AllSels = all_selections(N, List), NumAllSels = num_sels(N, Len), lofl_check(AllSels, NumAllSels, N, List) end) end). short_list(ElemType) -> resize(10, list(ElemType)). short_ne_list(ElemType) -> non_empty(short_list(ElemType)). num_sels(N, Len) -> fact(Len) div fact(N) div fact(Len - N). fact(0) -> 1; fact(N) when N >= 1 -> N * fact(N-1). prop_remove_insert_symmetry() -> ?FORALL(List, short_ne_list(integer()), ?FORALL(Positions, pos_selection(List), begin {Kept,Removed} = remove(Positions,List), insert(Positions,Removed,Kept) =:= List end)). pos_selection(List) -> Len = length(List), ?LET(N, range(0,Len), oneof(all_selection_pos(N, Len))). prop_delete_insert_all_symmetry() -> ?FORALL(List, short_list(integer()), ?FORALL(Subseq, subsequence(List), lists:member(List, insert_all(Subseq,delete(List,Subseq))))). subsequence(List) -> ?LET(L, [{X,boolean()} || X <- List], [Y || {Y,true} <- L]). prop_compatible_works() -> ?FORALL({Colors,A,B}, two_combinations(), compatible(A, B, score(A,B), Colors)). combination(Len, Colors) -> vector(Len, range(0,Colors-1)). two_combinations() -> ?LET({Len, Colors}, {range(0,30), range(1,36)}, {Colors, combination(Len,Colors), combination(Len,Colors)}). prop_io_filters_are_symmetric() -> ?FORALL(L, list(digit()), collect(num_digits(length(L)), export(parse(L)) =:= L)). digit() -> union([range($0,$9), range($a,$z)]). num_digits(X) when X >= 0, X =< 9 -> 1; num_digits(X) when X >= 10 -> 1 + num_digits(X div 10). prop_next_comb_produces_all_combinations_in_order() -> ?FORALL({Len, Colors}, {range(0,5), range(1,10)}, list_is_produced(Colors, lists:duplicate(Len,0), all_combinations(Len,lists:seq(0,Colors-1)))). list_is_produced(_Colors, done, []) -> true; list_is_produced(Colors, Same, [Same | Rest]) -> list_is_produced(Colors, next_comb(Colors,Same), Rest); list_is_produced(_Colors, _Comb, _List) -> false. prop_all_compatibles_are_produced() -> ?FORALL({Len, Colors, Guess}, one_guess_instance(), simple_solver(Len, Colors, [Guess]) =:= lists:sort(all_compatibles(Len, Colors, Guess))). one_guess_instance() -> ?LET({Len, Colors}, {range(2,5), range(2,10)}, {Len, Colors, scored_guess(Len,Colors)}). scored_guess(Len, Colors) -> ?LET(Score, valid_score(Len), {combination(Len,Colors), Score}). valid_score(Len) -> ?LET(Blacks, range(0,Len), ?LET(Whites, ?SUCHTHAT(W, range(0,Len-Blacks), W =/= 1 orelse Blacks + W =/= Len), {Blacks,Whites})). prop_all_produced_solutions_are_valid(SolverName) -> Solver = get_solver(SolverName), ?FORALL({Len, Colors, Guesses}, instance(), begin Solutions = Solver(Len, Colors, Guesses), collect(Solutions =:= [], lists:all(fun(Solution) -> lists:all(fun({C,Score}) -> compatible(C,Solution, Score,Colors) end, Guesses) end, Solutions)) end). instance() -> ?LET({Len, Colors}, {range(2,5), range(2,10)}, {Len, Colors, short_list(scored_guess(Len,Colors))}). %% Note that the next property is not necessarily true for solvers that don't %% return complete lists. prop_secret_combination_is_not_discarded(SolverName) -> Solver = get_solver(SolverName), ?FORALL({Len,Colors,Secret,Guesses}, full_non_trivial_instance(), lists:member(Secret, Solver(Len,Colors,Guesses))). full_non_trivial_instance() -> ?LET({Len, Colors}, {range(2,5), range(2,10)}, ?LET({Secret, Guesses}, {combination(Len,Colors), short_ne_list(combination(Len,Colors))}, {Len,Colors,Secret,[{G,score(G,Secret)} || G <- Guesses]})). prop_invalidated_instances_reject_original_secret(SolverName) -> Solver = get_solver(SolverName), ?FORALL({Len,Colors,Secret,Guesses}, invalid_instance(), not lists:member(Secret, Solver(Len,Colors,Guesses))). invalid_instance() -> ?LET({Len,Colors,Secret,Guesses}, full_non_trivial_instance(), ?LET(Pos, range(1,length(Guesses)), begin {Comb,OldScore} = lists:nth(Pos,Guesses), ?LET(NewScore, ?SUCHTHAT(S, valid_score(Len), S =/= OldScore), {Len,Colors,Secret, list_update(Pos,{Comb,NewScore},Guesses)}) end)). list_update(Index, NewElem, List) -> {H,[_OldElem | T]} = lists:split(Index - 1, List), H ++ [NewElem] ++ T. erlang-proper-1.1+gitfa58f82bdc+dfsg/examples/pdict_statem.erl000066400000000000000000000062631255446327200243260ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Kresten Krab Thorup, edited by Eirini Arvaniti %%% @doc Simple statem test for the process dictionary -module(pdict_statem). -behaviour(proper_statem). -export([test/0, test/1]). -export([initial_state/0, command/1, precondition/2, postcondition/3, next_state/3]). -include_lib("proper/include/proper.hrl"). -define(KEYS, [a,b,c,d]). %% A simple statem test for the process dictionary; tests the %% operations erlang:put/2, erlang:get/1, erlang:erase/1. test() -> test(100). test(N) -> proper:quickcheck(?MODULE:prop_pdict(), N). prop_pdict() -> ?FORALL(Cmds, commands(?MODULE), begin {H,S,Res} = run_commands(?MODULE, Cmds), clean_up(), ?WHENFAIL( io:format("History: ~w\nState: ~w\nRes: ~w\n", [H, S, Res]), aggregate(command_names(Cmds), Res =:= ok)) end). clean_up() -> lists:foreach(fun(Key) -> erlang:erase(Key) end, ?KEYS). key() -> elements(?KEYS). initial_state() -> []. command([]) -> {call,erlang,put,[key(), integer()]}; command(Props) -> ?LET({Key,Value}, weighted_union([{2, elements(Props)}, {1, {key(),integer()}}]), oneof([{call,erlang,put,[Key,Value]}, {call,erlang,get,[Key]}, {call,erlang,erase,[Key]} ])). precondition(_, {call,erlang,put,[_,_]}) -> true; precondition(Props, {call,erlang,get,[Key]}) -> proplists:is_defined(Key, Props); precondition(Props, {call,erlang,erase,[Key]}) -> proplists:is_defined(Key, Props); precondition(_, _) -> false. postcondition(Props, {call,erlang,put,[Key,_]}, undefined) -> not proplists:is_defined(Key, Props); postcondition(Props, {call,erlang,put,[Key,_]}, Old) -> {Key,Old} =:= proplists:lookup(Key, Props); postcondition(Props, {call,erlang,get,[Key]}, Val) -> {Key,Val} =:= proplists:lookup(Key, Props); postcondition(Props, {call,erlang,erase,[Key]}, Val) -> {Key,Val} =:= proplists:lookup(Key, Props); postcondition(_, _, _) -> false. next_state(Props, _Var, {call,erlang,put,[Key,Value]}) -> %% correct model [{Key,Value}|proplists:delete(Key, Props)]; %% wrong model %% Props ++ [{Key,Value}]; next_state(Props, _Var, {call,erlang,erase,[Key]}) -> proplists:delete(Key, Props); next_state(Props, _Var, {call,erlang,get,[_]}) -> Props. erlang-proper-1.1+gitfa58f82bdc+dfsg/examples/stack.erl000066400000000000000000000046731255446327200227560ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc Auto-ADT usage example: list-based implementation of a stack, with %%% element counting -module(stack). -export([is_empty/1, size/1, new/0, push/2, pop/1, safe_pop/1]). -export_type([stack/1]). -opaque stack(T) :: {non_neg_integer(),[T]}. %% NOTE: You don't need to include the proper header if no properties are %% declared in the module. -include_lib("proper/include/proper.hrl"). %% NOTE: Every instance of the ADT in a spec must have variables as parameters. %% When this would mean singleton variables, use variables starting with %% an underscore. -spec is_empty(stack(_T)) -> boolean(). is_empty({0, []}) -> true; is_empty({_N, [_Top|_Rest]}) -> false. -spec size(stack(_T)) -> non_neg_integer(). size({N, _Elems}) -> N. -spec new() -> stack(_T). new() -> {0, []}. -spec push(T, stack(T)) -> stack(T). push(X, {N,Elems}) -> {N+1, [X|Elems]}. -spec pop(stack(T)) -> {T,stack(T)}. pop({0, []}) -> throw(stack_empty); pop({N, [Top|Rest]}) when N > 0 -> {Top, {N-1,Rest}}. -spec safe_pop(stack(T)) -> {'ok',T,stack(T)} | 'error'. safe_pop({0, []}) -> error; safe_pop({N, [Top|Rest]}) when N > 0 -> {ok, Top, {N-1,Rest}}. %%------------------------------------------------------------------------------ %% Properties %%------------------------------------------------------------------------------ prop_push_pop() -> ?FORALL({X,S}, {integer(),stack(integer())}, begin {Y,_} = pop(push(X,S)), X =:= Y end). erlang-proper-1.1+gitfa58f82bdc+dfsg/include/000077500000000000000000000000001255446327200207405ustar00rootroot00000000000000erlang-proper-1.1+gitfa58f82bdc+dfsg/include/proper.hrl000066400000000000000000000107451255446327200227650ustar00rootroot00000000000000%%% Copyright 2010-2013 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc User header file: This file should be included in each file containing %%% user type declarations and/or properties to be tested. -compile(debug_info). -include_lib("proper/include/proper_common.hrl"). -ifndef(PROPER_NO_IMPORTS). %%------------------------------------------------------------------------------ %% Test generation functions %%------------------------------------------------------------------------------ -import(proper, [numtests/2, fails/1, on_output/2, conjunction/1]). -import(proper, [collect/2, collect/3, aggregate/2, aggregate/3, classify/3, measure/3, with_title/1, equals/2]). %%------------------------------------------------------------------------------ %% Basic types %%------------------------------------------------------------------------------ -import(proper_types, [integer/2, float/2, atom/0, binary/0, binary/1, bitstring/0, bitstring/1, list/1, vector/2, union/1, weighted_union/1, tuple/1, loose_tuple/1, exactly/1, fixed_list/1, function/2, any/0]). %%------------------------------------------------------------------------------ %% Type aliases %%------------------------------------------------------------------------------ -import(proper_types, [integer/0, non_neg_integer/0, pos_integer/0, neg_integer/0, range/2, float/0, non_neg_float/0, number/0, boolean/0, byte/0, char/0, list/0, tuple/0, string/0, wunion/1, term/0, timeout/0, arity/0]). -import(proper_types, [int/0, nat/0, largeint/0, real/0, bool/0, choose/2, elements/1, oneof/1, frequency/1, return/1, default/2, orderedlist/1, function0/1, function1/1, function2/1, function3/1, function4/1, weighted_default/2, parameter/1, parameter/2, with_parameter/3, with_parameters/2]). %%------------------------------------------------------------------------------ %% Unicode %%------------------------------------------------------------------------------ -import(proper_unicode, [utf8/0, utf8/1, utf8/2]). %%------------------------------------------------------------------------------ %% Type manipulation functions %%------------------------------------------------------------------------------ -import(proper_types, [resize/2, non_empty/1, noshrink/1]). %%------------------------------------------------------------------------------ %% Symbolic generation functions %%------------------------------------------------------------------------------ -import(proper_symb, [eval/1, eval/2, defined/1, well_defined/1, pretty_print/1, pretty_print/2]). %%------------------------------------------------------------------------------ %% Statem functions %%------------------------------------------------------------------------------ -import(proper_statem, [commands/1, commands/2, parallel_commands/1, parallel_commands/2, more_commands/2]). -import(proper_statem, [run_commands/2, run_commands/3, state_after/2, command_names/1, zip/2, run_parallel_commands/2, run_parallel_commands/3]). -ifndef(PROPER_NO_IMPORT_PARSE). -import(proper_unused_imports_remover, []). -compile({parse_transform, proper_unused_imports_remover}). -endif. -endif. %%------------------------------------------------------------------------------ %% Enable the PropEr parse transformer %%------------------------------------------------------------------------------ -ifndef(PROPER_NO_TRANS). -ifdef(PROPER_REMOVE_PROPS). -compile({parse_transform, proper_prop_remover}). -else. -compile({parse_transform, proper_transformer}). -endif. -endif. erlang-proper-1.1+gitfa58f82bdc+dfsg/include/proper_common.hrl000066400000000000000000000050271255446327200243320ustar00rootroot00000000000000%%% Copyright 2010-2013 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc Common parts of user and internal header files %%------------------------------------------------------------------------------ %% Test generation macros %%------------------------------------------------------------------------------ -define(FORALL(X,RawType,Prop), proper:forall(RawType,fun(X) -> Prop end)). -define(IMPLIES(Pre,Prop), proper:implies(Pre,?DELAY(Prop))). -define(WHENFAIL(Action,Prop), proper:whenfail(?DELAY(Action),?DELAY(Prop))). -define(TRAPEXIT(Prop), proper:trapexit(?DELAY(Prop))). -define(TIMEOUT(Limit,Prop), proper:timeout(Limit,?DELAY(Prop))). %% TODO: -define(ALWAYS(Tests,Prop), proper:always(Tests,?DELAY(Prop))). %% TODO: -define(SOMETIMES(Tests,Prop), proper:sometimes(Tests,?DELAY(Prop))). %%------------------------------------------------------------------------------ %% Generator macros %%------------------------------------------------------------------------------ -define(FORCE(X), (X)()). -define(DELAY(X), fun() -> X end). -define(LAZY(X), proper_types:lazy(?DELAY(X))). -define(SIZED(SizeArg,Gen), proper_types:sized(fun(SizeArg) -> Gen end)). -define(LET(X,RawType,Gen), proper_types:bind(RawType,fun(X) -> Gen end,false)). -define(SHRINK(Gen,AltGens), proper_types:shrinkwith(?DELAY(Gen),?DELAY(AltGens))). -define(LETSHRINK(Xs,RawType,Gen), proper_types:bind(RawType,fun(Xs) -> Gen end,true)). -define(SUCHTHAT(X,RawType,Condition), proper_types:add_constraint(RawType,fun(X) -> Condition end,true)). -define(SUCHTHATMAYBE(X,RawType,Condition), proper_types:add_constraint(RawType,fun(X) -> Condition end,false)). erlang-proper-1.1+gitfa58f82bdc+dfsg/include/proper_internal.hrl000066400000000000000000000064571255446327200246660ustar00rootroot00000000000000%%% Copyright 2010-2013 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc Internal header file: This header is included in all PropEr source %%% files. -include("compile_flags.hrl"). -include("proper_common.hrl"). %%------------------------------------------------------------------------------ %% Activate strip_types parse transform %%------------------------------------------------------------------------------ -ifdef(NO_TYPES). -compile({parse_transform, strip_types}). -endif. %%------------------------------------------------------------------------------ %% Random generator selection %%------------------------------------------------------------------------------ -ifdef(USE_SFMT). -define(RANDOM_MOD, sfmt). -define(SEED_NAME, sfmt_seed). -else. -define(RANDOM_MOD, random). -define(SEED_NAME, random_seed). -endif. %%------------------------------------------------------------------------------ %% Macros %%------------------------------------------------------------------------------ -define(PROPERTY_PREFIX, "prop_"). %%------------------------------------------------------------------------------ %% Constants %%------------------------------------------------------------------------------ -define(SEED_RANGE, 4294967296). -define(MAX_ARITY, 20). -define(MAX_TRIES_FACTOR, 5). -define(ANY_SIMPLE_PROB, 3). -define(ANY_BINARY_PROB, 1). -define(ANY_EXPAND_PROB, 8). -define(SMALL_RANGE_THRESHOLD, 16#FFFF). %%------------------------------------------------------------------------------ %% Common type aliases %%------------------------------------------------------------------------------ %% TODO: Perhaps these should be moved inside modules. -type mod_name() :: atom(). -type fun_name() :: atom(). -type size() :: non_neg_integer(). -type length() :: non_neg_integer(). -type position() :: pos_integer(). -type frequency() :: pos_integer(). -type seed() :: {non_neg_integer(), non_neg_integer(), non_neg_integer()}. -type abs_form() :: erl_parse:abstract_form(). -type abs_expr() :: erl_parse:abstract_expr(). -type abs_clause() :: erl_parse:abstract_clause(). %% TODO: Replace these with the appropriate types from stdlib. -type abs_type() :: term(). -type abs_rec_field() :: term(). -type loose_tuple(T) :: {} | {T} | {T,T} | {T,T,T} | {T,T,T,T} | {T,T,T,T,T} | {T,T,T,T,T,T} | {T,T,T,T,T,T,T} | {T,T,T,T,T,T,T,T} | {T,T,T,T,T,T,T,T,T} | {T,T,T,T,T,T,T,T,T,T} | tuple(). erlang-proper-1.1+gitfa58f82bdc+dfsg/include/proper_param_adts.hrl000066400000000000000000000033771255446327200251630ustar00rootroot00000000000000%%% Copyright 2010-2013 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc Complementary user header file: This file can be included in any %%% module, to allow for the use of parametric versions of some common %%% opaque datatypes from STDLIB. PropEr will recognize these types as %%% opaques and treat them accordingly. This is meant as a temporary %%% measure until Dialyzer implements support for parametric opaques. %%------------------------------------------------------------------------------ %% Type declarations %%------------------------------------------------------------------------------ -type array(_T) :: array(). -type dict(_K,_V) :: dict(). -type gb_set(_T) :: gb_set(). -type gb_tree(_K,_V) :: gb_tree(). -type orddict(K,V) :: [{K,V}]. -type ordset(T) :: [T]. -type queue(_T) :: queue(). -type set(_T) :: set(). erlang-proper-1.1+gitfa58f82bdc+dfsg/make_doc000077500000000000000000000357071255446327200210210ustar00rootroot00000000000000#!/usr/bin/env escript %%% Copyright 2010-2015 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% Author: Manolis Papadakis %%% Description: Documentation processing script: This script will call EDoc on %%% the application's source files, after inlining all types %%% denoted as aliases, and removing from the exported types lists %%% all types denoted as private. %%% Known Bugs: * This scipt is very hacky, it will probably break easily. %%% * Record declarations with no type information are discarded. %%% * Any text inside the same multi-line comment as an @alias or %%% @private_type tag will be discarded. %%% * Comments inside included files are not processed. %%% * Comments will generally be displaced, especially comments %%% inside type declarations or functions. %%% * File and line information is partially lost. %% Needed for some defines (e.g. NO_MODULES_IN_OPAQUES) and some types -include("include/proper_internal.hrl"). %%------------------------------------------------------------------------------ %% Constants %%------------------------------------------------------------------------------ -define(SRC_FILES_RE, "^.*\\.erl$"). -define(APP_NAME, proper). -define(BASE_DIR, "."). -define(SRC_DIR, (?BASE_DIR ++ "/src")). -define(INCLUDE_DIR, (?BASE_DIR ++ "/include")). -define(TEMP_SRC_DIR, (?BASE_DIR ++ "/temp_src")). -define(EDOC_OPTS, [{report_missing_types,true}, {report_type_mismatch,true}, {pretty_printer,erl_pp}, {preprocess,true}, {source_path, [?TEMP_SRC_DIR]}]). -ifdef(USE_ERL_SCAN_LINE). -define(LINE_MOD, erl_scan). -else. -define(LINE_MOD, erl_anno). -endif. %%------------------------------------------------------------------------------ %% Types %%------------------------------------------------------------------------------ -type line() :: ?LINE_MOD:line(). -type var_name() :: atom(). -type rec_name() :: atom(). -type var_form() :: {'var', line(), var_name()}. -type type_name() :: atom(). -type type_ref() :: {'type', type_name(), arity()}. -type type_def() :: {abs_type(), [var_form()]}. -type charlist() :: [char() | charlist()]. -type charlist_with_lines() :: {[line(),...], charlist()}. %%------------------------------------------------------------------------------ %% File handling %%------------------------------------------------------------------------------ -spec main([string()]) -> 'ok'. main(_CmdlineArgs) -> Delete = fun(Filename,ok) -> file:delete(Filename) end, case file:make_dir(?TEMP_SRC_DIR) of ok -> ok; {error,eexist} -> ok = filelib:fold_files(?TEMP_SRC_DIR, ?SRC_FILES_RE, false, Delete, ok), ok = file:del_dir(?TEMP_SRC_DIR), ok end, Copy = fun(SrcFilename, ok) -> Basename = filename:basename(SrcFilename), DstFilename = ?TEMP_SRC_DIR ++ "/" ++ Basename, {ok,_Bytes} = file:copy(SrcFilename, DstFilename), ok end, ok = filelib:fold_files(?SRC_DIR, ?SRC_FILES_RE, false, Copy, ok), Process = fun(Filename,ok) -> process(Filename) end, ok = filelib:fold_files(?TEMP_SRC_DIR, ?SRC_FILES_RE, false, Process, ok), ok = edoc:application(?APP_NAME, ?BASE_DIR, ?EDOC_OPTS), ok = filelib:fold_files(?TEMP_SRC_DIR, ?SRC_FILES_RE, false, Delete, ok), ok = file:del_dir(?TEMP_SRC_DIR), ok. -spec process(file:filename()) -> 'ok'. process(Filename) -> {ok,Forms} = epp:parse_file(Filename, [?INCLUDE_DIR], []), Comments = erl_comment_scan:file(Filename), {NewForms,NewComments} = process_forms(Forms, Comments), Code = pretty_print(NewForms, NewComments), {ok,IODev} = file:open(Filename, [write]), ok = io:put_chars(IODev, Code), ok = file:close(IODev), ok. -spec pretty_print([abs_form()], [erl_comment_scan:comment()]) -> charlist(). pretty_print(Forms, Comments) -> FormsWithLines = add_lines_to_forms(Forms), CommentsWithLines = [{[Line],[["%",Str,"\n"] || Str <- Text] ++ "%@end\n"} || {Line,_Col,_Ind,Text} <- Comments], CodeWithLines = lists:keymerge(1, FormsWithLines, CommentsWithLines), [S || {_L,S} <- CodeWithLines]. -spec add_lines_to_forms([abs_form()]) -> [charlist_with_lines()]. add_lines_to_forms(Forms) -> add_lines_to_forms(Forms, [], {"",0}, []). -spec add_lines_to_forms([abs_form()], [charlist_with_lines()], {file:filename(),line()}, [{file:filename(),line()}]) -> [charlist_with_lines()]. add_lines_to_forms([], Acc, _FilePos, _Stack) -> lists:reverse(Acc); add_lines_to_forms([Form|Rest], Acc, {FileName,_FileLine}, Stack) -> case Form of {attribute,Line,file,{NewFileName,_NewFileLine} = NewFilePos} -> case NewFileName of "" -> %% TODO: What is the meaning of an empty file name? %% TODO: Why is it causing problems? add_lines_to_forms(Rest, Acc, {FileName,Line}, Stack); FileName -> %% TODO: Can this happen? add_lines_to_forms(Rest, Acc, NewFilePos, Stack); _ -> NewStack = case Stack of [{NewFileName,_}|Bottom] -> Bottom; _ -> [{FileName,Line}|Stack] end, add_lines_to_forms(Rest, Acc, NewFilePos, NewStack) end; {attribute,Line,record,_Fields} -> add_lines_to_forms(Rest, Acc, {FileName,Line}, Stack); _ -> PrintedForm = print_form(Form), Line = get_line_from_form(Form), Lines = tl(lists:reverse([Line | [L || {_F,L} <- Stack]])), add_lines_to_forms(Rest, [{Lines,PrintedForm}|Acc], {FileName,Line}, Stack) end. -spec print_form(abs_form()) -> charlist(). print_form({attribute,_,type,{{record,Name},Fields,[]}}) -> print_record_type(Name,Fields); print_form(OtherForm) -> erl_pp:form(OtherForm). -spec print_record_type(rec_name(), [abs_rec_field()]) -> charlist(). print_record_type(Name, Fields) -> ["-record(", atom_to_list(Name), ",{", case Fields of [] -> []; [Head|Rest] -> [print_record_field(Head), [[",",print_record_field(F)] || F <- Rest]] end, "}).\n"]. -spec print_record_field(abs_rec_field()) -> charlist(). print_record_field({record_field,_,{atom,_,Name}}) -> atom_to_list(Name); print_record_field({record_field,_,{atom,_,Name},Initialization}) -> [atom_to_list(Name), $=, erl_pp:expr(Initialization,-1,none)]; print_record_field({typed_record_field,InnerField,FieldType}) -> MyTypeDecl = {attribute,0,type,{mytype,FieldType,[]}}, PrintedMyType = lists:flatten(erl_pp:form(MyTypeDecl)), PrintedFieldType = lists:reverse(remove_from_head("\n.", lists:reverse(remove_from_head("-typemytype()::", PrintedMyType)))), [print_record_field(InnerField), "::", PrintedFieldType]. -spec remove_from_head(string(), string()) -> string(). remove_from_head([], Str) -> Str; remove_from_head(ToRemove, [32|StrRest]) -> remove_from_head(ToRemove, StrRest); remove_from_head([C|ToRemoveRest], [C|StrRest]) -> remove_from_head(ToRemoveRest, StrRest). -spec get_line_from_form(abs_form()) -> line(). get_line_from_form({attribute,Line,_Kind,_Value}) -> Line; get_line_from_form({function,Line,_Name,_Arity,_Clauses}) -> Line; get_line_from_form({eof,Line}) -> Line. %%------------------------------------------------------------------------------ %% Abstract code processing %%------------------------------------------------------------------------------ -spec process_forms([abs_form(),...], [erl_comment_scan:comment()]) -> {[abs_form(),...],[erl_comment_scan:comment()]}. process_forms(Forms, Comments) -> [FileAttr|Rest] = Forms, {attribute,_Line,file,{TopFileName,_FileLine}} = FileAttr, process_forms([FileAttr], Rest, [], Comments, [], TopFileName). -spec process_forms([abs_form(),...], [abs_form()], [erl_comment_scan:comment()], [erl_comment_scan:comment()], [{type_name(),arity()}], file:filename()) -> {[abs_form(),...],[erl_comment_scan:comment()]}. process_forms(RevForms, Forms, RevComments, [], PrivTypes, _TopFileName) -> NewForms = lists:reverse(RevForms) ++ Forms, NewComments = lists:reverse(RevComments), {remove_private_types(NewForms,PrivTypes), NewComments}; process_forms(RevForms, Forms, RevComments, [Comment|Rest], PrivTypes, TopFileName) -> {CommLine,_Column,_Indentation,Text} = Comment, IsPrivate = contains_tag(Text, "@private_type"), IsAlias = contains_tag(Text, "@alias"), case IsPrivate orelse IsAlias of true -> {MaybeType,NewRevForms,NewForms} = find_next_type(CommLine, RevForms, Forms, TopFileName), case MaybeType of error -> process_forms(NewRevForms, NewForms, RevComments, Rest, PrivTypes, TopFileName); {TypeRef,TypeDef} -> %% TODO: Also throw away alias type forms? {FinalRevForms,FinalForms} = case IsAlias of true -> {[replace(F,TypeRef,TypeDef) || F <- NewRevForms], [replace(F,TypeRef,TypeDef) || F <- NewForms]}; false -> {NewRevForms,NewForms} end, NewPrivTypes = case IsPrivate of true -> {type,Name,Arity} = TypeRef, [{Name,Arity} | PrivTypes]; false -> PrivTypes end, process_forms(FinalRevForms, FinalForms, RevComments, Rest, NewPrivTypes, TopFileName) end; false -> process_forms(RevForms, Forms, [Comment|RevComments], Rest, PrivTypes, TopFileName) end. -spec find_next_type(line(), [abs_form()], [abs_form()], file:filename()) -> {'error' | {type_ref(),type_def()}, [abs_form()], [abs_form()]}. find_next_type(_CommLine, RevForms, [], _TopFileName) -> {error, RevForms, []}; find_next_type(CommLine, RevForms, [Form|Rest] = Forms, TopFileName) -> case Form of {attribute,_AttrLine,file,_FilePos} -> continue_after_header(CommLine, RevForms, Forms, TopFileName); _ -> case get_line_from_form(Form) =< CommLine of true -> find_next_type(CommLine, [Form|RevForms], Rest, TopFileName); false -> case Form of {attribute,_AttrLine,Kind,Value} when Kind =:= type orelse Kind =:= opaque -> {Name,TypeForm,VarForms} = Value, case is_atom(Name) of true -> Arity = length(VarForms), TypeRef = {type,Name,Arity}, TypeDef = {TypeForm,VarForms}, {{TypeRef,TypeDef}, RevForms, Forms}; false -> {error, RevForms, Forms} end; _ -> {error, RevForms, Forms} end end end. -spec continue_after_header(line(), [abs_form()], [abs_form(),...], file:filename()) -> {'error' | {type_ref(),type_def()}, [abs_form(),...], [abs_form()]}. continue_after_header(CommLine, RevForms, [Form|Rest], TopFileName) -> case Form of {attribute,_AttrLine,file,{TopFileName,_TopFileLine}} -> find_next_type(CommLine, [Form|RevForms], Rest, TopFileName); _Other -> continue_after_header(CommLine, [Form|RevForms], Rest, TopFileName) end. -spec contains_tag([string()], string()) -> boolean(). contains_tag(Text, Tag) -> StrContainsTag = fun(Str) -> string:str(Str,Tag) =/= 0 end, lists:any(StrContainsTag, Text). -spec replace(abs_form() | abs_type() | abs_rec_field() | abs_clause(), var_form() | type_ref(), abs_type() | type_def()) -> abs_form() | abs_type() | abs_rec_field() | abs_clause(). %% TODO: Should we update the source lines when inlining? replace({attribute,Line,type,{{record,Name},Fields,[]}}, Alias, Value) -> NewFields = [replace(Field,Alias,Value) || Field <- Fields], {attribute, Line, type, {{record,Name},NewFields,[]}}; replace({attribute,Line,Kind,{Name,TypeForm,VarForms}}, Alias, Value) when Kind =:= type orelse Kind =:= opaque -> NewTypeForm = replace(TypeForm, Alias, Value), {attribute, Line, Kind, {Name,NewTypeForm,VarForms}}; replace({attribute,Line,spec,{FunRef,Clauses}}, Alias, Value) -> NewClauses = [replace(Clause,Alias,Value) || Clause <- Clauses], {attribute, Line, spec, {FunRef,NewClauses}}; replace({typed_record_field,RecField,FieldType}, Alias, Value) -> {typed_record_field, RecField, replace(FieldType,Alias,Value)}; replace({type,Line,bounded_fun,[MainClause,Constraints]}, Alias, Value) -> ReplaceInConstraint = fun({type,L,constraint,[ConstrKind,Args]}) -> NewArgs = [replace(Arg,Alias,Value) || Arg <- Args], {type, L, constraint, [ConstrKind,NewArgs]} end, NewConstraints = [ReplaceInConstraint(C) || C <- Constraints], {type, Line, bounded_fun, [MainClause,NewConstraints]}; replace({var,_Line1,SameName}, {var,_Line2,SameName}, Value) -> Value; replace({Kind,Line,Args}, Alias, Value) when Kind =:= ann_type orelse Kind =:= paren_type orelse Kind =:= remote_type -> NewArgs = [replace(Arg,Alias,Value) || Arg <- Args], {Kind, Line, NewArgs}; replace(Type = {type,_Line,tuple,any}, _Alias, _Value) -> Type; replace({type,_Line,SameName,Args}, Alias = {type,SameName,Arity}, Value = {TypeForm,VarForms}) when length(Args) =:= Arity -> FixedArgs = [replace(Arg,Alias,Value) || Arg <- Args], ReplaceVar = fun({Var,Val},T) -> replace(T, Var, Val) end, lists:foldl(ReplaceVar, TypeForm, lists:zip(VarForms,FixedArgs)); replace({type,Line,Name,Args}, Alias, Value) -> NewArgs = [replace(Arg,Alias,Value) || Arg <- Args], {type, Line, Name, NewArgs}; replace(Other, _Alias, _Value) -> Other. -spec remove_private_types([abs_form()], [{type_name(),arity()}]) -> [abs_form()]. remove_private_types(Forms, PrivTypesList) -> PrivTypesSet = sets:from_list(PrivTypesList), [remove_from_exported(Form,PrivTypesSet) || Form <- Forms]. -ifdef(NO_MODULES_IN_OPAQUES). -type priv_types() :: set(). -else. -type priv_types() :: sets:set({type_name(),arity()}). -endif. -spec remove_from_exported(abs_form(), priv_types()) -> abs_form(). remove_from_exported({attribute,Line,export_type,TypesList}, PrivTypesSet) -> IsNotPrivate = fun(T) -> not sets:is_element(T,PrivTypesSet) end, {attribute, Line, export_type, lists:filter(IsNotPrivate,TypesList)}; remove_from_exported(OtherAttr, _PrivTypesSet) -> OtherAttr. %% -spec update_line(abs_type(), line()) -> abs_type(). %% update_line(Type, Line) -> %% %% TODO: Is this function necessary? %% %% TODO: Will this work with type declarations? %% UpdateNodeLine = fun(Node) -> set_pos(Node, Line) end, %% %% TODO: Is the 'revert' operation necessary? %% erl_syntax:revert(erl_syntax_lib:map(UpdateNodeLine, Type)). %% kate: syntax erlang; erlang-proper-1.1+gitfa58f82bdc+dfsg/rebar.cmd000066400000000000000000000001201255446327200210660ustar00rootroot00000000000000@echo off setlocal set rebarscript=%~f0 escript.exe "%rebarscript:.cmd=%" %* erlang-proper-1.1+gitfa58f82bdc+dfsg/rebar.config000066400000000000000000000033631255446327200216040ustar00rootroot00000000000000%%% Copyright 2010-2013 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% Author: Manolis Papadakis %%% Description: Options for rebar %% WARNING: Our version of rebar does NOT automatically report warnings, %% nor does it add erl_opts to eunit_compile_opts. {erl_first_files, ["src/strip_types.erl", "src/vararg.erl"]}. {eunit_first_files, ["src/strip_types.erl", "src/vararg.erl", "src/proper_transformer.erl", "src/proper_prop_remover.erl", "src/proper_typeserver.erl"]}. {erl_opts, [debug_info, report_warnings, {warn_format,1}, warn_export_vars, warn_obsolete_guard, warn_unused_import, warn_missing_spec, warn_untyped_record]}. {pre_hooks, [{"(linux|darwin|solaris|gnu)", compile, "make include/compile_flags.hrl"}, {"(freebsd|netbsd|openbsd)", compile, "gmake include/compile_flags.hrl"}, {"win32", compile, "escript.exe write_compile_flags include/compile_flags.hrl"}]}. {post_hooks, [{clean, "./clean_doc.sh"}]}. erlang-proper-1.1+gitfa58f82bdc+dfsg/src/000077500000000000000000000000001255446327200201045ustar00rootroot00000000000000erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper.app.src000066400000000000000000000023451255446327200227070ustar00rootroot00000000000000%%% Copyright 2010-2013 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc This is the source for the proper.app file. {application, proper, [{description, "A QuickCheck-inspired property-based testing tool for Erlang"}, {vsn, "1.1"}, {registered, []}, {applications, [compiler,kernel,stdlib]}, {env, []}]}. erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper.erl000066400000000000000000002272771255446327200221400ustar00rootroot00000000000000%%% Copyright 2010-2015 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2015 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc This is the main PropEr module. %%% %%% == How to write properties == %%% The simplest properties that PropEr can test consist of a single boolean %%% expression (or a statement block that returns a boolean), which is expected %%% to evaluate to `true'. Thus, the test `true' always succeeds, while the test %%% `false' always fails (the failure of a property may also be signified by %%% throwing an exception, error or exit. More complex (and useful) properties %%% can be written by wrapping such a boolean expression with one or more of the %%% following wrappers: %%% %%%
%%%
`?FORALL(, , )'
%%%
The `' field can either be a single variable, a tuple of variables %%% or a list of variables. The `' field must then be a single type, %%% a tuple of types of the same length as the tuple of variables or a list %%% of types of the same length as the list of variables, respectively. %%% Tuples and lists can be combined in any way, as long as `' and %%% `' are compatible. Both PropEr-provided types, as listed in the %%% {@link proper_types} module, and types declared in Erlang's built-in %%% typesystem (we will refer to such types in as native types) may %%% be used in the `' field. The use of native types in `?FORALL's is %%% subject to some limitations, as described in the documentation for the %%% {@link proper_typeserver} module. All the variables inside `' can %%% (and should) be present as free variables inside the wrapped property %%% `'. When a `?FORALL' wrapper is encountered, a random instance of %%% `' is produced and each variable in `' is replaced inside %%% `' by its corresponding instance.
%%%
`?IMPLIES(, )'
%%%
This wrapper only makes sense when in the scope of at least one %%% `?FORALL'. The `' field must be a boolean expression or a %%% statement block that returns a boolean. If the precondition evaluates to %%% `false' for the variable instances produced in the enclosing `?FORALL' %%% wrappers, the test case is rejected (it doesn't count as a failing test %%% case), and PropEr starts over with a new random test case. Also, in %%% verbose mode, an `x' is printed on screen.
%%%
`?WHENFAIL(, )'
%%%
The `' field should contain an expression or statement block %%% that produces some side-effect (e.g. prints something to the screen). %%% In case this test fails, `' will be executed. Note that the output %%% of such actions is not affected by the verbosity setting of the main %%% application.
%%%
`?TRAPEXIT()'
%%%
If the code inside `' spawns and links to a process that dies %%% abnormally, PropEr will catch the exit signal and treat it as a test %%% failure, instead of crashing. `?TRAPEXIT' cannot contain any more %%% wrappers.
%%%
`?TIMEOUT(, )'
%%%
Signifies that `' should be considered failing if it takes more %%% than `' milliseconds to return. The purpose of this wrapper is %%% to test code that may hang if something goes wrong. `?TIMEOUT' cannot %%% contain any more wrappers.
%%%
`conjunction()'
%%%
See the documentation for {@link conjunction/1}.
%%%
`equals(, )'
%%%
See the documentation for {@link equals/2}.
%%%
%%% %%% There are also multiple wrappers that can be used to collect statistics on %%% the distribution of test data: %%% %%%
    %%%
  • {@link collect/2}
  • %%%
  • {@link collect/3}
  • %%%
  • {@link aggregate/2}
  • %%%
  • {@link aggregate/3}
  • %%%
  • {@link classify/3}
  • %%%
  • {@link measure/3}
  • %%%
%%% %%% %%% A property may also be wrapped with one or more of the following outer-level %%% wrappers, which control the behaviour of the testing subsystem. If an %%% outer-level wrapper appears more than once in a property, the innermost %%% instance takes precedence. %%% %%%
    %%%
  • {@link numtests/2}
  • %%%
  • {@link fails/2}
  • %%%
  • {@link on_output/2}
  • %%%
%%% %%% For some actual usage examples, see the code in the examples directory, or %%% check out PropEr's site. The testing modules in the tests directory may also %%% be of interest. %%% %%% == Program behaviour == %%% When running in verbose mode (this is the default), each sucessful test %%% prints a '.' on screen. If a test fails, a '!' is printed, along with the %%% failing test case (the instances of the types in every `?FORALL') and the %%% cause of the failure, if it was not simply the falsification of the %%% property. %%% Then, unless the test was expected to fail, PropEr attempts to produce a %%% minimal test case that fails the property in the same way. This process is %%% called shrinking. During shrinking, a '.' is printed for each %%% successful simplification of the failing test case. When PropEr reaches its %%% shrinking limit or realizes that the instance cannot be shrunk further while %%% still failing the test, it prints the minimal failing test case and failure %%% reason and exits. %%% %%% The return value of PropEr can be one of the following: %%% %%%
    %%%
  • `true': The property held for all valid produced inputs.
  • %%%
  • `false': The property failed for some input.
  • %%%
  • `{error, }': An error occured; see the {@section Errors} %%% section for more information.
  • %%%
%%% %%% To test all properties exported from a module (a property is a 0-arity %%% function whose name begins with `prop_'), you can use {@link module/1} or %%% {@link module/2}. This returns a list of all failing properties, represented %%% by MFAs. Testing progress is also printed on screen (unless quiet mode is %%% active). The provided options are passed on to each property, except for %%% `long_result', which controls the return value format of the `module' %%% function itself. %%% %%% == Counterexamples == %%% A counterexample for a property is represented as a list of terms; each such %%% term corresponds to the type in a `?FORALL'. The instances are provided in %%% the same order as the `?FORALL' wrappers in the property, i.e. the instance %%% at the head of the list corresponds to the outermost `?FORALL' etc. %%% Instances generated inside a failing sub-property of a conjunction are %%% marked with the sub-property's tag. %%% %%% The last (simplest) counterexample produced by PropEr during a (failing) run %%% can be retrieved after testing has finished, by running %%% {@link counterexample/0}. When testing a whole module, run %%% {@link counterexamples/0} to get a counterexample for each failing property, %%% as a list of `{mfa(), '{@type counterexample()}`}' tuples. To enable this %%% functionality, some information has to remain in the process dictionary %%% even after PropEr has returned. If, for some reason, you want to completely %%% clean up the process dictionary of PropEr-produced entries, run %%% {@link clean_garbage/0}. %%% %%% Counterexamples can also be retrieved by running PropEr in long-result mode, %%% where counterexamples are returned as part of the return value. %%% Specifically, when testing a single property under long-result mode %%% (activated by supplying the option `long_result', or by calling %%% {@link counterexample/1} or {@link counterexample/2} instead of %%% {@link quickcheck/1} and {@link quickcheck/2} respectively), PropEr will %%% return a counterexample in case of failure (instead of simply returning %%% `false'). When testing a whole module under long-result mode (activated by %%% supplying the option `long_result' to {@link module/2}), PropEr will return %%% a list of `{mfa(), '{@type counterexample()}`}' tuples, one for each failing %%% property. %%% %%% You can re-check a specific counterexample against the property that it %%% previously falsified by running {@link check/2} or {@link check/3}. This %%% will return one of the following (both in short- and long-result mode): %%% %%%
    %%%
  • `true': The property now holds for this test case.
  • %%%
  • `false': The test case still fails (although not necessarily for the %%% same reason as before).
  • %%%
  • `{error, }': An error occured - see the {@section Errors} %%% section for more information.
  • %%%
%%% %%% Proper will not attempt to shrink the input in case it still fails the %%% property. Unless silent mode is active, PropEr will also print a message on %%% screen, describing the result of the re-checking. Note that PropEr can do %%% very little to verify that the counterexample actually corresponds to the %%% property that it is tested against. %%% %%% == Options == %%% Options can be provided as an extra argument to most testing functions (such %%% as {@link quickcheck/1}). A single option can be written stand-alone, or %%% multiple options can be provided in a list. When two settings conflict, the %%% one that comes first in the list takes precedence. Settings given inside %%% external wrappers to a property (see the {@section How to write properties} %%% section) override any conflicting settings provided as options. %%% %%% The available options are: %%% %%%
%%%
`quiet'
%%%
Enables quiet mode - no output is printed on screen while PropEr is %%% running.
%%%
`verbose'
%%%
Enables verbose mode - this is the default mode of operation.
%%%
`{to_file, }'
%%%
Redirects all of PropEr's output to `', which should be an %%% IO device associated with a file opened for writing.
%%%
`{on_output, }'
%%%
PropEr will use the supplied function for all output printing. This %%% function should accept two arguments in the style of `io:format/2'.
%%% CAUTION: The above output control options are incompatible with each %%% other.
%%%
`long_result'
%%%
Enables long-result mode (see the {@section Counterexamples} section %%% for details).
%%%
`{numtests, }' or simply `'
%%%
This is equivalent to the {@link numtests/1} property wrapper. Any %%% {@link numtests/1} wrappers in the actual property will overwrite this %%% setting.
%%%
`{start_size, }'
%%%
Specifies the initial value of the `size' parameter (default is 1), see %%% the documentation of the {@link proper_types} module for details.
%%%
`{max_size, }'
%%%
Specifies the maximum value of the `size' parameter (default is 42), see %%% the documentation of the {@link proper_types} module for details.
%%%
`{max_shrinks, }'
%%%
Specifies the maximum number of times a failing test case should be %%% shrunk before returning. Note that the shrinking may stop before so many %%% shrinks are achieved if the shrinking subsystem deduces that it cannot %%% shrink the failing test case further. Default is 500.
%%%
`noshrink'
%%%
Instructs PropEr to not attempt to shrink any failing test cases.
%%%
`{constraint_tries, }'
%%%
Specifies the maximum number of tries before the generator subsystem %%% gives up on producing an instance that satisfies a `?SUCHTHAT' %%% constraint. Default is 50.
%%%
`fails'
%%%
This is equivalent to the {@link fails/1} property wrapper.
%%%
`{spec_timeout, infinity | }'
%%%
When testing a spec, PropEr will consider an input to be failing if the %%% function under test takes more than the specified amount of milliseconds %%% to return for that input.
%%%
`any_to_integer'
%%%
All generated instances of the type {@link proper_types:any/0} will be %%% integers. This is provided as a means to speed up the testing of specs, %%% where `any()' is a commonly used type (see the {@section Spec testing} %%% section for details).
%%%
`{skip_mfas, []}'
%%%
When checking a module's specs, PropEr will not test the %%% specified MFAs. Default is [].
%%%
`{false_positive_mfas, fun((mfa(),[Arg::term()],{fail, Result::term()} | {error | exit | throw, Reason::term()}) -> boolean()) | undefined}'
%%%
When checking a module's spec(s), PropEr will treat a %%% counterexample as a false positive if the user supplied function %%% returns true. Otherwise, PropEr will treat the counterexample as %%% it normally does. The inputs to the user supplied function are %%% the MFA, the arguments passed to the MFA, and the result returned %%% from the MFA or an exception with it's reason. If needed, the %%% user supplied function can call erlang:get_stacktrace/0. Default %%% is undefined.
%%%
%%% %%% == Spec testing == %%% You can test the accuracy of an exported function's spec by running %%% {@link check_spec/1} or {@link check_spec/2}. %%% Under this mode of operation, PropEr will call the provided function with %%% increasingly complex valid inputs (according to its spec) and test that no %%% unexpected value is returned. If an input is found that violates the spec, %%% it will be saved as a counterexample and PropEr will attempt to shrink it. %%% %%% You can test all exported functions of a module against their spec by %%% running {@link check_specs/1} or {@link check_specs/2}. %%% %%% The use of `check_spec' is subject to the following usage rules: %%% %%%
    %%%
  • Currently, PropEr can't test functions whose range contains a type %%% that exhibits a certain kind of self-reference: it is (directly or %%% indirectly) self-recursive and at least one recursion path contains only %%% unions and type references. E.g. these types are acceptable: %%% ``` -type a(T) :: T | {'bar',a(T)}. %%% -type b() :: 42 | [c()]. %%% -type c() :: {'baz',b()}.''' %%% while these are not: %%% ``` -type a() :: 'foo' | b(). %%% -type b() :: c() | [integer()]. %%% -type c() :: 'bar' | a(). %%% -type d(T) :: T | d({'baz',T}).'''
  • %%%
  • Throwing any exception or raising an `error:badarg' is considered %%% normal behaviour. Currently, users cannot fine-tune this setting.
  • %%%
  • Only the first clause of the function's spec is considered.
  • %%%
  • The only spec constraints we accept are is_subtype' constraints whose %%% first argument is a simple, non-'_' variable. It is not checked whether or %%% not these variables actually appear in the spec. The second argument of an %%% `is_subtype' constraint cannot contain any non-'_' variables. Multiple %%% constraints for the same variable are not supported.
  • %%%
%%% %%% == Errors == %%% The following errors may be encountered during testing. The term provided %%% for each error is the error type returned by proper:quickcheck in case such %%% an error occurs. Normaly, a message is also printed on screen describing %%% the error. %%% %%%
%%%
`arity_limit'
%%%
The random instance generation subsystem has failed to produce %%% a function of the desired arity. Please recompile PropEr with a suitable %%% value for `?MAX_ARITY' (defined in `proper_internal.hrl'). This error %%% should only be encountered during normal operation.
%%%
`cant_generate'
%%%
The random instance generation subsystem has failed to %%% produce an instance that satisfies some `?SUCHTHAT' constraint. You %%% should either increase the `constraint_tries' limit, loosen the failing %%% constraint, or make it non-strict. This error should only be encountered %%% during normal operation.
%%%
`cant_satisfy'
%%%
All the tests were rejected because no produced test case %%% would pass all `?IMPLIES' checks. You should loosen the failing `?IMPLIES' %%% constraint(s). This error should only be encountered during normal %%% operation.
%%%
`non_boolean_result'
%%%
The property code returned a non-boolean result. Please %%% fix your property.
%%%
`rejected'
%%%
Only encountered during re-checking, the counterexample does not %%% match the property, since the counterexample doesn't pass an `?IMPLIES' %%% check.
%%%
`too_many_instances'
%%%
Only encountered during re-checking, the counterexample %%% does not match the property, since the counterexample contains more %%% instances than there are `?FORALL's in the property.
%%%
`type_mismatch'
%%%
The variables' and types' structures inside a `?FORALL' don't %%% match. Please check your properties.
%%%
`{typeserver, }'
%%%
The typeserver encountered an error. The `' field contains %%% specific information regarding the error.
%%%
`{unexpected, }'
%%%
A test returned an unexpected result during normal operation. If you %%% ever get this error, it means that you have found a bug in PropEr %%% - please send an error report to the maintainers and remember to include %%% both the failing test case and the output of the program, if possible. %%%
%%%
`{unrecognized_option,
%%%
`
%%%
-module(proper). -export([quickcheck/1, quickcheck/2, counterexample/1, counterexample/2, check/2, check/3, module/1, module/2, check_spec/1, check_spec/2, check_specs/1, check_specs/2]). -export([numtests/2, fails/1, on_output/2, conjunction/1]). -export([collect/2, collect/3, aggregate/2, aggregate/3, classify/3, measure/3, with_title/1, equals/2]). -export([counterexample/0, counterexamples/0]). -export([clean_garbage/0, global_state_erase/0]). -export([get_size/1, global_state_init_size/1, global_state_init_size_seed/2,report_error/2]). -export([pure_check/1, pure_check/2]). -export([forall/2, implies/2, whenfail/2, trapexit/1, timeout/2]). -export_type([test/0, outer_test/0, counterexample/0, exception/0, false_positive_mfas/0]). -include("proper_internal.hrl"). %%----------------------------------------------------------------------------- %% Macros %%----------------------------------------------------------------------------- -define(MISMATCH_MSG, "Error: The input doesn't correspond to this property: "). %%----------------------------------------------------------------------------- %% Test types %%----------------------------------------------------------------------------- -type imm_testcase() :: [imm_input()]. -type imm_input() :: proper_gen:imm_instance() | {'$conjunction',sub_imm_testcases()}. -type sub_imm_testcases() :: [{tag(),imm_testcase()}]. -type imm_counterexample() :: [imm_clean_input()]. -type imm_clean_input() :: proper_gen:instance() | {'$conjunction',sub_imm_counterexamples()}. -type sub_imm_counterexamples() :: [{tag(),imm_counterexample()}]. -type counterexample() :: [clean_input()]. %% @alias -type clean_input() :: proper_gen:instance() | sub_counterexamples(). %% @alias -type sub_counterexamples() :: [{tag(),counterexample()}]. -type sample() :: [term()]. -type freq_sample() :: [{term(),frequency()}]. -type side_effects_fun() :: fun(() -> 'ok'). -type fail_actions() :: [side_effects_fun()]. -type output_fun() :: fun((string(),[term()]) -> 'ok'). %% A fun to be used by PropEr for output printing. Such a fun should follow the %% conventions of `io:format/2'. -type tag() :: atom(). -type title() :: atom() | string(). -type stats_printer() :: fun((sample()) -> 'ok') | fun((sample(),output_fun()) -> 'ok'). %% A stats-printing function that can be passed to some of the statistics %% collection functions, to be used instead of the predefined stats-printer. %% Such a function will be called at the end of testing (in case no test fails) %% with a sorted list of collected terms. A commonly used stats-printer is %% `with_title/1'. -type numeric_stats() :: {number(), float(), number()}. -type time_period() :: non_neg_integer(). %% TODO: This should be opaque. %% @type outer_test(). A testable property that has optionally been wrapped with %% one or more
external wrappers. -type outer_test() :: test() | numtests_clause() | fails_clause() | on_output_clause(). %% TODO: This should be opaque. %% TODO: Should the tags be of the form '$...'? %% @type test(). A testable property that has not been wrapped with an %% external wrapper. -type test() :: boolean() | forall_clause() | conjunction_clause() | implies_clause() | sample_clause() | whenfail_clause() | trapexit_clause() | timeout_clause(). %%| always_clause() %%| sometimes_clause() -type delayed_test() :: fun(() -> test()). -type dependent_test() :: fun((proper_gen:instance()) -> test()). -type lazy_test() :: delayed_test() | dependent_test(). -type raw_test_kind() :: 'test' | 'spec'. -type raw_test() :: {'test',test()} | {'spec',mfa()}. -type stripped_test() :: boolean() | {proper_types:type(), dependent_test()} | [{tag(),test()}]. -type numtests_clause() :: {'numtests', pos_integer(), outer_test()}. -type fails_clause() :: {'fails', outer_test()}. -type on_output_clause() :: {'on_output', output_fun(), outer_test()}. -type forall_clause() :: {'forall', proper_types:raw_type(), dependent_test()}. -type conjunction_clause() :: {'conjunction', [{tag(),test()}]}. -type implies_clause() :: {'implies', boolean(), delayed_test()}. -type sample_clause() :: {'sample', sample(), stats_printer(), test()}. -type whenfail_clause() :: {'whenfail', side_effects_fun(), delayed_test()}. -type trapexit_clause() :: {'trapexit', fun(() -> boolean())}. -type timeout_clause() :: {'timeout', time_period(), fun(() -> boolean())}. %%-type always_clause() :: {'always', pos_integer(), delayed_test()}. %%-type sometimes_clause() :: {'sometimes', pos_integer(), delayed_test()}. -type false_positive_mfas() :: fun((mfa(),Args::[term()],{fail,Result::term()} | {error | exit | throw,Reason::term()}) -> boolean()) | 'undefined'. %%----------------------------------------------------------------------------- %% Options and Context types %%----------------------------------------------------------------------------- %% TODO: Rename this to 'options()'? -type user_opt() :: 'quiet' | 'verbose' | {'to_file',io:device()} | {'on_output',output_fun()} | 'long_result' | {'numtests',pos_integer()} | pos_integer() | {'start_size',size()} | {'max_size',size()} | {'max_shrinks',non_neg_integer()} | 'noshrink' | {'constraint_tries',pos_integer()} | 'fails' | 'any_to_integer' | {'spec_timeout',timeout()} | {'skip_mfas',[mfa()]} | {'false_positive_mfas',false_positive_mfas()}. -type user_opts() :: [user_opt()] | user_opt(). -record(opts, {output_fun = fun io:format/2 :: output_fun(), long_result = false :: boolean(), numtests = 100 :: pos_integer(), start_size = 1 :: size(), seed = os:timestamp() :: seed(), max_size = 42 :: size(), max_shrinks = 500 :: non_neg_integer(), noshrink = false :: boolean(), constraint_tries = 50 :: pos_integer(), expect_fail = false :: boolean(), any_type :: {'type', proper_types:type()} | 'undefined', spec_timeout = infinity :: timeout(), skip_mfas = [] :: [mfa()], false_positive_mfas :: false_positive_mfas()}). -type opts() :: #opts{}. -record(ctx, {mode = new :: 'new' | 'try_shrunk' | 'try_cexm', bound = [] :: imm_testcase() | counterexample(), actions = [] :: fail_actions(), samples = [] :: [sample()], printers = [] :: [stats_printer()]}). -type ctx() :: #ctx{}. %%----------------------------------------------------------------------------- %% Result types %%----------------------------------------------------------------------------- -record(pass, {reason :: pass_reason() | 'undefined', samples :: [sample()], printers :: [stats_printer()], performed :: pos_integer() | 'undefined'}). -record(fail, {reason :: fail_reason() | 'undefined', bound :: imm_testcase() | counterexample(), actions :: fail_actions(), performed :: pos_integer() | 'undefined'}). %% @alias -type error() :: {'error', error_reason()}. -type pass_reason() :: 'true_prop' | 'didnt_crash'. -type fail_reason() :: 'false_prop' | 'time_out' | {'trapped',exc_reason()} | exception() | {'sub_props',[{tag(),fail_reason()},...]}. %% @private_type -type exception() :: {'exception',exc_kind(),exc_reason(),stacktrace()}. -type exc_kind() :: 'throw' | 'error' | 'exit'. -type exc_reason() :: term(). -type stacktrace() :: [call_record()]. -ifdef(OLD_STACKTRACE_FORMAT). -type call_record() :: {mod_name(),fun_name(),arity() | list()}. -else. -type call_record() :: {mod_name(),fun_name(),arity() | list(),location()}. -type location() :: [{atom(),term()}]. -endif. -type error_reason() :: 'arity_limit' | 'cant_generate' | 'cant_satisfy' | 'non_boolean_result' | 'rejected' | 'too_many_instances' | 'type_mismatch' | 'wrong_type' | {'typeserver',term()} | {'unexpected',any()} | {'unrecognized_option',term()}. -type run_result() :: #pass{performed :: 'undefined'} | #fail{performed :: 'undefined'} | error(). -type imm_result() :: #pass{reason :: 'undefined'} | #fail{} | error(). -type long_result() :: 'true' | counterexample() | error(). -type short_result() :: boolean() | error(). -type result() :: long_result() | short_result(). -type long_module_result() :: [{mfa(),counterexample()}] | error(). -type short_module_result() :: [mfa()] | error(). -type module_result() :: long_module_result() | short_module_result(). -type shrinking_result() :: {non_neg_integer(),imm_testcase()}. %%----------------------------------------------------------------------------- %% State handling functions %%----------------------------------------------------------------------------- -spec grow_size(opts()) -> 'ok'. grow_size(#opts{max_size = MaxSize} = Opts) -> Size = get('$size'), case Size < MaxSize of true -> case get('$left') of 0 -> {ToRun, NextSize} = tests_at_next_size(Size, Opts), put('$size', NextSize), put('$left', ToRun - 1), ok; Left -> put('$left', Left - 1), ok end; false -> ok end. -spec tests_at_next_size(size(), opts()) -> {pos_integer(), size()}. tests_at_next_size(_Size, #opts{numtests = 1, start_size = StartSize}) -> {1, StartSize}; tests_at_next_size(Size, #opts{numtests = NumTests, start_size = StartSize, max_size = MaxSize}) when Size < MaxSize, StartSize =< MaxSize, NumTests > 1 -> SizesToTest = MaxSize - StartSize + 1, case NumTests >= SizesToTest of true -> TotalOverflow = NumTests rem SizesToTest, NextSize = erlang:max(StartSize, Size + 1), Overflow = case NextSize - StartSize < TotalOverflow of true -> 1; false -> 0 end, {NumTests div SizesToTest + Overflow, NextSize}; false -> EverySoManySizes = (SizesToTest - 1) div (NumTests - 1), NextSize = case Size < StartSize of true -> StartSize; false -> PrevMultiple = Size - (Size - StartSize) rem EverySoManySizes, PrevMultiple + EverySoManySizes end, {1, NextSize} end. %% @private -spec get_size(proper_types:type()) -> size() | 'undefined'. get_size(Type) -> case get('$size') of undefined -> undefined; Size -> case proper_types:find_prop(size_transform, Type) of {ok,Transform} -> Transform(Size); error -> Size end end. %% @private -spec global_state_init_size(size()) -> 'ok'. global_state_init_size(Size) -> global_state_init(#opts{start_size = Size}). %% @private -spec global_state_init_size_seed(size(), seed()) -> 'ok'. global_state_init_size_seed(Size, Seed) -> global_state_init(#opts{start_size = Size, seed = Seed}). -spec global_state_init(opts()) -> 'ok'. global_state_init(#opts{start_size = StartSize, constraint_tries = CTries, any_type = AnyType, seed = Seed} = Opts) -> clean_garbage(), put('$size', StartSize - 1), put('$left', 0), grow_size(Opts), put('$constraint_tries', CTries), put('$any_type', AnyType), {_, _, _} = Seed, % just an assertion proper_arith:rand_restart(Seed), proper_typeserver:restart(), ok. -spec global_state_reset(opts()) -> 'ok'. global_state_reset(#opts{start_size = StartSize} = Opts) -> clean_garbage(), put('$size', StartSize - 1), put('$left', 0), grow_size(Opts). %% @private -spec global_state_erase() -> 'ok'. global_state_erase() -> proper_typeserver:stop(), proper_arith:rand_stop(), erase('$any_type'), erase('$constraint_tries'), erase('$left'), erase('$size'), erase('$parameters'), ok. %% @private -spec spawn_link_migrate(fun(() -> 'ok')) -> pid(). spawn_link_migrate(ActualFun) -> PDictStuff = get(), Fun = fun() -> lists:foreach(fun({K,V}) -> put(K,V) end, PDictStuff), proper_arith:rand_reseed(), ok = ActualFun() end, spawn_link(Fun). -spec save_counterexample(counterexample()) -> 'ok'. save_counterexample(CExm) -> put('$counterexample', CExm), ok. %% @doc Retrieves the last (simplest) counterexample produced by PropEr during %% the most recent testing run. -spec counterexample() -> counterexample() | 'undefined'. counterexample() -> get('$counterexample'). -spec save_counterexamples([{mfa(),counterexample()}]) -> 'ok'. save_counterexamples(CExms) -> put('$counterexamples', CExms), ok. %% @doc Returns a counterexample for each failing property of the most recent %% module testing run. -spec counterexamples() -> [{mfa(),counterexample()}] | 'undefined'. counterexamples() -> get('$counterexamples'). %% @doc Cleans up the process dictionary of all PropEr-produced entries. -spec clean_garbage() -> 'ok'. clean_garbage() -> erase('$counterexample'), erase('$counterexamples'), ok. %%----------------------------------------------------------------------------- %% Public interface functions %%----------------------------------------------------------------------------- %% @doc Runs PropEr on the property `OuterTest'. -spec quickcheck(outer_test()) -> result(). quickcheck(OuterTest) -> quickcheck(OuterTest, []). %% @doc Same as {@link quickcheck/1}, but also accepts a list of options. -spec quickcheck(outer_test(), user_opts()) -> result(). quickcheck(OuterTest, UserOpts) -> try parse_opts(UserOpts) of ImmOpts -> {Test,Opts} = peel_test(OuterTest, ImmOpts), test({test,Test}, Opts) catch throw:{unrecognized_option,_UserOpt} = Reason -> report_error(Reason, fun io:format/2), {error, Reason} end. %% @equiv quickcheck(OuterTest, [long_result]) -spec counterexample(outer_test()) -> long_result(). counterexample(OuterTest) -> counterexample(OuterTest, []). %% @doc Same as {@link counterexample/1}, but also accepts a list of options. -spec counterexample(outer_test(), user_opts()) -> long_result(). counterexample(OuterTest, UserOpts) -> quickcheck(OuterTest, add_user_opt(long_result, UserOpts)). %% @private %% @doc Runs PropEr in pure mode. Under this mode, PropEr will perform no I/O %% and will not access the caller's process dictionary in any way. Please note %% that PropEr will not actually run as a pure function under this mode. -spec pure_check(outer_test()) -> result(). pure_check(OuterTest) -> pure_check(OuterTest, []). %% @private %% @doc Same as {@link pure_check/2}, but also accepts a list of options. -spec pure_check(outer_test(), user_opts()) -> result(). pure_check(OuterTest, ImmUserOpts) -> Parent = self(), UserOpts = add_user_opt(quiet, ImmUserOpts), spawn_link(fun() -> Parent ! {result, quickcheck(OuterTest, UserOpts)} end), receive {result, Result} -> Result end. %% @doc Tests the accuracy of an exported function's spec. -spec check_spec(mfa()) -> result(). check_spec(MFA) -> check_spec(MFA, []). %% @doc Same as {@link check_spec/1}, but also accepts a list of options. -spec check_spec(mfa(), user_opts()) -> result(). check_spec(MFA, UserOpts) -> try parse_opts(UserOpts) of Opts -> test({spec,MFA}, Opts) catch throw:{unrecognized_option,_UserOpt} = Reason -> report_error(Reason, fun io:format/2), {error, Reason} end. %% @doc Re-checks a specific counterexample `CExm' against the property %% `OuterTest' that it previously falsified. -spec check(outer_test(), counterexample()) -> short_result(). check(OuterTest, CExm) -> check(OuterTest, CExm, []). %% @doc Same as {@link check/2}, but also accepts a list of options. -spec check(outer_test(), counterexample(), user_opts()) -> short_result(). check(OuterTest, CExm, UserOpts) -> try parse_opts(UserOpts) of ImmOpts -> {Test,Opts} = peel_test(OuterTest, ImmOpts), retry(Test, CExm, Opts) catch throw:{unrecognized_option,_UserOpt} = Reason -> report_error(Reason, fun io:format/2), {error, Reason} end. %% @doc Tests all properties (i.e., all 0-arity functions whose name begins with %% `prop_') exported from module `Mod'. -spec module(mod_name()) -> module_result(). module(Mod) -> module(Mod, []). %% @doc Same as {@link module/1}, but also accepts a list of options. -spec module(mod_name(), user_opts()) -> module_result(). module(Mod, UserOpts) -> multi_test_prep(Mod, test, UserOpts). %% @doc Tests all exported, `-spec'ed functions of a module `Mod' against their %% spec. -spec check_specs(mod_name()) -> module_result(). check_specs(Mod) -> check_specs(Mod, []). %% @doc Same as {@link check_specs/1}, but also accepts a list of options. -spec check_specs(mod_name(), user_opts()) -> module_result(). check_specs(Mod, UserOpts) -> multi_test_prep(Mod, spec, UserOpts). -spec multi_test_prep(mod_name(), raw_test_kind(), user_opts()) -> module_result(). multi_test_prep(Mod, Kind, UserOpts) -> try parse_opts(UserOpts) of Opts -> multi_test(Mod, Kind, Opts) catch throw:{unrecognized_option,_UserOpt} = Reason -> report_error(Reason, fun io:format/2), {error, Reason} end. %%----------------------------------------------------------------------------- %% Options parsing functions %%----------------------------------------------------------------------------- -spec add_user_opt(user_opt(), user_opts()) -> [user_opt(),...]. add_user_opt(NewUserOpt, UserOptsList) when is_list(UserOptsList) -> [NewUserOpt | UserOptsList]; add_user_opt(NewUserOpt, SingleUserOpt) -> add_user_opt(NewUserOpt, [SingleUserOpt]). -spec parse_opts(user_opts()) -> opts(). parse_opts(UserOptsList) when is_list(UserOptsList) -> parse_opts(lists:reverse(UserOptsList), #opts{}); parse_opts(SingleUserOpt) -> parse_opts([SingleUserOpt]). -spec parse_opts([user_opt()], opts()) -> opts(). parse_opts([], Opts) -> Opts; parse_opts([UserOpt | Rest], Opts) -> parse_opts(Rest, parse_opt(UserOpt,Opts)). -spec parse_opt(user_opt(), opts()) -> opts(). parse_opt(UserOpt, Opts) -> case UserOpt of quiet -> Opts#opts{output_fun = fun(_,_) -> ok end}; verbose -> Opts#opts{output_fun = fun io:format/2}; {to_file,IoDev} -> Opts#opts{output_fun = fun(S,F) -> io:format(IoDev, S, F) end }; {on_output,Print} -> Opts#opts{output_fun = Print}; long_result -> Opts#opts{long_result = true}; {numtests,N} -> Opts#opts{numtests = N}; N when is_integer(N) -> Opts#opts{numtests = N}; {start_size,Size} -> Opts#opts{start_size = Size}; {max_size,Size} -> Opts#opts{max_size = Size}; {max_shrinks,N} -> Opts#opts{max_shrinks = N}; noshrink -> Opts#opts{noshrink = true}; {constraint_tries,N} -> Opts#opts{constraint_tries = N}; fails -> Opts#opts{expect_fail = true}; any_to_integer -> Opts#opts{any_type = {type,proper_types:integer()} }; {spec_timeout,N} -> Opts#opts{spec_timeout = N}; {skip_mfas,L} when is_list(L) -> Opts#opts{skip_mfas = L}; {false_positive_mfas,F} when is_function(F); F =:= undefined -> Opts#opts{false_positive_mfas = F}; _ -> throw({unrecognized_option,UserOpt}) end. -spec peel_test(outer_test(), opts()) -> {test(),opts()}. peel_test({numtests,N,OuterTest}, Opts) -> peel_test(OuterTest, Opts#opts{numtests = N}); peel_test({fails,OuterTest}, Opts) -> peel_test(OuterTest, Opts#opts{expect_fail = true}); peel_test({on_output,Print,OuterTest}, Opts) -> peel_test(OuterTest, Opts#opts{output_fun = Print}); peel_test(Test, Opts) -> {Test, Opts}. %%----------------------------------------------------------------------------- %% Test declaration functions %%----------------------------------------------------------------------------- %% TODO: All of these should have a test() or outer_test() return type. %% @doc Specifies the number `N' of tests to run when testing the property %% `Test'. Default is 100. %% @spec numtests(pos_integer(), outer_test()) -> outer_test() -spec numtests(pos_integer(), outer_test()) -> numtests_clause(). numtests(N, Test) -> {numtests, N, Test}. %% @doc Specifies that we expect the property `Test' to fail for some input. The %% property will be considered failing if it passes all the tests. %% @spec fails(outer_test()) -> outer_test() -spec fails(outer_test()) -> fails_clause(). fails(Test) -> {fails, Test}. %% @doc Specifies an output function `Print' to be used by PropEr for all output %% printing during the testing of property `Test'. This wrapper is equivalent to %% the `on_output' option. %% @spec on_output(output_fun(), outer_test()) -> outer_test() -spec on_output(output_fun(), outer_test()) -> on_output_clause(). on_output(Print, Test) -> {on_output, Print, Test}. %% @private -spec forall(proper_types:raw_type(), dependent_test()) -> forall_clause(). forall(RawType, DTest) -> {forall, RawType, DTest}. %% @doc Returns a property that is true only if all of the sub-properties %% `SubProps' are true. Each sub-property should be tagged with a distinct atom. %% If this property fails, each failing sub-property will be reported and saved %% inside the counterexample along with its tag. %% @spec conjunction([{tag(),test()}]) -> test() -spec conjunction([{tag(),test()}]) -> conjunction_clause(). conjunction(SubProps) -> {conjunction, SubProps}. %% @private -spec implies(boolean(), delayed_test()) -> implies_clause(). implies(Pre, DTest) -> {implies, Pre, DTest}. %% @doc Specifies that test cases produced by this property should be %% categorized under the term `Category'. This field can be an expression or %% statement block that evaluates to any term. All produced categories are %% printed at the end of testing (in case no test fails) along with the %% percentage of test cases belonging to each category. Multiple `collect' %% wrappers are allowed in a single property, in which case the percentages for %% each `collect' wrapper are printed separately. %% @spec collect(term(), test()) -> test() -spec collect(term(), test()) -> sample_clause(). collect(Category, Test) -> collect(with_title(""), Category, Test). %% @doc Same as {@link collect/2}, but also accepts a fun `Printer' to be used %% as the stats printer. %% @spec collect(stats_printer(), term(), test()) -> test() -spec collect(stats_printer(), term(), test()) -> sample_clause(). collect(Printer, Category, Test) -> aggregate(Printer, [Category], Test). %% @doc Same as {@link collect/2}, but accepts a list of categories under which %% to classify the produced test case. %% @spec aggregate(sample(), test()) -> test() -spec aggregate(sample(), test()) -> sample_clause(). aggregate(Sample, Test) -> aggregate(with_title(""), Sample, Test). %% @doc Same as {@link collect/3}, but accepts a list of categories under which %% to classify the produced test case. %% @spec aggregate(stats_printer(), sample(), test()) -> test() -spec aggregate(stats_printer(), sample(), test()) -> sample_clause(). aggregate(Printer, Sample, Test) -> {sample, Sample, Printer, Test}. %% @doc Same as {@link collect/2}, but can accept both a single category and a %% list of categories. `Count' is a boolean flag: when `false', the particular %% test case will not be counted. %% @spec classify(Count::boolean(), term() | sample(), test()) -> test() -spec classify(boolean(), term() | sample(), test()) -> sample_clause(). classify(false, _TermOrSample, Test) -> aggregate([], Test); classify(true, Sample, Test) when is_list(Sample) -> aggregate(Sample, Test); classify(true, Term, Test) -> collect(Term, Test). %% @doc A function that collects numeric statistics on the produced instances. %% The number (or numbers) provided are collected and some statistics over the %% collected sample are printed at the end of testing (in case no test fails), %% prepended with `Title', which should be an atom or string. %% @spec measure(title(), number() | [number()], test()) -> test() -spec measure(title(), number() | [number()], test()) -> sample_clause(). measure(Title, Sample, Test) when is_number(Sample) -> measure(Title, [Sample], Test); measure(Title, Sample, Test) when is_list(Sample) -> aggregate(numeric_with_title(Title), Sample, Test). %% @private -spec whenfail(side_effects_fun(), delayed_test()) -> whenfail_clause(). whenfail(Action, DTest) -> {whenfail, Action, DTest}. %% @private -spec trapexit(fun(() -> boolean())) -> trapexit_clause(). trapexit(DTest) -> {trapexit, DTest}. %% @private -spec timeout(time_period(), fun(() -> boolean())) -> timeout_clause(). timeout(Limit, DTest) -> {timeout, Limit, DTest}. %% @doc A custom property that evaluates to `true' only if `A =:= B', else %% evaluates to `false' and prints "`A =/= B'" on the screen. %% @spec equals(term(), term()) -> test() -spec equals(term(), term()) -> whenfail_clause(). equals(A, B) -> ?WHENFAIL(io:format("~w =/= ~w~n",[A,B]), A =:= B). %%----------------------------------------------------------------------------- %% Bulk testing functions %%----------------------------------------------------------------------------- -spec test(raw_test(), opts()) -> result(). test(RawTest, Opts) -> global_state_init(Opts), Result = inner_test(RawTest, Opts), global_state_erase(), Result. -spec inner_test(raw_test(), opts()) -> result(). inner_test(RawTest, #opts{numtests = NumTests, long_result = ReturnLong, output_fun = Print} = Opts) -> Test = cook_test(RawTest, Opts), ImmResult = perform(NumTests, Test, Opts), Print("~n", []), report_imm_result(ImmResult, Opts), {ShortResult,LongResult} = get_result(ImmResult, Test, Opts), case ReturnLong of true -> LongResult; false -> ShortResult end. -spec retry(test(), counterexample(), opts()) -> short_result(). retry(Test, CExm, Opts) -> global_state_init(Opts), RunResult = rerun(Test, false, CExm), report_rerun_result(RunResult, Opts), ShortResult = get_rerun_result(RunResult), global_state_erase(), ShortResult. -spec multi_test(mod_name(), raw_test_kind(), opts()) -> module_result(). multi_test(Mod, RawTestKind, #opts{long_result = ReturnLong, output_fun = Print, skip_mfas = SkipMFAs} = Opts) -> global_state_init(Opts), MaybeMFAs = case RawTestKind of test -> {ok, [{Mod,Name,0} || {Name,0} <- Mod:module_info(exports), lists:prefix(?PROPERTY_PREFIX, atom_to_list(Name))]}; spec -> proper_typeserver:get_exp_specced(Mod) end, {ShortResult, LongResult} = case MaybeMFAs of {ok,MFAs} -> RawLRes = [{MFA,mfa_test(MFA,RawTestKind,Opts)} || MFA <- MFAs--SkipMFAs], LRes = [T || {_MFA,Res} = T <- RawLRes, is_list(Res)], SRes = [MFA || {MFA,_Res} <- LRes], save_counterexamples(LRes), {SRes, LRes}; {error,SubReason} -> Reason = {typeserver,SubReason}, report_error(Reason, Print), Error = {error,Reason}, {Error, Error} end, global_state_erase(), case ReturnLong of true -> LongResult; false -> ShortResult end. -spec mfa_test(mfa(), raw_test_kind(), opts()) -> long_result(). mfa_test({Mod,Fun,Arity} = MFA, RawTestKind, ImmOpts) -> {RawTest,#opts{output_fun = Print} = Opts} = case RawTestKind of test -> OuterTest = Mod:Fun(), {Test,FinalOpts} = peel_test(OuterTest, ImmOpts), {{test,Test}, FinalOpts}; spec -> {{spec,MFA}, ImmOpts} end, global_state_reset(Opts), Print("Testing ~w:~w/~b~n", [Mod,Fun,Arity]), LongResult = inner_test(RawTest, Opts#opts{long_result = true}), Print("~n", []), LongResult. -spec cook_test(raw_test(), opts()) -> test(). cook_test({test,Test}, _Opts) -> Test; cook_test({spec,MFA}, #opts{spec_timeout = SpecTimeout, false_positive_mfas = FalsePositiveMFAs}) -> case proper_typeserver:create_spec_test(MFA, SpecTimeout, FalsePositiveMFAs) of {ok,Test} -> Test; {error,Reason} -> ?FORALL(_, dummy, throw({'$typeserver',Reason})) end. -spec get_result(imm_result(),test(),opts()) -> {short_result(),long_result()}. get_result(#pass{}, _Test, _Opts) -> {true, true}; get_result(#fail{reason = Reason, bound = Bound}, Test, Opts) -> case shrink(Bound, Test, Reason, Opts) of {ok,MinImmTestCase} -> MinTestCase = clean_testcase(MinImmTestCase), save_counterexample(MinTestCase), {false, MinTestCase}; {error,ErrorReason} = Error -> report_error(ErrorReason, Opts#opts.output_fun), {Error, Error} end; get_result({error,_Reason} = ErrorResult, _Test, _Opts) -> {ErrorResult, ErrorResult}. -spec get_rerun_result(run_result()) -> short_result(). get_rerun_result(#pass{}) -> true; get_rerun_result(#fail{}) -> false; get_rerun_result({error,_Reason} = ErrorResult) -> ErrorResult. -spec perform(pos_integer(), test(), opts()) -> imm_result(). perform(NumTests, Test, Opts) -> perform(0, NumTests, ?MAX_TRIES_FACTOR * NumTests, Test, none, none, Opts). -spec perform(non_neg_integer(), pos_integer(), non_neg_integer(), test(), [sample()] | 'none', [stats_printer()] | 'none', opts()) -> imm_result(). perform(Passed, _ToPass, 0, _Test, Samples, Printers, _Opts) -> case Passed of 0 -> {error, cant_satisfy}; _ -> #pass{samples = Samples, printers = Printers, performed = Passed} end; perform(ToPass, ToPass, _TriesLeft, _Test, Samples, Printers, _Opts) -> #pass{samples = Samples, printers = Printers, performed = ToPass}; perform(Passed, ToPass, TriesLeft, Test, Samples, Printers, #opts{output_fun = Print} = Opts) -> case run(Test) of #pass{reason = true_prop, samples = MoreSamples, printers = MorePrinters} -> Print(".", []), NewSamples = add_samples(MoreSamples, Samples), NewPrinters = case Printers of none -> MorePrinters; _ -> Printers end, grow_size(Opts), perform(Passed + 1, ToPass, TriesLeft - 1, Test, NewSamples, NewPrinters, Opts); #fail{} = FailResult -> Print("!", []), FailResult#fail{performed = Passed + 1}; {error, rejected} -> Print("x", []), grow_size(Opts), perform(Passed, ToPass, TriesLeft - 1, Test, Samples, Printers, Opts); {error, Reason} = Error when Reason =:= arity_limit orelse Reason =:= cant_generate orelse Reason =:= non_boolean_result orelse Reason =:= type_mismatch -> Error; {error, {typeserver,_SubReason}} = Error -> Error; Other -> {error, {unexpected,Other}} end. -spec add_samples([sample()], [sample()] | 'none') -> [sample()]. add_samples(MoreSamples, none) -> MoreSamples; add_samples(MoreSamples, Samples) -> [M ++ S || {M,S} <- proper_arith:safe_zip(MoreSamples,Samples)]. %%----------------------------------------------------------------------------- %% Single test runner functions %%----------------------------------------------------------------------------- -spec run(test()) -> run_result(). run(Test) -> run(Test, #ctx{}). -spec rerun(test(),boolean(),imm_testcase() | counterexample()) -> run_result(). rerun(Test, IsImm, ToTry) -> Mode = case IsImm of true -> try_shrunk; false -> try_cexm end, Ctx = #ctx{mode = Mode, bound = ToTry}, run(Test, Ctx). -spec run(test(), ctx()) -> run_result(). run(Result, #ctx{mode = Mode, bound = Bound} = Ctx) when is_boolean(Result) -> case Mode =:= new orelse Bound =:= [] of true -> case Result of true -> create_pass_result(Ctx, true_prop); false -> create_fail_result(Ctx, false_prop) end; false -> {error, too_many_instances} end; run({forall,RawType,Prop}, #ctx{mode = new, bound = Bound} = Ctx) -> case proper_gen:safe_generate(RawType) of {ok,ImmInstance} -> Instance = proper_gen:clean_instance(ImmInstance), NewCtx = Ctx#ctx{bound = [ImmInstance | Bound]}, force(Instance, Prop, NewCtx); {error,_Reason} = Error -> Error end; run({forall,_RawType,_Prop}, #ctx{bound = []} = Ctx) -> create_pass_result(Ctx, didnt_crash); run({forall,RawType,Prop}, #ctx{mode = try_shrunk, bound = [ImmInstance | Rest]} = Ctx) -> case proper_types:safe_is_instance(ImmInstance, RawType) of true -> Instance = proper_gen:clean_instance(ImmInstance), force(Instance, Prop, Ctx#ctx{bound = Rest}); false -> %% TODO: could try to fix the instances here {error, wrong_type}; {error,_Reason} = Error -> Error end; run({forall,_RawType,Prop}, #ctx{mode = try_cexm, bound = [Instance | Rest]} = Ctx) -> force(Instance, Prop, Ctx#ctx{bound = Rest}); run({conjunction,SubProps}, #ctx{mode = new} = Ctx) -> run_all(SubProps, [], Ctx); run({conjunction,SubProps}, #ctx{mode = try_shrunk, bound = Bound} = Ctx) -> case Bound of [] -> create_pass_result(Ctx, didnt_crash); [{'$conjunction',SubImmTCs}] -> run_all(SubProps, SubImmTCs, Ctx#ctx{bound = []}); _ -> {error, too_many_instances} end; run({conjunction,SubProps}, #ctx{mode = try_cexm, bound = Bound} = Ctx) -> RealBound = case Bound of [] -> [[]]; _ -> Bound end, case RealBound of [SubTCs] -> run_all(SubProps, SubTCs, Ctx#ctx{bound = []}); _ -> {error, too_many_instances} end; run({implies,true,Prop}, Ctx) -> force(Prop, Ctx); run({implies,false,_Prop}, _Ctx) -> {error, rejected}; run({sample,NewSample,NewPrinter,Prop}, #ctx{samples = Samples, printers = Printers} = Ctx) -> NewCtx = Ctx#ctx{samples = [NewSample | Samples], printers = [NewPrinter | Printers]}, run(Prop, NewCtx); run({whenfail,NewAction,Prop}, #ctx{actions = Actions} = Ctx)-> NewCtx = Ctx#ctx{actions = [NewAction | Actions]}, force(Prop, NewCtx); run({trapexit,Prop}, Ctx) -> OldFlag = process_flag(trap_exit, true), Self = self(), Child = spawn_link_migrate(fun() -> child(Self,Prop,Ctx) end), Result = receive {result, RecvResult} -> RecvResult; {'EXIT', Child, ExcReason} -> create_fail_result(Ctx, {trapped,ExcReason}) end, true = process_flag(trap_exit, OldFlag), Result; run({timeout,Limit,Prop}, Ctx) -> Self = self(), Child = spawn_link_migrate(fun() -> child(Self,Prop,Ctx) end), receive {result, RecvResult} -> RecvResult after Limit -> unlink(Child), exit(Child, kill), clear_mailbox(), create_fail_result(Ctx, time_out) end; run(_Other, _Ctx) -> {error, non_boolean_result}. -spec run_all([{tag(),test()}], sub_imm_testcases() | sub_counterexamples(), ctx()) -> run_result(). run_all(SubProps, Bound, Ctx) -> run_all(SubProps, Bound, [], Ctx). -spec run_all([{tag(),test()}], sub_imm_testcases() | sub_counterexamples(), [{tag(),fail_reason()}], ctx()) -> run_result(). run_all([], SubBound, SubReasons, #ctx{mode = new, bound = OldBound} = Ctx) -> NewBound = [{'$conjunction',lists:reverse(SubBound)} | OldBound], NewCtx = Ctx#ctx{bound = NewBound}, case SubReasons of [] -> create_pass_result(NewCtx, true_prop); _ -> create_fail_result(NewCtx, {sub_props,lists:reverse(SubReasons)}) end; run_all([], SubBound, SubReasons, Ctx) -> case {SubBound,SubReasons} of {[],[]} -> create_pass_result(Ctx, true_prop); {[],_ } -> create_fail_result(Ctx, {sub_props,lists:reverse(SubReasons)}); {_ ,_ } -> {error, too_many_instances} end; run_all([{Tag,Prop}|Rest], OldSubBound, SubReasons, #ctx{mode = Mode, actions = Actions, samples = Samples, printers = Printers} = Ctx) -> {SubCtxBound,SubBound} = case Mode of new -> {[], OldSubBound}; _ -> {proplists:get_value(Tag, OldSubBound, []), proplists:delete(Tag, OldSubBound)} end, case run(Prop, #ctx{mode = Mode, bound = SubCtxBound}) of #pass{samples = MoreSamples, printers = MorePrinters} -> NewSamples = lists:reverse(MoreSamples, Samples), NewPrinters = lists:reverse(MorePrinters, Printers), NewCtx = Ctx#ctx{samples = NewSamples, printers = NewPrinters}, run_all(Rest, SubBound, SubReasons, NewCtx); #fail{reason = Reason, bound = SubImmTC, actions = MoreActions} -> NewActions = lists:reverse(MoreActions, Actions), NewCtx = Ctx#ctx{actions = NewActions}, NewSubBound = case Mode of new -> [{Tag,SubImmTC}|SubBound]; _ -> SubBound end, NewSubReasons = [{Tag,Reason}|SubReasons], run_all(Rest, NewSubBound, NewSubReasons, NewCtx); {error,_Reason} = Error -> Error end. -spec force(delayed_test(), ctx()) -> run_result(). force(Prop, Ctx) -> apply_args([], Prop, Ctx). -spec force(proper_gen:instance(), dependent_test(), ctx()) -> run_result(). force(Arg, Prop, Ctx) -> apply_args([proper_symb:internal_eval(Arg)], Prop, Ctx). -spec apply_args([proper_gen:instance()], lazy_test(), ctx()) -> run_result(). apply_args(Args, Prop, Ctx) -> try apply(Prop, Args) of InnerProp -> run(InnerProp, Ctx) catch error:ErrReason -> RawTrace = erlang:get_stacktrace(), case ErrReason =:= function_clause andalso threw_exception(Prop, RawTrace) of true -> {error, type_mismatch}; false -> Trace = clean_stacktrace(RawTrace), create_fail_result(Ctx, {exception,error,ErrReason,Trace}) end; throw:'$arity_limit' -> {error, arity_limit}; throw:'$cant_generate' -> {error, cant_generate}; throw:{'$typeserver',SubReason} -> {error, {typeserver,SubReason}}; ExcKind:ExcReason -> Trace = erlang:get_stacktrace(), create_fail_result(Ctx, {exception,ExcKind,ExcReason,Trace}) end. -spec create_pass_result(ctx(), pass_reason()) -> #pass{performed :: 'undefined'}. create_pass_result(#ctx{samples = Samples, printers = Printers}, Reason) -> #pass{reason = Reason, samples = lists:reverse(Samples), printers = lists:reverse(Printers)}. -spec create_fail_result(ctx(), fail_reason()) -> #fail{performed :: 'undefined'}. create_fail_result(#ctx{bound = Bound, actions = Actions}, Reason) -> #fail{reason = Reason, bound = lists:reverse(Bound), actions = lists:reverse(Actions)}. -spec child(pid(), delayed_test(), ctx()) -> 'ok'. child(Father, Prop, Ctx) -> Result = force(Prop, Ctx), Father ! {result,Result}, ok. -spec clear_mailbox() -> 'ok'. clear_mailbox() -> receive _ -> clear_mailbox() after 0 -> ok end. -spec threw_exception(function(), stacktrace()) -> boolean(). -ifdef(OLD_STACKTRACE_FORMAT). threw_exception(Fun, [{TopMod,TopName,TopArgs} | _Rest]) -> threw_exception_aux(Fun, TopMod, TopName, TopArgs). -else. threw_exception(Fun, [{TopMod,TopName,TopArgs,_Location} | _Rest]) -> threw_exception_aux(Fun, TopMod, TopName, TopArgs). -endif. -spec threw_exception_aux(function(), mod_name(), fun_name(), arity() | list()) -> boolean(). threw_exception_aux(Fun, TopMod, TopName, TopArgs) -> {module,FunMod} = erlang:fun_info(Fun, module), {name,FunName} = erlang:fun_info(Fun, name), {arity,FunArity} = erlang:fun_info(Fun, arity), TopArity = if is_integer(TopArgs) -> TopArgs; is_list(TopArgs) -> length(TopArgs) end, FunMod =:= TopMod andalso FunName =:= TopName andalso FunArity =:= TopArity. -spec clean_stacktrace(stacktrace()) -> stacktrace(). clean_stacktrace(RawTrace) -> {Trace,_Rest} = lists:splitwith(fun is_not_proper_call/1, RawTrace), %% If the clean trace is empty it's probably because of a bad call to %% the proper API, so we let the whole stacktrace through case Trace of [] -> RawTrace; _ -> Trace end. -spec is_not_proper_call(call_record()) -> boolean(). -ifdef(OLD_STACKTRACE_FORMAT). is_not_proper_call({Mod,_Fun,_Args}) -> not lists:prefix("proper", atom_to_list(Mod)). -else. is_not_proper_call({Mod,_Fun,_Args,_Location}) -> not lists:prefix("proper", atom_to_list(Mod)). -endif. -spec clean_testcase(imm_testcase()) -> counterexample(). clean_testcase(ImmTestCase) -> finalize_counterexample(preclean_testcase(ImmTestCase, [])). -spec preclean_testcase(imm_testcase(), imm_counterexample()) -> imm_counterexample(). preclean_testcase([], Acc) -> lists:reverse(Acc); preclean_testcase([{'$conjunction',SubImmTCs} | Rest], Acc) -> Rest = [], case preclean_sub_imm_testcases(SubImmTCs, []) of [] -> preclean_testcase([], Acc); SubImmCExms -> preclean_testcase([], [{'$conjunction',SubImmCExms}|Acc]) end; preclean_testcase([ImmInstance | Rest], Acc) -> preclean_testcase(Rest, [proper_gen:clean_instance(ImmInstance) | Acc]). -spec preclean_sub_imm_testcases(sub_imm_testcases(), sub_imm_counterexamples()) -> sub_imm_counterexamples(). preclean_sub_imm_testcases([], Acc) -> lists:reverse(Acc); preclean_sub_imm_testcases([{Tag,ImmTC} | Rest], Acc) -> case preclean_testcase(ImmTC, []) of [] -> preclean_sub_imm_testcases(Rest, Acc); ImmCExm -> preclean_sub_imm_testcases(Rest, [{Tag,ImmCExm} | Acc]) end. -spec finalize_counterexample(imm_counterexample()) -> counterexample(). finalize_counterexample(ImmCExm) -> [finalize_input(ImmCleanInput) || ImmCleanInput <- ImmCExm]. -spec finalize_input(imm_clean_input()) -> clean_input(). finalize_input({'$conjunction',SubImmCExms}) -> [{Tag,finalize_counterexample(SubImmCExm)} || {Tag,SubImmCExm} <- SubImmCExms]; finalize_input(Instance) -> Instance. %%----------------------------------------------------------------------------- %% Shrinking functions %%----------------------------------------------------------------------------- -spec shrink(imm_testcase(), test(), fail_reason(), opts()) -> {'ok',imm_testcase()} | error(). shrink(ImmTestCase, Test, Reason, #opts{expect_fail = false, noshrink = false, max_shrinks = MaxShrinks, output_fun = Print} = Opts) -> Print("~nShrinking ", []), try StrTest = skip_to_next(Test), fix_shrink(ImmTestCase, StrTest, Reason, 0, MaxShrinks, Opts) of {Shrinks,MinImmTestCase} -> case rerun(Test, true, MinImmTestCase) of #fail{actions = MinActions} -> report_shrinking(Shrinks, MinImmTestCase, MinActions, Print), {ok, MinImmTestCase}; %% The cases below should never occur for deterministic tests. %% When they do happen, we have no choice but to silently %% skip the fail actions. #pass{} -> report_shrinking(Shrinks, MinImmTestCase, [], Print), {ok, MinImmTestCase}; {error,_Reason} -> report_shrinking(Shrinks, MinImmTestCase, [], Print), {ok, MinImmTestCase} end catch throw:non_boolean_result -> Print("~n", []), {error, non_boolean_result} end; shrink(ImmTestCase, _Test, _Reason, _Opts) -> {ok, ImmTestCase}. -spec fix_shrink(imm_testcase(), stripped_test(), fail_reason(), non_neg_integer(), non_neg_integer(), opts()) -> shrinking_result(). fix_shrink(ImmTestCase, _StrTest, _Reason, Shrinks, 0, _Opts) -> {Shrinks, ImmTestCase}; fix_shrink(ImmTestCase, StrTest, Reason, Shrinks, ShrinksLeft, Opts) -> case shrink([], ImmTestCase, StrTest, Reason, 0, ShrinksLeft, init, Opts) of {0,_MinImmTestCase} -> {Shrinks, ImmTestCase}; {MoreShrinks,MinImmTestCase} -> fix_shrink(MinImmTestCase, StrTest, Reason, Shrinks + MoreShrinks, ShrinksLeft - MoreShrinks, Opts) end. -spec shrink(imm_testcase(), imm_testcase(), stripped_test(), fail_reason(), non_neg_integer(), non_neg_integer(), proper_shrink:state(), opts()) -> shrinking_result(). %% TODO: 'tries_left' instead of 'shrinks_left'? shrinking timeout? %% TODO: Can we do anything better for non-deterministic tests? shrink(Shrunk, TestTail, StrTest, _Reason, Shrinks, ShrinksLeft, _State, _Opts) when is_boolean(StrTest) orelse ShrinksLeft =:= 0 -> {Shrinks, lists:reverse(Shrunk, TestTail)}; shrink(Shrunk, [ImmInstance | Rest], {_Type,Prop}, Reason, Shrinks, ShrinksLeft, done, Opts) -> Instance = proper_gen:clean_instance(ImmInstance), NewStrTest = force_skip(Instance, Prop), shrink([ImmInstance | Shrunk], Rest, NewStrTest, Reason, Shrinks, ShrinksLeft, init, Opts); shrink(Shrunk, [ImmInstance | Rest] = TestTail, {Type,Prop} = StrTest, Reason, Shrinks, ShrinksLeft, State, Opts) -> {NewImmInstances,NewState} = proper_shrink:shrink(ImmInstance, Type, State), %% TODO: Should we try fixing the nested ?FORALLs while shrinking? We could %% also just produce new test tails. IsValid = fun(I) -> I =/= ImmInstance andalso still_fails(I, Rest, Prop, Reason) end, case proper_arith:find_first(IsValid, NewImmInstances) of none -> shrink(Shrunk, TestTail, StrTest, Reason, Shrinks, ShrinksLeft, NewState, Opts); {Pos, ShrunkImmInstance} -> (Opts#opts.output_fun)(".", []), shrink(Shrunk, [ShrunkImmInstance | Rest], StrTest, Reason, Shrinks+1, ShrinksLeft-1, {shrunk,Pos,NewState}, Opts) end; shrink(Shrunk, [{'$conjunction',SubImmTCs}], SubProps, {sub_props,SubReasons}, Shrinks, ShrinksLeft, init, Opts) when is_list(SubProps) -> shrink_all(Shrunk, [], SubImmTCs, SubProps, SubReasons, Shrinks, ShrinksLeft, Opts). -spec shrink_all(imm_testcase(), sub_imm_testcases(), sub_imm_testcases(), [{tag(),test()}], [{tag(),fail_reason()}], non_neg_integer(), non_neg_integer(), opts()) -> shrinking_result(). shrink_all(ShrunkHead, Shrunk, SubImmTCs, _SubProps, _SubReasons, Shrinks, 0, _Opts) -> ShrunkSubImmTCs = lists:reverse(Shrunk, SubImmTCs), ImmTC = lists:reverse([{'$conjunction',ShrunkSubImmTCs} | ShrunkHead]), {Shrinks, ImmTC}; shrink_all(ShrunkHead, Shrunk, [], [], [], Shrinks, _ShrinksLeft, Opts) -> shrink_all(ShrunkHead, Shrunk, [], [], [], Shrinks, 0, Opts); shrink_all(ShrunkHead, Shrunk, SubImmTCs, [{Tag,Prop}|Rest], SubReasons, Shrinks, ShrinksLeft, Opts) -> case lists:keytake(Tag, 1, SubReasons) of {value,{Tag,Reason},NewSubReasons} -> {value,{Tag,SubImmTC},NewSubImmTCs} = lists:keytake(Tag, 1, SubImmTCs), {MoreShrinks,MinSubImmTC} = shrink([], SubImmTC, skip_to_next(Prop), Reason, 0, ShrinksLeft, init, Opts), shrink_all(ShrunkHead, [{Tag,MinSubImmTC}|Shrunk], NewSubImmTCs, Rest, NewSubReasons, Shrinks+MoreShrinks, ShrinksLeft-MoreShrinks, Opts); false -> shrink_all(ShrunkHead, Shrunk, SubImmTCs, Rest, SubReasons, Shrinks, ShrinksLeft, Opts) end. -spec still_fails(proper_gen:imm_instance(), imm_testcase(), dependent_test(), fail_reason()) -> boolean(). still_fails(ImmInstance, TestTail, Prop, OldReason) -> Instance = proper_gen:clean_instance(ImmInstance), Ctx = #ctx{mode = try_shrunk, bound = TestTail}, case force(Instance, Prop, Ctx) of #fail{reason = NewReason} -> same_fail_reason(OldReason, NewReason); _ -> false end. -spec same_fail_reason(fail_reason(), fail_reason()) -> boolean(). %% We don't mind if the stacktraces are different. same_fail_reason({trapped,{ExcReason1,_StackTrace1}}, {trapped,{ExcReason2,_StackTrace2}}) -> same_exc_reason(ExcReason1, ExcReason2); same_fail_reason({exception,SameExcKind,ExcReason1,_StackTrace1}, {exception,SameExcKind,ExcReason2,_StackTrace2}) -> same_exc_reason(ExcReason1, ExcReason2); same_fail_reason({sub_props,SubReasons1}, {sub_props,SubReasons2}) -> length(SubReasons1) =:= length(SubReasons2) andalso lists:all(fun({A,B}) -> same_sub_reason(A,B) end, lists:zip(lists:sort(SubReasons1),lists:sort(SubReasons2))); same_fail_reason(SameReason, SameReason) -> true; same_fail_reason(_, _) -> false. -spec same_exc_reason(exc_reason(), exc_reason()) -> boolean(). same_exc_reason(ExcReason1, ExcReason2) -> %% We assume that exception reasons are either atoms or tagged tuples. %% What we try to do is force the generation of the same exception reason. if is_atom(ExcReason1) -> ExcReason1 =:= ExcReason2; is_tuple(ExcReason1) -> is_tuple(ExcReason2) andalso tuple_size(ExcReason1) >= 1 andalso tuple_size(ExcReason1) =:= tuple_size(ExcReason2) %% We assume that the tag is the first element. andalso is_atom(element(1, ExcReason1)) andalso element(1, ExcReason1) =:= element(1, ExcReason2); true -> false end. -spec same_sub_reason({tag(),fail_reason()},{tag(),fail_reason()}) -> boolean(). same_sub_reason({SameTag,Reason1}, {SameTag,Reason2}) -> same_fail_reason(Reason1, Reason2); same_sub_reason(_, _) -> false. -spec skip_to_next(test()) -> stripped_test(). skip_to_next(Result) when is_boolean(Result) -> Result; skip_to_next({forall,RawType,Prop}) -> Type = proper_types:cook_outer(RawType), {Type, Prop}; skip_to_next({conjunction,SubProps}) -> SubProps; skip_to_next({implies,Pre,Prop}) -> case Pre of true -> force_skip(Prop); false -> true end; skip_to_next({sample,_Sample,_Printer,Prop}) -> skip_to_next(Prop); skip_to_next({whenfail,_Action,Prop}) -> force_skip(Prop); %% The following 2 clauses assume that _Prop cannot contain any other wrappers. skip_to_next({trapexit,_Prop}) -> false; skip_to_next({timeout,_Limit,_Prop}) -> false; skip_to_next(_Other) -> throw(non_boolean_result). -spec force_skip(delayed_test()) -> stripped_test(). force_skip(Prop) -> apply_skip([], Prop). -spec force_skip(proper_gen:instance(), dependent_test()) -> stripped_test(). force_skip(Arg, Prop) -> apply_skip([proper_symb:internal_eval(Arg)], Prop). -spec apply_skip([proper_gen:instance()], lazy_test()) -> stripped_test(). apply_skip(Args, Prop) -> try apply(Prop, Args) of InnerTest -> skip_to_next(InnerTest) catch %% Should be OK to catch everything here, since we have already tested %% at this point that the test still fails. _ExcKind:_ExcReason -> false end. %%----------------------------------------------------------------------------- %% Output functions %%----------------------------------------------------------------------------- -spec report_imm_result(imm_result(), opts()) -> 'ok'. report_imm_result(#pass{samples = Samples, printers = Printers, performed = Performed}, #opts{expect_fail = ExpectF, output_fun = Print}) -> case ExpectF of true -> Print("Failed: All tests passed when a failure was expected." "~n", []); false -> Print("OK: Passed ~b test(s).~n", [Performed]) end, SortedSamples = [lists:sort(Sample) || Sample <- Samples], lists:foreach(fun({P,S}) -> apply_stats_printer(P, S, Print) end, proper_arith:safe_zip(Printers, SortedSamples)); report_imm_result(#fail{reason = Reason, bound = Bound, actions = Actions, performed = Performed}, #opts{expect_fail = ExpectF, output_fun = Print}) -> case ExpectF of true -> Print("OK: Failed as expected, after ~b test(s).~n", [Performed]); false -> Print("Failed: After ~b test(s).~n", [Performed]) end, report_fail_reason(Reason, "", Print), print_imm_testcase(Bound, "", Print), execute_actions(Actions); report_imm_result({error,Reason}, #opts{output_fun = Print}) -> report_error(Reason, Print). -spec report_rerun_result(run_result(), opts()) -> 'ok'. report_rerun_result(#pass{reason = Reason}, #opts{expect_fail = ExpectF, output_fun = Print}) -> case ExpectF of true -> Print("Failed: ", []); false -> Print("OK: ", []) end, case Reason of true_prop -> Print("The input passed the test.~n", []); didnt_crash -> Print("The input didn't raise an early exception.~n", []) end; report_rerun_result(#fail{reason = Reason, actions = Actions}, #opts{expect_fail = ExpectF, output_fun = Print}) -> case ExpectF of true -> Print("OK: ", []); false -> Print("Failed: ", []) end, Print("The input fails the test.~n", []), report_fail_reason(Reason, "", Print), execute_actions(Actions); report_rerun_result({error,Reason}, #opts{output_fun = Print}) -> report_error(Reason, Print). %% @private -spec report_error(error_reason(), output_fun()) -> 'ok'. report_error(arity_limit, Print) -> Print("Error: Couldn't produce a function of the desired arity, please " "recompile PropEr with an increased value for ?MAX_ARITY.~n", []); report_error(cant_generate, Print) -> Print("Error: Couldn't produce an instance that satisfies all strict " "constraints after ~b tries.~n", [get('$constraint_tries')]); report_error(cant_satisfy, Print) -> Print("Error: No valid test could be generated.~n", []); report_error(non_boolean_result, Print) -> Print("Error: The property code returned a non-boolean result.~n", []); report_error(rejected, Print) -> Print(?MISMATCH_MSG ++ "It failed an ?IMPLIES check.~n", []); report_error(too_many_instances, Print) -> Print(?MISMATCH_MSG ++ "It's too long.~n", []); %% that's what she said report_error(type_mismatch, Print) -> Print("Error: The variables' and types' structures inside a ?FORALL don't " "match.~n", []); report_error(wrong_type, Print) -> Print("Internal error: 'wrong_type' error reached toplevel.~n" "Please notify the maintainers about this error.~n", []); report_error({typeserver,SubReason}, Print) -> Print("Error: The typeserver encountered an error: ~w.~n", [SubReason]); report_error({unexpected,Unexpected}, Print) -> Print("Internal error: The last run returned an unexpected result:~n~w~n" "Please notify the maintainers about this error.~n", [Unexpected]); report_error({unrecognized_option,UserOpt}, Print) -> Print("Error: Unrecognized option: ~w.~n", [UserOpt]). -spec report_fail_reason(fail_reason(), string(), output_fun()) -> 'ok'. report_fail_reason(false_prop, _Prefix, _Print) -> ok; report_fail_reason(time_out, Prefix, Print) -> Print(Prefix ++ "Test execution timed out.~n", []); report_fail_reason({trapped,ExcReason}, Prefix, Print) -> Print(Prefix ++ "A linked process died with reason ~w.~n", [ExcReason]); report_fail_reason({exception,ExcKind,ExcReason,StackTrace}, Prefix, Print) -> Print(Prefix ++ "An exception was raised: ~w:~w.~n", [ExcKind,ExcReason]), Print(Prefix ++ "Stacktrace: ~p.~n", [StackTrace]); report_fail_reason({sub_props,SubReasons}, Prefix, Print) -> Report = fun({Tag,Reason}) -> Print(Prefix ++ "Sub-property ~w failed.~n", [Tag]), report_fail_reason(Reason, ">> " ++ Prefix, Print) end, lists:foreach(Report, SubReasons). -spec print_imm_testcase(imm_testcase(), string(), output_fun()) -> 'ok'. print_imm_testcase(ImmTestCase, Prefix, Print) -> ImmCExm = preclean_testcase(ImmTestCase, []), print_imm_counterexample(ImmCExm, Prefix, Print). -spec print_imm_counterexample(imm_counterexample(), string(), output_fun()) -> 'ok'. print_imm_counterexample(ImmCExm, Prefix, Print) -> PrintImmCleanInput = fun(I) -> print_imm_clean_input(I, Prefix, Print) end, lists:foreach(PrintImmCleanInput, ImmCExm). -spec print_imm_clean_input(imm_clean_input(), string(), output_fun()) -> 'ok'. print_imm_clean_input({'$conjunction',SubImmCExms}, Prefix, Print) -> PrintSubImmCExm = fun({Tag,ImmCExm}) -> Print(Prefix ++ "~w:~n", [Tag]), print_imm_counterexample(ImmCExm, ">> " ++ Prefix, Print) end, lists:foreach(PrintSubImmCExm, SubImmCExms); print_imm_clean_input(Instance, Prefix, Print) -> Print(Prefix ++ "~w~n", [Instance]). -spec execute_actions(fail_actions()) -> 'ok'. execute_actions(Actions) -> lists:foreach(fun(A) -> ?FORCE(A) end, Actions). -spec report_shrinking(non_neg_integer(), imm_testcase(), fail_actions(), output_fun()) -> 'ok'. report_shrinking(Shrinks, MinImmTestCase, MinActions, Print) -> Print("(~b time(s))~n", [Shrinks]), print_imm_testcase(MinImmTestCase, "", Print), execute_actions(MinActions). %%----------------------------------------------------------------------------- %% Stats printing functions %%----------------------------------------------------------------------------- -spec apply_stats_printer(stats_printer(), sample(), output_fun()) -> 'ok'. apply_stats_printer(Printer, SortedSample, Print) -> {arity,Arity} = erlang:fun_info(Printer, arity), case Arity of 1 -> Printer(SortedSample); 2 -> Printer(SortedSample, Print) end. %% @doc A predefined function that accepts an atom or string and returns a %% stats printing function which is equivalent to the default one, but prints %% the given title `Title' above the statistics. -spec with_title(title()) -> stats_printer(). with_title(Title) -> fun(S,O) -> plain_stats_printer(S, O, Title) end. -spec plain_stats_printer(sample(), output_fun(), title()) -> 'ok'. plain_stats_printer(SortedSample, Print, Title) -> print_title(Title, Print), Total = length(SortedSample), FreqSample = process_sorted_sample(SortedSample), lists:foreach(fun({X,F}) -> Print("~b\% ~w~n", [100 * F div Total,X]) end, FreqSample). -spec print_title(title(), output_fun()) -> 'ok'. print_title(RawTitle, Print) -> Print("~n", []), Title = if is_atom(RawTitle) -> atom_to_list(RawTitle); is_list(RawTitle) -> RawTitle end, case Title of "" -> ok; _ -> Print(Title ++ "~n", []) end. -spec process_sorted_sample(sample()) -> freq_sample(). process_sorted_sample(SortedSample) -> Freqs = get_freqs(SortedSample, []), lists:reverse(lists:keysort(2, Freqs)). -spec get_freqs(sample(), freq_sample()) -> freq_sample(). get_freqs([], Freqs) -> Freqs; get_freqs([Term | Rest], Freqs) -> {Freq,Others} = remove_all(Term, 1, Rest), get_freqs(Others, [{Term,Freq} | Freqs]). -spec remove_all(term(), frequency(), sample()) -> {frequency(), sample()}. remove_all(X, Freq, [X | Rest]) -> remove_all(X, Freq + 1, Rest); remove_all(_X, Freq, Sample) -> {Freq, Sample}. -spec numeric_with_title(title()) -> stats_printer(). numeric_with_title(Title) -> fun(S,O) -> num_stats_printer(S, O, Title) end. -spec num_stats_printer([number()], output_fun(), title()) -> 'ok'. num_stats_printer(SortedSample, Print, Title) -> print_title(Title, Print), {Min,Avg,Max} = get_numeric_stats(SortedSample), Print("minimum: ~w~naverage: ~w~nmaximum: ~w~n", [Min,Avg,Max]). -spec get_numeric_stats([]) -> {'undefined', 'undefined', 'undefined'}; ([number(),...]) -> numeric_stats(). get_numeric_stats([]) -> {undefined, undefined, undefined}; get_numeric_stats([Min | _Rest] = SortedSample) -> {Avg, Max} = avg_and_last(SortedSample, 0, 0), {Min, Avg, Max}. -spec avg_and_last([number(),...], number(), non_neg_integer()) -> {float(), number()}. avg_and_last([Last], Sum, Len) -> {(Sum + Last) / (Len + 1), Last}; avg_and_last([X | Rest], Sum, Len) -> avg_and_last(Rest, Sum + X, Len + 1). erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_arith.erl000066400000000000000000000303661255446327200233160ustar00rootroot00000000000000%%% Copyright 2010-2015 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2015 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc This module contains helper arithmetic, list handling and random %%% functions. %%% @private -module(proper_arith). -export([list_remove/2, list_update/3, list_insert/3, safe_map/2, safe_foldl/3, safe_any/2, safe_zip/2, tuple_map/2, cut_improper_tail/1, head_length/1, find_first/2, filter/2, partition/2, remove/2, insert/3, unflatten/2]). -export([rand_start/1, rand_restart/1, rand_reseed/0, rand_stop/0, rand_int/1, rand_int/2, smart_rand_int/3, rand_non_neg_int/1, rand_float/1, rand_float/2, rand_non_neg_float/1, distribute/2, jumble/1, rand_choose/1, freq_choose/1]). -include("proper_internal.hrl"). %%----------------------------------------------------------------------------- %% List handling functions %%----------------------------------------------------------------------------- -spec list_remove(position(), [T]) -> [T]. list_remove(Index, List) -> {H,[_Elem | T]} = lists:split(Index - 1, List), H ++ T. -spec list_update(position(), T, [T]) -> [T,...]. list_update(Index, NewElem, List) -> {H,[_OldElem | T]} = lists:split(Index - 1, List), H ++ [NewElem] ++ T. -spec list_insert(position(), T, [T]) -> [T,...]. list_insert(Index, Elem, List) -> {H,T} = lists:split(Index - 1, List), H ++ [Elem] ++ T. %% TODO: safe_map and cut_improper_tail can be combined into one generic list- %% recursing function, with 3 function arguments: apply_to_proper_elems, %% apply_to_improper_tail, combine -spec safe_map(fun((T) -> S), maybe_improper_list(T,T | [])) -> maybe_improper_list(S,S | []). safe_map(Fun, List) -> safe_map_tr(Fun, List, []). -spec safe_map_tr(fun((T) -> S), maybe_improper_list(T,T | []) | T, [S]) -> maybe_improper_list(S,S | []). safe_map_tr(_Fun, [], AccList) -> lists:reverse(AccList); safe_map_tr(Fun, [Head | Tail], AccList) -> safe_map_tr(Fun, Tail, [Fun(Head) | AccList]); safe_map_tr(Fun, ImproperTail, AccList) -> lists:reverse(AccList, Fun(ImproperTail)). -spec safe_foldl(fun((T,A) -> A), A, maybe_improper_list(T,T | [])) -> A. safe_foldl(_Fun, Acc, []) -> Acc; safe_foldl(Fun, Acc, [X | Rest]) -> safe_foldl(Fun, Fun(X,Acc), Rest); safe_foldl(Fun, Acc, ImproperTail) -> Fun(ImproperTail, Acc). -spec safe_any(fun((T) -> boolean()), maybe_improper_list(T,T | [])) -> boolean(). safe_any(_Pred, []) -> false; safe_any(Pred, [X | Rest]) -> Pred(X) orelse safe_any(Pred, Rest); safe_any(Pred, ImproperTail) -> Pred(ImproperTail). -spec safe_zip([T], [S]) -> [{T,S}]. safe_zip(Xs, Ys) -> safe_zip_tr(Xs, Ys, []). -spec safe_zip_tr([T], [S], [{T,S}]) -> [{T,S}]. safe_zip_tr([], _Ys, Acc) -> lists:reverse(Acc); safe_zip_tr(_Xs, [], Acc) -> lists:reverse(Acc); safe_zip_tr([X|Xtail], [Y|YTail], Acc) -> safe_zip_tr(Xtail, YTail, [{X,Y}|Acc]). -spec tuple_map(fun((T) -> S), loose_tuple(T)) -> loose_tuple(S). tuple_map(Fun, Tuple) -> list_to_tuple(lists:map(Fun, tuple_to_list(Tuple))). -spec cut_improper_tail(maybe_improper_list(T,T | [])) -> [T] | {[T],T}. cut_improper_tail(List) -> cut_improper_tail_tr(List, []). -spec cut_improper_tail_tr(maybe_improper_list(T,T | []) | T, [T]) -> [T] | {[T],T}. cut_improper_tail_tr([], AccList) -> lists:reverse(AccList); cut_improper_tail_tr([Head | Tail], AccList) -> cut_improper_tail_tr(Tail, [Head | AccList]); cut_improper_tail_tr(ImproperTail, AccList) -> {lists:reverse(AccList), ImproperTail}. -spec head_length(nonempty_improper_list(term(),term())) -> pos_integer(). head_length(List) -> head_length_tr(List, 0). -spec head_length_tr(nonempty_improper_list(term(),term()) | term(), non_neg_integer()) -> pos_integer(). head_length_tr([_Head | Tail], Len) -> head_length_tr(Tail, Len + 1); head_length_tr(_ImproperTail, Len) -> Len. -spec find_first(fun((T) -> boolean()), [T]) -> {position(),T} | 'none'. find_first(Pred, List) -> find_first_tr(Pred, List, 1). -spec find_first_tr(fun((T) -> boolean()), [T], position()) -> {position(),T} | 'none'. find_first_tr(_Pred, [], _Pos) -> none; find_first_tr(Pred, [X | Rest], Pos) -> case Pred(X) of true -> {Pos, X}; false -> find_first_tr(Pred, Rest, Pos + 1) end. -spec filter(fun((T) -> boolean()), [T]) -> {[T],[position()]}. filter(Pred, List) -> {Trues,TrueLookup,_Falses,_FalseLookup} = partition(Pred, List), {Trues, TrueLookup}. -spec partition(fun((T) -> boolean()), [T]) -> {[T],[position()],[T],[position()]}. partition(Pred, List) -> partition_tr(Pred, List, 1, [], [], [], []). -spec partition_tr(fun((T) -> boolean()), [T], position(), [T], [position()], [T], [position()]) -> {[T],[position()],[T],[position()]}. partition_tr(_Pred, [], _Pos, Trues, TrueLookup, Falses, FalseLookup) -> {lists:reverse(Trues), lists:reverse(TrueLookup), lists:reverse(Falses), lists:reverse(FalseLookup)}; partition_tr(Pred, [X | Rest], Pos, Trues, TrueLookup, Falses, FalseLookup) -> case Pred(X) of true -> partition_tr(Pred, Rest, Pos + 1, [X | Trues], [Pos | TrueLookup], Falses, FalseLookup); false -> partition_tr(Pred, Rest, Pos + 1, Trues, TrueLookup, [X | Falses], [Pos | FalseLookup]) end. -spec remove([T], [position()]) -> [T]. remove(Xs, Positions) -> remove_tr(Xs, Positions, 1, []). -spec remove_tr([T], [position()], position(), [T]) -> [T]. remove_tr(Xs, [], _Pos, Acc) -> lists:reverse(Acc, Xs); remove_tr([_X | XsTail], [Pos | PosTail], Pos, Acc) -> remove_tr(XsTail, PosTail, Pos + 1, Acc); remove_tr([X | XsTail], Positions, Pos, Acc) -> remove_tr(XsTail, Positions, Pos + 1, [X | Acc]). -spec insert([T], [position()], [T]) -> [T]. insert(Xs, Positions, Ys) -> insert_tr(Xs, Positions, Ys, 1, []). -spec insert_tr([T], [position()], [T], position(), [T]) -> [T]. insert_tr([], [], Ys, _Pos, Acc) -> lists:reverse(Acc, Ys); insert_tr([X | XsTail], [Pos | PosTail], Ys, Pos, Acc) -> insert_tr(XsTail, PosTail, Ys, Pos + 1, [X | Acc]); insert_tr(Xs, Positions, [Y | YsTail], Pos, Acc) -> insert_tr(Xs, Positions, YsTail, Pos + 1, [Y | Acc]). -spec unflatten([T], [length()]) -> [[T]]. unflatten(List, Lens) -> {[],RevSubLists} = lists:foldl(fun remove_n/2, {List,[]}, Lens), lists:reverse(RevSubLists). -spec remove_n(non_neg_integer(), {[T],[[T]]}) -> {[T],[[T]]}. remove_n(N, {List,Acc}) -> {Front,Back} = lists:split(N, List), {Back, [Front | Acc]}. %%----------------------------------------------------------------------------- %% Random functions %%----------------------------------------------------------------------------- %% @doc Seeds the random number generator. This function should be run before %% calling any random function from this module. -spec rand_start(seed()) -> 'ok'. rand_start(Seed) -> _ = ?RANDOM_MOD:seed(Seed), %% TODO: read option for RNG bijections here ok. %% @doc Conditionally seeds the random number generator. This function should be run before %% calling any random function from this module. -spec rand_restart(seed()) -> 'ok'. rand_restart(Seed) -> case get(?SEED_NAME) of undefined -> rand_start(Seed); _ -> ok end. -spec rand_reseed() -> 'ok'. rand_reseed() -> %% TODO: This should use the pid of the process somehow, in case two %% spawned functions call it simultaneously? _ = ?RANDOM_MOD:seed(os:timestamp()), ok. -spec rand_stop() -> 'ok'. rand_stop() -> erase(?SEED_NAME), ok. -spec rand_int(non_neg_integer()) -> integer(). rand_int(Const) -> round(rand_float(Const)). -spec rand_non_neg_int(non_neg_integer()) -> non_neg_integer(). rand_non_neg_int(Const) -> trunc(rand_non_neg_float(Const)). -spec bounded_rand_non_neg_int(non_neg_integer(), non_neg_integer()) -> non_neg_integer(). bounded_rand_non_neg_int(Const, Lim) when is_integer(Lim), Lim >= 0 -> X = rand_non_neg_int(Const), case X > Lim of true -> bounded_rand_non_neg_int(Const, Lim); false -> X end. -spec rand_int(integer(), integer()) -> integer(). rand_int(Low, High) when is_integer(Low), is_integer(High), Low =< High -> Low + ?RANDOM_MOD:uniform(High - Low + 1) - 1. %% When the range is large, skew the distribution to be more like that of an %% unbounded random integer. -spec smart_rand_int(non_neg_integer(), integer(), integer()) -> integer(). smart_rand_int(Const, Low, High) -> case High - Low =< ?SMALL_RANGE_THRESHOLD of true -> rand_int(Low, High); false -> wide_range_rand_int(Const, Low, High) end. -spec wide_range_rand_int(non_neg_integer(), integer(), integer()) -> integer(). wide_range_rand_int(Const, Low, High) when Low >= 0 -> Low + bounded_rand_non_neg_int(Const, High - Low); wide_range_rand_int(Const, Low, High) when High =< 0 -> High - bounded_rand_non_neg_int(Const, High - Low); wide_range_rand_int(Const, Low, High) -> case ?RANDOM_MOD:uniform(2) of 1 -> smart_rand_int(Const, 0, High); 2 -> smart_rand_int(Const, Low, 0) end. -spec rand_float(non_neg_integer()) -> float(). rand_float(Const) -> X = rand_non_neg_float(Const), case ?RANDOM_MOD:uniform(2) of 1 -> X; 2 -> -X end. -spec rand_non_neg_float(non_neg_integer()) -> float(). rand_non_neg_float(Const) when is_integer(Const), Const >= 0 -> case ?RANDOM_MOD:uniform() of 1.0 -> rand_non_neg_float(Const); X -> Const * zero_one_to_zero_inf(X) end. -spec rand_float(float(), float()) -> float(). rand_float(Low, High) when is_float(Low), is_float(High), Low =< High -> Low + ?RANDOM_MOD:uniform() * (High - Low). -spec zero_one_to_zero_inf(float()) -> float(). %% This function must return only non-negative values and map 0.0 to 0.0, but %% may be undefined at 1.0. %% TODO: read global options and decide here which bijection to use zero_one_to_zero_inf(X) -> X / math:sqrt(1 - X*X). -spec distribute(non_neg_integer(), non_neg_integer()) -> [non_neg_integer()]. distribute(_Credits, 0) -> []; distribute(Credits, People) -> jumble(distribute_tr(Credits, People, [])). -spec distribute_tr(non_neg_integer(), pos_integer(), [non_neg_integer()]) -> [non_neg_integer()]. distribute_tr(0, PeopleLeft, AccList) -> lists:duplicate(PeopleLeft, 0) ++ AccList; distribute_tr(CreditsLeft, 1, AccList) -> [CreditsLeft | AccList]; distribute_tr(CreditsLeft, PeopleLeft, AccList) -> YourCut = rand_int(0, CreditsLeft), distribute_tr(CreditsLeft - YourCut, PeopleLeft - 1, [YourCut | AccList]). -spec jumble([T]) -> [T]. %% @doc Produces a random permutation of a list. jumble(List) -> jumble_tr(List, length(List), []). -spec jumble_tr([T], non_neg_integer(), [T]) -> [T]. jumble_tr([], 0, Acc) -> Acc; jumble_tr(List, Len, Acc) -> Pos = rand_int(0, Len - 1), {List1, [H|List2]} = lists:split(Pos, List), jumble_tr(List1 ++ List2, Len - 1, [H|Acc]). -spec rand_choose([T,...]) -> {position(),T}. rand_choose(Choices) when Choices =/= [] -> Pos = rand_int(1, length(Choices)), {Pos, lists:nth(Pos, Choices)}. -spec freq_choose([{frequency(),T},...]) -> {position(),T}. freq_choose(Choices) when Choices =/= [] -> AddFreq = fun({Freq,_},Acc) -> Freq + Acc end, SumFreq = lists:foldl(AddFreq, 0, Choices), freq_select(rand_int(1, SumFreq), Choices, 1). -spec freq_select(frequency(), [{frequency(),T}], position()) -> {position(),T}. freq_select(N, [{Freq,Choice} | Rest], Pos) -> case N =< Freq of true -> {Pos,Choice}; false -> freq_select(N - Freq, Rest, Pos + 1) end. erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_array.erl000066400000000000000000000122241255446327200233160ustar00rootroot00000000000000%%% Copyright 2010-2015 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2015 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc Parametric wrapper to array module. %%% @private -module(proper_array). -export([new/0, new/1, new/2, is_array/1, set/3, get/2, size/1, sparse_size/1, default/1, reset/2, to_list/1, sparse_to_list/1, from_list/1, from_list/2, to_orddict/1, sparse_to_orddict/1, from_orddict/1, from_orddict/2, map/2, sparse_map/2, foldl/3, foldr/3, sparse_foldl/3, sparse_foldr/3, fix/1, relax/1, is_fix/1, resize/1, resize/2]). -export_type([array/1]). %% This header is included for the ifdef below and so that the %% strip_types parse transform will be applied to this file as well. -include("proper_internal.hrl"). -ifdef(NO_MODULES_IN_OPAQUES). %% When parsed by the typeserver, this becomes opaque (it's declared as a simple %% type because dialyzer can't handle parametric opaque types yet). -type array(_T) :: array(). -else. -opaque array(T) :: array:array(T). -endif. -type array_size() :: non_neg_integer(). -type array_indx() :: non_neg_integer(). -type indx_pairs(T) :: proper_orddict:orddict(array_indx(),T). -type array_opt(T) :: 'fixed' | array_size() | {'default', T} | {'fixed', boolean()} | {'size', array_size()}. -type array_opts(T) :: array_opt(T) | [array_opt(T)]. %%------------------------------------------------------------------------------ %% API functions %%------------------------------------------------------------------------------ -spec new() -> array(_T). new() -> array:new(). -spec new(array_opts(T)) -> array(T). new(Opts) -> array:new(Opts). -spec new(array_size(), array_opts(T)) -> array(T). new(Size, Opts) -> array:new(Size, Opts). -spec is_array(term()) -> boolean(). is_array(X) -> array:is_array(X). -spec size(array(_T)) -> array_size(). size(Array) -> array:size(Array). -spec default(array(T)) -> T. default(Array) -> array:default(Array). -spec fix(array(T)) -> array(T). fix(Array) -> array:fix(Array). -spec is_fix(array(_T)) -> boolean(). is_fix(Array) -> array:is_fix(Array). -spec relax(array(T)) -> array(T). relax(Array) -> array:relax(Array). -spec resize(array_size(), array(T)) -> array(T). resize(Size, Array) -> array:resize(Size, Array). -spec resize(array(T)) -> array(T). resize(Array) -> array:resize(Array). -spec set(array_indx(), T, array(T)) -> array(T). set(Index, Value, Array) -> array:set(Index, Value, Array). -spec get(array_indx(), array(T)) -> T. get(Index, Array) -> array:get(Index, Array). -spec reset(array_indx(), array(T)) -> array(T). reset(Index, Array) -> array:reset(Index, Array). -spec to_list(array(T)) -> [T]. to_list(Array) -> array:to_list(Array). -spec sparse_to_list(array(T)) -> [T]. sparse_to_list(Array) -> array:sparse_to_list(Array). -spec from_list([T]) -> array(T). from_list(List) -> array:from_list(List). -spec from_list([T], T) -> array(T). from_list(List, Default) -> array:from_list(List, Default). -spec to_orddict(array(T)) -> indx_pairs(T). to_orddict(Array) -> array:to_orddict(Array). -spec sparse_to_orddict(array(T)) -> indx_pairs(T). sparse_to_orddict(Array) -> array:sparse_to_orddict(Array). -spec from_orddict(indx_pairs(T)) -> array(T). from_orddict(Dict) -> array:from_orddict(Dict). -spec from_orddict(indx_pairs(T), T) -> array(T). from_orddict(Dict, Default) -> array:from_orddict(Dict, Default). -spec map(fun((array_indx(),T1) -> T2), array(T1)) -> array(T2). map(Fun, Array) -> array:map(Fun, Array). -spec sparse_map(fun((array_indx(),T1) -> T2), array(T1)) -> array(T2). sparse_map(Fun, Array) -> array:sparse_map(Fun, Array). -spec foldl(fun((array_indx(),T,A) -> A), A, array(T)) -> A. foldl(Fun, Acc0, Array) -> array:foldl(Fun, Acc0, Array). -spec sparse_foldl(fun((array_indx(),T,A) -> A), A, array(T)) -> A. sparse_foldl(Fun, Acc0, Array) -> array:sparse_foldl(Fun, Acc0, Array). -spec foldr(fun((array_indx(),T,A) -> A), A, array(T)) -> A. foldr(Fun, Acc0, Array) -> array:foldr(Fun, Acc0, Array). -spec sparse_foldr(fun((array_indx(),T,A) -> A), A, array(T)) -> A. sparse_foldr(Fun, Acc0, Array) -> array:sparse_foldr(Fun, Acc0, Array). -spec sparse_size(array(_T)) -> array_size(). sparse_size(Array) -> array:sparse_size(Array). erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_dict.erl000066400000000000000000000130771255446327200231320ustar00rootroot00000000000000%%% Copyright 2010-2015 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2015 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc Parametric wrapper to dict module. %%% @private -module(proper_dict). -export([new/0,is_key/2,to_list/1,from_list/1,size/1]). -export([fetch/2,find/2,fetch_keys/1,erase/2]). -export([store/3,append/3,append_list/3,update/3,update/4,update_counter/3]). -export([fold/3,map/2,filter/2,merge/3]). -export_type([dict/2]). %% This header is included for the ifdef below and so that the %% strip_types parse transform will be applied to this file as well. -include("proper_internal.hrl"). %% This would normally contain the internal representation of the ADT. %% This representation won't actually be used, so we could just use a dummy one. %% As with specs, unbound type variables are not allowed in '-type' declarations %% unless they begin with an underscore. -ifdef(NO_MODULES_IN_OPAQUES). %% When parsed by the typeserver, this becomes opaque (it's declared as a simple %% type because dialyzer can't handle parametric opaque types yet). -type dict(_K,_V) :: dict(). -else. -opaque dict(K,V) :: dict:dict(K,V). -endif. %% Here are some valid symbolic calls that could be automatically produced using %% this module's exported functions, for the type dict(atom(),integer()): %% * {'$call',proper_dict,store,[aa,12,{'$call',proper_dict,new,[]}]} %% * {'$call',proper_dict,filter,[Fun,{'$call',proper_dict,from_list, %% [[{a,1},{b,2}]]}]} %% * {'$call',proper_dict,merge,[Fun, %% {'$call',proper_dict,from_list,[[]]}, %% {'$call',proper_dict,update, %% [aa,Fun,3,{'$call',proper_dict,new,[]}]}]} %% Notice that PropEr will never produce a call like this one: %% {'$call',proper_dict,update,[aa,Fun,{'$call',proper_dict,new,[]}]} %% which would raise an exception if we tried to evaluate it. %%------------------------------------------------------------------------------ %% API functions %%------------------------------------------------------------------------------ -spec new() -> dict(_K,_V). new() -> dict:new(). -spec is_key(K, dict(K,_V)) -> boolean(). is_key(Key, Dict) -> dict:is_key(Key, Dict). -spec to_list(dict(K,V)) -> [{K,V}]. to_list(Dict) -> dict:to_list(Dict). -spec from_list([{K,V}]) -> dict(K,V). from_list(List) -> dict:from_list(List). -spec size(dict(_K,_V)) -> non_neg_integer(). size(Dict) -> dict:size(Dict). -spec fetch(K, dict(K,V)) -> V. fetch(Key, Dict) -> dict:fetch(Key, Dict). -spec find(K, dict(K,V)) -> {'ok', V} | 'error'. find(Key, Dict) -> dict:find(Key, Dict). -spec fetch_keys(dict(K,_V)) -> [K]. fetch_keys(Dict) -> dict:fetch_keys(Dict). -spec erase(K, dict(K,V)) -> dict(K,V). erase(Key, Dict) -> dict:erase(Key, Dict). -spec store(K, V, dict(K,V)) -> dict(K,V). store(Key, Value, Dict) -> dict:store(Key, Value, Dict). %% NOTE: This is currently unacceptable - only simple variables can be used as %% ADT parameters. %% TODO: This is too restricting: the other values in the dictionary can be %% arbitrary, we only care that the one being appended to is a list. -spec append(K, V, dict(K,[V])) -> dict(K,[V]). append(Key, Value, Dict) -> dict:append(Key, Value, Dict). %% NOTE: This is currently unacceptable - only simple variables can be used as %% ADT parameters. %% TODO: This is too restricting: the other values in the dictionary can be %% arbitrary, we only care that the one being appended to is a list. -spec append_list(K, [V], dict(K,[V])) -> dict(K,[V]). append_list(Key, Values, Dict) -> dict:append_list(Key, Values, Dict). -spec update(K, fun((V) -> V), dict(K,V)) -> dict(K,V). update(Key, Fun, Dict) -> dict:update(Key, Fun, Dict). -spec update(K, fun((V) -> V), V, dict(K,V)) -> dict(K,V). update(Key, Fun, InitVal, Dict) -> dict:update(Key, Fun, InitVal, Dict). %% NOTE: This is currently unacceptable - only simple variables can be used as %% ADT parameters. %% TODO: This is too restricting: the other values in the dictionary can be %% arbitrary, we only care that the one being updated is a number. -spec update_counter(K, number(), dict(K,number())) -> dict(K,number()). update_counter(Key, Number, Dict) -> dict:update_counter(Key, Number, Dict). -spec fold(fun((K,V,A) -> A), A, dict(K,V)) -> A. fold(Fun, Acc0, Dict) -> dict:fold(Fun, Acc0, Dict). -spec map(fun((K,V1) -> V2), dict(K,V1)) -> dict(K,V2). map(Fun, Dict) -> dict:map(Fun, Dict). -spec filter(fun((K,V) -> boolean()), dict(K,V)) -> dict(K,V). filter(Fun, Dict) -> dict:filter(Fun, Dict). -spec merge(fun((K,V,V) -> V), dict(K,V), dict(K,V)) -> dict(K,V). merge(Fun, Dict1, Dict2) -> dict:merge(Fun, Dict1, Dict2). erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_fsm.erl000066400000000000000000000421721255446327200227720ustar00rootroot00000000000000%%% Copyright 2010-2013 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Eirini Arvaniti %%% @doc This module defines the `proper_fsm' behaviour, useful for testing %%% systems that can be modeled as finite state machines. That is, a finite %%% collection of named states and transitions between them. `{@module}' is %%% closely related to {@link proper_statem} and is, in fact, implemented in %%% terms of that. Testcases generated using `{@module}' will be on precisely %%% the same form as testcases generated using {@link proper_statem}. The %%% difference lies in the way the callback modules are specified. %%% The relation between {@link proper_statem} and `{@module}' is similar %%% to the one between `gen_server' and `gen_fsm' in OTP libraries. %%% %%% Due to name conflicts with functions automatically imported from %%% {@link proper_statem}, a fully qualified call is needed in order to %%% use the API functions of `{@module}'. %%% %%% === The states of the finite state machine === %%% Following the convention used in `gen_fsm behaviour', the state is %%% separated into a `StateName::'{@type state_name()} and some %%% `StateData::'{@type state_data()}. `StateName' is used to denote a state %%% of the finite state machine and `StateData' is any relevant information %%% that has to be stored in the model state. States are fully %%% represented as tuples `{StateName, StateData}'. %%% %%% `StateName' is usually an atom (i.e. the name of the state), but can also %%% be a tuple. In the latter case, the first element of the tuple must be an %%% atom specifying the name of the state, whereas the rest of the elements can %%% be arbitrary terms specifying state attributes. For example, when %%% implementing the fsm of an elevator which can reach N different floors, the %%% `StateName' for each floor could be `{floor,K}, 1 <= K <= N'.
%%% `StateData' can be an arbitrary term, but is usually a record. %%% %%% === Transitions between states === %%% A transition ({@type transition()}) is represented as a tuple %%% `{TargetState, {call,M,F,A}}'. This means that performing the specified %%% symbolic call at the current state of the fsm will lead to `TargetState'. %%% The atom `history' can be used as `TargetState' to denote that a transition %%% does not change the current state of the fsm. %%% %%% === The callback functions === %%% The following functions must be exported from the callback module %%% implementing the finite state machine: %%%
    %%%
  • `initial_state() ::' {@type state_name()} %%%

    Specifies the initial state of the finite state machine. As with %%% `proper_statem:initial_state/0', its result should be deterministic. %%%

  • %%%
  • `initial_state_data() ::' {@type state_data()} %%%

    Specifies what the state data should initially contain. Its result %%% should be deterministic

  • %%%
  • `StateName(S::'{@type state_data()}`) ::' %%% `['{@type transition()}`]' %%%

    There should be one instance of this function for each reachable %%% state `StateName' of the finite state machine. In case `StateName' is a %%% tuple the function takes a different form, described just below. The %%% function returns a list of possible transitions ({@type transition()}) %%% from the current state. %%% At command generation time, the instance of this function with the same %%% name as the current state's name is called to return the list of possible %%% transitions. Then, PropEr will randomly choose a transition and, %%% according to that, generate the next symbolic call to be included in the %%% command sequence. However, before the call is actually included, a %%% precondition that might impose constraints on `StateData' is checked.
    %%% Note also that PropEr detects transitions that would raise an exception %%% of class `' at generation time (not earlier) and does not choose %%% them. This feature can be used to include conditional transitions that %%% depend on the `StateData'.

  • %%%
  • `StateName(Attr1::term(), ..., AttrN::term(), %%% S::'{@type state_data()}`) ::' %%% `['{@type transition()}`]' %%%

    There should be one instance of this function for each reachable state %%% `{StateName,Attr1,...,AttrN}' of the finite state machine. The function %%% has similar beaviour to `StateName/1', described above.

  • %%%
  • `weight(From::'{@type state_name()}`, %%% Target::'{@type state_name()}`, %%% Call::'{@type symb_call()}`) :: integer()' %%%

    This is an optional callback. When it is not defined (or not exported), %%% transitions are chosen with equal probability. When it is defined, it %%% assigns an integer weight to transitions from `From' to `Target' %%% triggered by symbolic call `Call'. In this case, each transition is chosen %%% with probability proportional to the weight assigned.

  • %%%
  • `precondition(From::'{@type state_name()}`, %%% Target::'{@type state_name()}`, %%% StateData::'{@type state_data()}`, %%% Call::'{@type symb_call()}`) :: boolean()' %%%

    Similar to `proper_statem:precondition/2'. Specifies the %%% precondition that should hold about `StateData' so that `Call' can be %%% included in the command sequence. In case precondition doesn't hold, a %%% new transition is chosen using the appropriate `StateName/1' generator. %%% It is possible for more than one transitions to be triggered by the same %%% symbolic call and lead to different target states. In this case, at most %%% one of the target states may have a true precondition. Otherwise, PropEr %%% will not be able to detect which transition was chosen and an exception %%% will be raised.

  • %%%
  • `postcondition(From::'{@type state_name()}`, %%% Target::'{@type state_name()}`, %%% StateData::'{@type state_data()}`, %%% Call::'{@type symb_call()}`, %%% Res::'{@type result()}`) :: boolean()' %%%

    Similar to `proper_statem:postcondition/3'. Specifies the %%% postcondition that should hold about the result `Res' of the evaluation %%% of `Call'.

  • %%%
  • `next_state_data(From::'{@type state_name()}`, %%% Target::'{@type state_name()}`, %%% StateData::'{@type state_data()}`, %%% Res::'{@type result()}`, %%% Call::'{@type symb_call()}`) ::' %%% {@type state_data()} %%%

    Similar to `proper_statem:next_state/3'. Specifies how the %%% transition from `FromState' to `Target' triggered by `Call' affects the %%% `StateData'. `Res' refers to the result of `Call' and can be either %%% symbolic or dynamic.

  • %%%
%%% %%% === The property used === %%% This is an example of a property that can be used to test a %%% finite state machine specification: %%% %%% ```prop_fsm() -> %%% ?FORALL(Cmds, proper_fsm:commands(?MODULE), %%% begin %%% {_History, _State, Result} = proper_fsm:run_commands(?MODULE, Cmds), %%% cleanup(), %%% Result =:= ok %%% end).''' %%% @end -module(proper_fsm). -export([behaviour_info/1]). -export([commands/1, commands/2, run_commands/2, run_commands/3, state_names/1]). -export([command/1, precondition/2, next_state/3, postcondition/3]). -export([target_states/4]). -include("proper_internal.hrl"). %% ----------------------------------------------------------------------------- %% Type declarations %% ----------------------------------------------------------------------------- -type symb_var() :: proper_statem:symb_var(). -type symb_call() :: proper_statem:symb_call(). -type fsm_result() :: proper_statem:statem_result(). -type state_name() :: atom() | tuple(). %% @type state_data() -type state_data() :: term(). -type fsm_state() :: {state_name(),state_data()}. -type transition() :: {state_name(),symb_call()}. -type command() :: {'set',symb_var(),symb_call()} | {'init',fsm_state()}. -type command_list() :: [command()]. %% @type cmd_result() -type cmd_result() :: term(). -type history() :: [{fsm_state(),cmd_result()}]. -type tmp_command() :: {'init',state()} | {'set',symb_var(),symb_call()}. -record(state, {name :: state_name(), data :: state_data(), mod :: mod_name()}). -type state() :: #state{}. %% ----------------------------------------------------------------------------- %% Proper_fsm behaviour %% ---------------------------------------------------------------------------- %% @doc Specifies the callback functions that should be exported from a module %% implementing the `proper_fsm' behaviour. -spec behaviour_info('callbacks') -> [{fun_name(),arity()}]. behaviour_info(callbacks) -> [{initial_state,0}, {initial_state_data,0}, {precondition,4}, {postcondition,5}, {next_state_data,5}]; behaviour_info(_Attribute) -> undefined. %% ----------------------------------------------------------------------------- %% API %% ----------------------------------------------------------------------------- %% @doc A special PropEr type which generates random command sequences, %% according to a finite state machine specification. The function takes as %% input the name of a callback module, which contains the fsm specification. %% The initial state is computed by
%% `{Mod:initial_state/0, Mod:initial_state_data/0}'. -spec commands(mod_name()) -> proper_types:type(). commands(Mod) -> ?LET([_|Cmds], proper_statem:commands(?MODULE, initial_state(Mod)), Cmds). %% @doc Similar to {@link commands/1}, but generated command sequences always %% start at a given state. In this case, the first command is always
%% `{init, InitialState = {Name,Data}}' and is used to correctly initialize the %% state every time the command sequence is run (i.e. during normal execution, %% while shrinking and when checking a counterexample). -spec commands(mod_name(), fsm_state()) -> proper_types:type(). commands(Mod, {Name,Data} = InitialState) -> State = #state{name = Name, data = Data, mod = Mod}, ?LET([_|Cmds], proper_statem:commands(?MODULE, State), [{init,InitialState}|Cmds]). %% @doc Evaluates a given symbolic command sequence `Cmds' according to the %% finite state machine specified in `Mod'. The result is a triple of the %% form
`{History, FsmState, Result}', similar to %% {@link proper_statem:run_commands/2}. -spec run_commands(mod_name(), command_list()) -> {history(),fsm_state(),fsm_result()}. run_commands(Mod, Cmds) -> run_commands(Mod, Cmds, []). %% @doc Similar to {@link run_commands/2}, but also accepts an environment %% used for symbolic variable evaluation, exactly as described in %% {@link proper_statem:run_commands/3}. -spec run_commands(mod_name(), command_list(), proper_symb:var_values()) -> {history(),fsm_state(),fsm_result()}. run_commands(Mod, Cmds, Env) -> Cmds1 = tmp_commands(Mod, Cmds), {H,S,Res} = proper_statem:run_commands(?MODULE, Cmds1, Env), History = [{{Name,Data},R} || {#state{name = Name, data = Data},R} <- H], State = {S#state.name, S#state.data}, {History, State, Res}. %% @doc Extracts the names of the states from a given command execution history. %% It is useful in combination with functions such as {@link proper:aggregate/2} %% in order to collect statistics about state transitions during command %% execution. -spec state_names(history()) -> [state_name()]. state_names(History) -> [SName || {{SName,_},_Res} <- History]. %% ----------------------------------------------------------------------------- %% Proper_statem bahaviour callback functions %% ----------------------------------------------------------------------------- -spec initial_state(mod_name()) -> state(). initial_state(Mod) -> S_name = Mod:initial_state(), S_data = Mod:initial_state_data(), #state{name = S_name, data = S_data, mod = Mod}. %% @private -spec command(state()) -> proper_types:type(). command(#state{name = From, data = Data, mod = Mod}) -> choose_transition(Mod, From, get_transitions(Mod, From, Data)). %% @private -spec precondition(state(), symb_call()) -> boolean(). precondition(#state{name = From, data = Data, mod = Mod}, Call) -> Targets = target_states(Mod, From, Data, Call), case [To || To <- Targets, Mod:precondition(From, cook_history(From, To), Data, Call)] of [] -> false; [_T] -> true; _ -> io:format( "\nError: The transition from \"~w\" state triggered by ~w " "call leads to multiple target states.\nUse the precondition/5 " "callback to specify which target state should be chosen.\n", [From, get_mfa(Call)]), erlang:error(too_many_targets) end. %% @private -spec next_state(state(), symb_var() | cmd_result(), symb_call()) -> state(). next_state(S = #state{name = From, data = Data, mod = Mod} , Var, Call) -> To = cook_history(From, transition_target(Mod, From, Data, Call)), S#state{name = To, data = Mod:next_state_data(From, To, Data, Var, Call)}. %% @private -spec postcondition(state(), symb_call(), cmd_result()) -> boolean(). postcondition(#state{name = From, data = Data, mod = Mod}, Call, Res) -> To = cook_history(From, transition_target(Mod, From, Data, Call)), Mod:postcondition(From, To, Data, Call, Res). %% ----------------------------------------------------------------------------- %% Utility functions %% ----------------------------------------------------------------------------- -spec tmp_commands(mod_name(), command_list()) -> [tmp_command()]. tmp_commands(Mod, Cmds) -> case Cmds of [{init, {Name,Data}}|Rest] -> I = #state{name = Name, data = Data, mod = Mod}, [{init,I}|Rest]; Rest -> I = initial_state(Mod), [{init,I}|Rest] end. -spec get_transitions(mod_name(), state_name(), state_data()) -> [transition()]. get_transitions(Mod, StateName, Data) -> case StateName of From when is_atom(From) -> Mod:From(Data); From when is_tuple(From) -> Fun = element(1, From), Args = tl(tuple_to_list(From)), apply(Mod, Fun, Args ++ [Data]) end. -spec choose_transition(mod_name(), state_name(), [transition()]) -> proper_types:type(). choose_transition(Mod, From, T_list) -> case is_exported(Mod, {weight,3}) of false -> choose_uniform_transition(T_list); true -> choose_weighted_transition(Mod, From, T_list) end. -spec choose_uniform_transition([transition()]) -> proper_types:type(). choose_uniform_transition(T_list) -> List = [CallGen || {_,CallGen} <- T_list], proper_types:safe_union(List). -spec choose_weighted_transition(mod_name(), state_name(), [transition()]) -> proper_types:type(). choose_weighted_transition(Mod, From, T_list) -> List = [{Mod:weight(From, cook_history(From, To), CallGen), CallGen} || {To,CallGen} <- T_list], proper_types:safe_weighted_union(List). -spec cook_history(state_name(), state_name()) -> state_name(). cook_history(From, history) -> From; cook_history(_, To) -> To. -spec is_exported(mod_name(), {fun_name(),arity()}) -> boolean(). is_exported(Mod, Fun) -> lists:member(Fun, Mod:module_info(exports)). -spec transition_target(mod_name(), state_name(), state_data(), symb_call()) -> state_name(). transition_target(Mod, From, Data, Call) -> Targets = target_states(Mod, From, Data, Call), [To] = [T || T <- Targets, Mod:precondition(From, cook_history(From, T), Data, Call)], To. %% @private -spec target_states(mod_name(), state_name(), state_data(), symb_call()) -> [state_name()]. target_states(Mod, From, StateData, Call) -> find_target(get_transitions(Mod, From, StateData), Call, []). -spec find_target([transition()], symb_call(), [state_name()]) -> [state_name()]. find_target([], _, Accum) -> Accum; find_target(Transitions, Call, Accum) -> [{Target,CallGen}|Rest] = Transitions, case is_compatible(Call, CallGen) of true -> find_target(Rest, Call, [Target|Accum]); false -> find_target(Rest, Call, Accum) end. -spec is_compatible(symb_call(), symb_call()) -> boolean(). is_compatible({call,M,F,A1}, {call,M,F,A2}) when length(A1) =:= length(A2) -> true; is_compatible(_, _) -> false. -spec get_mfa(symb_call()) -> mfa(). get_mfa({call,M,F,A}) -> {M,F,length(A)}. erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_gb_sets.erl000066400000000000000000000124771255446327200236400ustar00rootroot00000000000000%%% Copyright 2010-2015 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2015 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc Parametric wrapper to gb_sets module. %%% @private -module(proper_gb_sets). -export([empty/0, is_empty/1, size/1, singleton/1, is_member/2, insert/2, add/2, delete/2, delete_any/2, balance/1, union/2, union/1, intersection/2, intersection/1, is_disjoint/2, difference/2, is_subset/2, to_list/1, from_list/1, from_ordset/1, smallest/1, largest/1, take_smallest/1, take_largest/1, iterator/1, next/1, filter/2, fold/3, is_set/1]). -export([new/0, is_element/2, add_element/2, del_element/2, subtract/2]). -export_type([gb_set/1, iterator/1]). %% This header is included for the ifdef below and so that the %% strip_types parse transform will be applied to this file as well. -include("proper_internal.hrl"). -ifdef(NO_MODULES_IN_OPAQUES). %% When parsed by the typeserver, this becomes opaque (it's declared as a simple %% type because dialyzer can't handle parametric opaque types yet). -type gb_set(_T) :: gb_set(). -else. -opaque gb_set(T) :: gb_sets:set(T). -endif. %% Based on the documentation alone, this is the best we can do. -type iterator(_T) :: term(). %%------------------------------------------------------------------------------ %% API functions %%------------------------------------------------------------------------------ -spec empty() -> gb_set(_T). empty() -> gb_sets:empty(). -spec new() -> gb_set(_T). new() -> gb_sets:new(). -spec is_empty(gb_set(_T)) -> boolean(). is_empty(Set) -> gb_sets:is_empty(Set). -spec size(gb_set(_T)) -> non_neg_integer(). size(Set) -> gb_sets:size(Set). -spec singleton(T) -> gb_set(T). singleton(X) -> gb_sets:singleton(X). -spec is_element(T, gb_set(T)) -> boolean(). is_element(X, Set) -> gb_sets:is_element(X, Set). -spec is_member(T, gb_set(T)) -> boolean(). is_member(X, Set) -> gb_sets:is_member(X, Set). -spec insert(T, gb_set(T)) -> gb_set(T). insert(X, Set) -> gb_sets:insert(X, Set). -spec balance(gb_set(T)) -> gb_set(T). balance(Set) -> gb_sets:balance(Set). -spec add_element(T, gb_set(T)) -> gb_set(T). add_element(X, Set) -> gb_sets:add_element(X, Set). -spec add(T, gb_set(T)) -> gb_set(T). add(X, Set) -> gb_sets:add(X, Set). -spec from_list([T]) -> gb_set(T). from_list(List) -> gb_sets:from_list(List). -spec from_ordset(proper_ordsets:ordset(T)) -> gb_set(T). from_ordset(Set) -> gb_sets:from_ordset(Set). -spec del_element(T, gb_set(T)) -> gb_set(T). del_element(X, Set) -> gb_sets:del_element(X, Set). -spec delete_any(T, gb_set(T)) -> gb_set(T). delete_any(X, Set) -> gb_sets:delete_any(X, Set). -spec delete(T, gb_set(T)) -> gb_set(T). delete(X, Set) -> gb_sets:delete(X, Set). -spec take_smallest(gb_set(T)) -> {T, gb_set(T)}. take_smallest(Set) -> gb_sets:take_smallest(Set). -spec smallest(gb_set(T)) -> T. smallest(Set) -> gb_sets:smallest(Set). -spec take_largest(gb_set(T)) -> {T, gb_set(T)}. take_largest(Set) -> gb_sets:take_largest(Set). -spec largest(gb_set(T)) -> T. largest(Set) -> gb_sets:largest(Set). -spec to_list(gb_set(T)) -> [T]. to_list(Set) -> gb_sets:to_list(Set). -spec iterator(gb_set(T)) -> iterator(T). iterator(Set) -> gb_sets:iterator(Set). -spec next(iterator(T)) -> {T, iterator(T)} | 'none'. next(Iter) -> gb_sets:next(Iter). -spec union(gb_set(T), gb_set(T)) -> gb_set(T). union(Set1, Set2) -> gb_sets:union(Set1, Set2). -spec union([gb_set(T)]) -> gb_set(T). union(Sets) -> gb_sets:union(Sets). -spec intersection(gb_set(T), gb_set(T)) -> gb_set(T). intersection(Set1, Set2) -> gb_sets:intersection(Set1, Set2). -spec intersection([gb_set(T),...]) -> gb_set(T). intersection(Sets) -> gb_sets:intersection(Sets). -spec is_disjoint(gb_set(T), gb_set(T)) -> boolean(). is_disjoint(Set1, Set2) -> gb_sets:is_disjoint(Set1, Set2). -spec subtract(gb_set(T), gb_set(T)) -> gb_set(T). subtract(Set1, Set2) -> gb_sets:subtract(Set1, Set2). -spec difference(gb_set(T), gb_set(T)) -> gb_set(T). difference(Set1, Set2) -> gb_sets:difference(Set1, Set2). -spec is_subset(gb_set(T), gb_set(T)) -> boolean(). is_subset(Set1, Set2) -> gb_sets:is_subset(Set1, Set2). -spec is_set(term()) -> boolean(). is_set(X) -> gb_sets:is_set(X). -spec filter(fun((T) -> boolean()), gb_set(T)) -> gb_set(T). filter(Pred, Set) -> gb_sets:filter(Pred, Set). -spec fold(fun((T,A) -> A), A, gb_set(T)) -> A. fold(Fun, Acc0, Set) -> gb_sets:fold(Fun, Acc0, Set). erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_gb_trees.erl000066400000000000000000000104601255446327200237720ustar00rootroot00000000000000%%% Copyright 2010-2015 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2015 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc Parametric wrapper to gb_trees module. %%% @private -module(proper_gb_trees). -export([empty/0, is_empty/1, size/1, lookup/2, get/2, insert/3, update/3, enter/3, delete/2, delete_any/2, balance/1, is_defined/2, keys/1, values/1, to_list/1, from_orddict/1, smallest/1, largest/1, take_smallest/1, take_largest/1, iterator/1, next/1, map/2]). -export_type([gb_tree/2, iterator/2]). %% This header is included for the ifdef below and so that the %% strip_types parse transform will be applied to this file as well. -include("proper_internal.hrl"). -ifdef(NO_MODULES_IN_OPAQUES). %% When parsed by the typeserver, this becomes opaque (it's declared as a simple %% type because dialyzer can't handle parametric opaque types yet). -type gb_tree(_K,_V) :: gb_tree(). -else. -opaque gb_tree(K,V) :: gb_trees:tree(K,V). -endif. %% Based on the documentation alone, this is the best we can do. -type iterator(_K,_V) :: term(). %%------------------------------------------------------------------------------ %% API functions %%------------------------------------------------------------------------------ -spec empty() -> gb_tree(_K,_V). empty() -> gb_trees:empty(). -spec is_empty(gb_tree(_K,_V)) -> boolean(). is_empty(Tree) -> gb_trees:is_empty(Tree). -spec size(gb_tree(_K,_V)) -> non_neg_integer(). size(Tree) -> gb_trees:size(Tree). -spec lookup(K, gb_tree(K,V)) -> 'none' | {'value', V}. lookup(Key, Tree) -> gb_trees:lookup(Key, Tree). -spec is_defined(K, gb_tree(K,_V)) -> boolean(). is_defined(Key, Tree) -> gb_trees:is_defined(Key, Tree). -spec get(K, gb_tree(K,V)) -> V. get(Key, Tree) -> gb_trees:get(Key, Tree). -spec update(K, V, gb_tree(K,V)) -> gb_tree(K,V). update(Key, Value, Tree) -> gb_trees:update(Key, Value, Tree). -spec insert(K, V, gb_tree(K,V)) -> gb_tree(K,V). insert(Key, Value, Tree) -> gb_trees:insert(Key, Value, Tree). -spec enter(K, V, gb_tree(K,V)) -> gb_tree(K,V). enter(Key, Value, Tree) -> gb_trees:enter(Key, Value, Tree). -spec balance(gb_tree(K,V)) -> gb_tree(K,V). balance(Tree) -> gb_trees:balance(Tree). -spec from_orddict(proper_orddict:orddict(K,V)) -> gb_tree(K,V). from_orddict(Dict) -> gb_trees:from_orddict(Dict). -spec delete_any(K, gb_tree(K,V)) -> gb_tree(K,V). delete_any(Key, Tree) -> gb_trees:delete_any(Key, Tree). -spec delete(K, gb_tree(K,V)) -> gb_tree(K,V). delete(Key, Tree) -> gb_trees:delete(Key, Tree). -spec take_smallest(gb_tree(K,V)) -> {K, V, gb_tree(K,V)}. take_smallest(Tree) -> gb_trees:take_smallest(Tree). -spec smallest(gb_tree(K,V)) -> {K, V}. smallest(Tree) -> gb_trees:smallest(Tree). -spec take_largest(gb_tree(K,V)) -> {K, V, gb_tree(K,V)}. take_largest(Tree) -> gb_trees:take_largest(Tree). -spec largest(gb_tree(K,V)) -> {K, V}. largest(Tree) -> gb_trees:largest(Tree). -spec to_list(gb_tree(K,V)) -> [{K, V}]. to_list(Tree) -> gb_trees:to_list(Tree). -spec keys(gb_tree(K,_V)) -> [K]. keys(Tree) -> gb_trees:keys(Tree). -spec values(gb_tree(_K,V)) -> [V]. values(Tree) -> gb_trees:values(Tree). -spec iterator(gb_tree(K,V)) -> iterator(K,V). iterator(Tree) -> gb_trees:iterator(Tree). -spec next(iterator(K,V)) -> 'none' | {K, V, iterator(K,V)}. next(Iter) -> gb_trees:next(Iter). -spec map(fun((K,V1) -> V2), gb_tree(K,V1)) -> gb_tree(K,V2). map(Fun, Tree) -> gb_trees:map(Fun, Tree). erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_gen.erl000066400000000000000000000507411255446327200227570ustar00rootroot00000000000000%%% Copyright 2010-2015 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2015 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc Generator subsystem and generators for basic types. %%% %%% You can use these functions to try out the random %%% instance generation and shrinking subsystems. %%% %%% CAUTION: These functions should never be used inside properties. They are %%% meant for demonstration purposes only. -module(proper_gen). -export([pick/1, pick/2, pick/3, sample/1, sample/3, sampleshrink/1, sampleshrink/2]). -export([safe_generate/1]). -export([generate/1, normal_gen/1, alt_gens/1, clean_instance/1, get_ret_type/1]). -export([integer_gen/3, float_gen/3, atom_gen/1, atom_rev/1, binary_gen/1, binary_rev/1, binary_len_gen/1, bitstring_gen/1, bitstring_rev/1, bitstring_len_gen/1, list_gen/2, distlist_gen/3, vector_gen/2, union_gen/1, weighted_union_gen/1, tuple_gen/1, loose_tuple_gen/2, loose_tuple_rev/2, exactly_gen/1, fixed_list_gen/1, function_gen/2, any_gen/1, native_type_gen/2, safe_weighted_union_gen/1, safe_union_gen/1]). -export_type([instance/0, imm_instance/0, sized_generator/0, nosize_generator/0, generator/0, reverse_gen/0, combine_fun/0, alt_gens/0]). -include("proper_internal.hrl"). -compile({parse_transform, vararg}). %%----------------------------------------------------------------------------- %% Types %%----------------------------------------------------------------------------- %% TODO: update imm_instance() when adding more types: be careful when reading %% anything that returns it %% @private_type -type imm_instance() :: proper_types:raw_type() | instance() | {'$used', imm_instance(), imm_instance()} | {'$to_part', imm_instance()}. -type instance() :: term(). %% A value produced by the random instance generator. -type error_reason() :: 'arity_limit' | 'cant_generate' | {'typeserver',term()}. %% @private_type -type sized_generator() :: fun((size()) -> imm_instance()). %% @private_type -type typed_sized_generator() :: {'typed', fun((proper_types:type(),size()) -> imm_instance())}. %% @private_type -type nosize_generator() :: fun(() -> imm_instance()). %% @private_type -type typed_nosize_generator() :: {'typed', fun((proper_types:type()) -> imm_instance())}. %% @private_type -type generator() :: sized_generator() | typed_sized_generator() | nosize_generator() | typed_nosize_generator(). %% @private_type -type plain_reverse_gen() :: fun((instance()) -> imm_instance()). %% @private_type -type typed_reverse_gen() :: {'typed', fun((proper_types:type(),instance()) -> imm_instance())}. %% @private_type -type reverse_gen() :: plain_reverse_gen() | typed_reverse_gen(). %% @private_type -type combine_fun() :: fun((instance()) -> imm_instance()). %% @private_type -type alt_gens() :: fun(() -> [imm_instance()]). %% @private_type -type fun_seed() :: {non_neg_integer(),non_neg_integer()}. %%----------------------------------------------------------------------------- %% Instance generation functions %%----------------------------------------------------------------------------- %% @private -spec safe_generate(proper_types:raw_type()) -> {'ok',imm_instance()} | {'error',error_reason()}. safe_generate(RawType) -> try generate(RawType) of ImmInstance -> {ok, ImmInstance} catch throw:'$arity_limit' -> {error, arity_limit}; throw:'$cant_generate' -> {error, cant_generate}; throw:{'$typeserver',SubReason} -> {error, {typeserver,SubReason}} end. %% @private -spec generate(proper_types:raw_type()) -> imm_instance(). generate(RawType) -> Type = proper_types:cook_outer(RawType), ok = add_parameters(Type), Instance = generate(Type, get('$constraint_tries'), none), ok = remove_parameters(Type), Instance. -spec add_parameters(proper_types:type()) -> 'ok'. add_parameters(Type) -> case proper_types:find_prop(parameters, Type) of {ok, Params} -> OldParams = erlang:get('$parameters'), case OldParams of undefined -> erlang:put('$parameters', Params); _ -> erlang:put('$parameters', Params ++ OldParams) end, ok; _ -> ok end. -spec remove_parameters(proper_types:type()) -> 'ok'. remove_parameters(Type) -> case proper_types:find_prop(parameters, Type) of {ok, Params} -> AllParams = erlang:get('$parameters'), case AllParams of Params-> erlang:erase('$parameters'); _ -> erlang:put('$parameters', AllParams -- Params) end, ok; _ -> ok end. -spec generate(proper_types:type(), non_neg_integer(), 'none' | {'ok',imm_instance()}) -> imm_instance(). generate(_Type, 0, none) -> throw('$cant_generate'); generate(_Type, 0, {ok,Fallback}) -> Fallback; generate(Type, TriesLeft, Fallback) -> ImmInstance = case proper_types:get_prop(kind, Type) of constructed -> PartsType = proper_types:get_prop(parts_type, Type), Combine = proper_types:get_prop(combine, Type), ImmParts = generate(PartsType), Parts = clean_instance(ImmParts), ImmInstance1 = Combine(Parts), %% TODO: We can just generate the internal type: if it's not %% a type, it will turn into an exactly. ImmInstance2 = case proper_types:is_raw_type(ImmInstance1) of true -> generate(ImmInstance1); false -> ImmInstance1 end, {'$used',ImmParts,ImmInstance2}; _ -> ImmInstance1 = normal_gen(Type), case proper_types:is_raw_type(ImmInstance1) of true -> generate(ImmInstance1); false -> ImmInstance1 end end, case proper_types:satisfies_all(clean_instance(ImmInstance), Type) of {_,true} -> ImmInstance; {true,false} -> generate(Type, TriesLeft - 1, {ok,ImmInstance}); {false,false} -> generate(Type, TriesLeft - 1, Fallback) end. %% @equiv pick(Type, 10) -spec pick(Type::proper_types:raw_type()) -> {'ok',instance()} | 'error'. pick(RawType) -> pick(RawType, 10). %% @equiv pick(Type, Size, os:timestamp()) -spec pick(Type::proper_types:raw_type(), size()) -> {'ok',instance()} | 'error'. pick(RawType, Size) -> pick(RawType, Size, os:timestamp()). %% @doc Generates a random instance of `Type', of size `Size' with seed `Seed'. -spec pick(Type::proper_types:raw_type(), size(), seed()) -> {'ok',instance()} | 'error'. pick(RawType, Size, Seed) -> proper:global_state_init_size_seed(Size, Seed), case clean_instance(safe_generate(RawType)) of {ok,Instance} = Result -> Msg = "WARNING: Some garbage has been left in the process registry " "and the code server~n" "to allow for the returned function(s) to run normally.~n" "Please run proper:global_state_erase() when done.~n", case contains_fun(Instance) of true -> io:format(Msg, []); false -> proper:global_state_erase() end, Result; {error,Reason} -> proper:report_error(Reason, fun io:format/2), proper:global_state_erase(), error end. %% @equiv sample(Type, 10, 20) -spec sample(Type::proper_types:raw_type()) -> 'ok'. sample(RawType) -> sample(RawType, 10, 20). %% @doc Generates and prints one random instance of `Type' for each size from %% `StartSize' up to `EndSize'. -spec sample(Type::proper_types:raw_type(), size(), size()) -> 'ok'. sample(RawType, StartSize, EndSize) when StartSize =< EndSize -> Tests = EndSize - StartSize + 1, Prop = ?FORALL(X, RawType, begin io:format("~p~n",[X]), true end), Opts = [quiet,{start_size,StartSize},{max_size,EndSize},{numtests,Tests}], _ = proper:quickcheck(Prop, Opts), ok. %% @equiv sampleshrink(Type, 10) -spec sampleshrink(Type::proper_types:raw_type()) -> 'ok'. sampleshrink(RawType) -> sampleshrink(RawType, 10). %% @doc Generates a random instance of `Type', of size `Size', then shrinks it %% as far as it goes. The value produced on each step of the shrinking process %% is printed on the screen. -spec sampleshrink(Type::proper_types:raw_type(), size()) -> 'ok'. sampleshrink(RawType, Size) -> proper:global_state_init_size(Size), Type = proper_types:cook_outer(RawType), case safe_generate(Type) of {ok,ImmInstance} -> Shrunk = keep_shrinking(ImmInstance, [], Type), PrintInst = fun(I) -> io:format("~p~n",[clean_instance(I)]) end, lists:foreach(PrintInst, Shrunk); {error,Reason} -> proper:report_error(Reason, fun io:format/2) end, proper:global_state_erase(), ok. -spec keep_shrinking(imm_instance(), [imm_instance()], proper_types:type()) -> [imm_instance(),...]. keep_shrinking(ImmInstance, Acc, Type) -> case proper_shrink:shrink(ImmInstance, Type, init) of {[], _NewState} -> lists:reverse([ImmInstance|Acc]); {[Shrunk|_Rest], _NewState} -> keep_shrinking(Shrunk, [ImmInstance|Acc], Type) end. -spec contains_fun(term()) -> boolean(). contains_fun(List) when is_list(List) -> proper_arith:safe_any(fun contains_fun/1, List); contains_fun(Tuple) when is_tuple(Tuple) -> contains_fun(tuple_to_list(Tuple)); contains_fun(Fun) when is_function(Fun) -> true; contains_fun(_Term) -> false. %%----------------------------------------------------------------------------- %% Utility functions %%----------------------------------------------------------------------------- %% @private -spec normal_gen(proper_types:type()) -> imm_instance(). normal_gen(Type) -> case proper_types:get_prop(generator, Type) of {typed, Gen} -> if is_function(Gen, 1) -> Gen(Type); is_function(Gen, 2) -> Gen(Type, proper:get_size(Type)) end; Gen -> if is_function(Gen, 0) -> Gen(); is_function(Gen, 1) -> Gen(proper:get_size(Type)) end end. %% @private -spec alt_gens(proper_types:type()) -> [imm_instance()]. alt_gens(Type) -> case proper_types:find_prop(alt_gens, Type) of {ok, AltGens} -> ?FORCE(AltGens); error -> [] end. %% @private -spec clean_instance(imm_instance()) -> instance(). clean_instance({'$used',_ImmParts,ImmInstance}) -> clean_instance(ImmInstance); clean_instance({'$to_part',ImmInstance}) -> clean_instance(ImmInstance); clean_instance(ImmInstance) -> if is_list(ImmInstance) -> %% CAUTION: this must handle improper lists proper_arith:safe_map(fun clean_instance/1, ImmInstance); is_tuple(ImmInstance) -> proper_arith:tuple_map(fun clean_instance/1, ImmInstance); true -> ImmInstance end. %%----------------------------------------------------------------------------- %% Basic type generators %%----------------------------------------------------------------------------- %% @private -spec integer_gen(size(), proper_types:extint(), proper_types:extint()) -> integer(). integer_gen(Size, inf, inf) -> proper_arith:rand_int(Size); integer_gen(Size, inf, High) -> High - proper_arith:rand_non_neg_int(Size); integer_gen(Size, Low, inf) -> Low + proper_arith:rand_non_neg_int(Size); integer_gen(Size, Low, High) -> proper_arith:smart_rand_int(Size, Low, High). %% @private -spec float_gen(size(), proper_types:extnum(), proper_types:extnum()) -> float(). float_gen(Size, inf, inf) -> proper_arith:rand_float(Size); float_gen(Size, inf, High) -> High - proper_arith:rand_non_neg_float(Size); float_gen(Size, Low, inf) -> Low + proper_arith:rand_non_neg_float(Size); float_gen(_Size, Low, High) -> proper_arith:rand_float(Low, High). %% @private -spec atom_gen(size()) -> proper_types:type(). %% We make sure we never clash with internal atoms by checking that the first %% character is not '$'. atom_gen(Size) -> ?LET(Str, ?SUCHTHAT(X, proper_types:resize(Size, proper_types:list(proper_types:byte())), X =:= [] orelse hd(X) =/= $$), list_to_atom(Str)). %% @private -spec atom_rev(atom()) -> imm_instance(). atom_rev(Atom) -> {'$used', atom_to_list(Atom), Atom}. %% @private -spec binary_gen(size()) -> proper_types:type(). binary_gen(Size) -> ?LET(Bytes, proper_types:resize(Size, proper_types:list(proper_types:byte())), list_to_binary(Bytes)). %% @private -spec binary_rev(binary()) -> imm_instance(). binary_rev(Binary) -> {'$used', binary_to_list(Binary), Binary}. %% @private -spec binary_len_gen(length()) -> proper_types:type(). binary_len_gen(Len) -> ?LET(Bytes, proper_types:vector(Len, proper_types:byte()), list_to_binary(Bytes)). %% @private -spec bitstring_gen(size()) -> proper_types:type(). bitstring_gen(Size) -> ?LET({BytesHead, NumBits, TailByte}, {proper_types:resize(Size,proper_types:binary()), proper_types:range(0,7), proper_types:range(0,127)}, <>). %% @private -spec bitstring_rev(bitstring()) -> imm_instance(). bitstring_rev(BitString) -> List = bitstring_to_list(BitString), {BytesList, BitsTail} = lists:splitwith(fun erlang:is_integer/1, List), {NumBits, TailByte} = case BitsTail of [] -> {0, 0}; [Bits] -> N = bit_size(Bits), <> = Bits, {N, Byte} end, {'$used', {{'$used',BytesList,list_to_binary(BytesList)}, NumBits, TailByte}, BitString}. %% @private -spec bitstring_len_gen(length()) -> proper_types:type(). bitstring_len_gen(Len) -> BytesLen = Len div 8, BitsLen = Len rem 8, ?LET({BytesHead, NumBits, TailByte}, {proper_types:binary(BytesLen), BitsLen, proper_types:range(0, 1 bsl BitsLen - 1)}, <>). %% @private -spec list_gen(size(), proper_types:type()) -> [imm_instance()]. list_gen(Size, ElemType) -> Len = proper_arith:rand_int(0, Size), vector_gen(Len, ElemType). %% @private -spec distlist_gen(size(), sized_generator(), boolean()) -> [imm_instance()]. distlist_gen(RawSize, Gen, NonEmpty) -> Len = case NonEmpty of true -> proper_arith:rand_int(1, erlang:max(1,RawSize)); false -> proper_arith:rand_int(0, RawSize) end, Size = case Len of 1 -> RawSize - 1; _ -> RawSize end, %% TODO: this produces a lot of types: maybe a simple 'div' is sufficient? Sizes = proper_arith:distribute(Size, Len), InnerTypes = [Gen(S) || S <- Sizes], fixed_list_gen(InnerTypes). %% @private -spec vector_gen(length(), proper_types:type()) -> [imm_instance()]. vector_gen(Len, ElemType) -> vector_gen_tr(Len, ElemType, []). -spec vector_gen_tr(length(), proper_types:type(), [imm_instance()]) -> [imm_instance()]. vector_gen_tr(0, _ElemType, AccList) -> AccList; vector_gen_tr(Left, ElemType, AccList) -> vector_gen_tr(Left - 1, ElemType, [generate(ElemType) | AccList]). %% @private -spec union_gen([proper_types:type(),...]) -> imm_instance(). union_gen(Choices) -> {_Choice,Type} = proper_arith:rand_choose(Choices), generate(Type). %% @private -spec weighted_union_gen([{frequency(),proper_types:type()},...]) -> imm_instance(). weighted_union_gen(FreqChoices) -> {_Choice,Type} = proper_arith:freq_choose(FreqChoices), generate(Type). %% @private -spec safe_union_gen([proper_types:type(),...]) -> imm_instance(). safe_union_gen(Choices) -> {Choice,Type} = proper_arith:rand_choose(Choices), try generate(Type) catch error:_ -> safe_union_gen(proper_arith:list_remove(Choice, Choices)) end. %% @private -spec safe_weighted_union_gen([{frequency(),proper_types:type()},...]) -> imm_instance(). safe_weighted_union_gen(FreqChoices) -> {Choice,Type} = proper_arith:freq_choose(FreqChoices), try generate(Type) catch error:_ -> safe_weighted_union_gen(proper_arith:list_remove(Choice, FreqChoices)) end. %% @private -spec tuple_gen([proper_types:type()]) -> tuple(). tuple_gen(Fields) -> list_to_tuple(fixed_list_gen(Fields)). %% @private -spec loose_tuple_gen(size(), proper_types:type()) -> proper_types:type(). loose_tuple_gen(Size, ElemType) -> ?LET(L, proper_types:resize(Size, proper_types:list(ElemType)), list_to_tuple(L)). %% @private -spec loose_tuple_rev(tuple(), proper_types:type()) -> imm_instance(). loose_tuple_rev(Tuple, ElemType) -> CleanList = tuple_to_list(Tuple), List = case proper_types:find_prop(reverse_gen, ElemType) of {ok,{typed, ReverseGen}} -> [ReverseGen(ElemType,X) || X <- CleanList]; {ok,ReverseGen} -> [ReverseGen(X) || X <- CleanList]; error -> CleanList end, {'$used', List, Tuple}. %% @private -spec exactly_gen(T) -> T. exactly_gen(X) -> X. %% @private -spec fixed_list_gen([proper_types:type()]) -> imm_instance() ; ({[proper_types:type()],proper_types:type()}) -> maybe_improper_list(imm_instance(), imm_instance() | []). fixed_list_gen({ProperHead,ImproperTail}) -> [generate(F) || F <- ProperHead] ++ generate(ImproperTail); fixed_list_gen(ProperFields) -> [generate(F) || F <- ProperFields]. %% @private -spec function_gen(arity(), proper_types:type()) -> function(). function_gen(Arity, RetType) -> FunSeed = {proper_arith:rand_int(0, ?SEED_RANGE - 1), proper_arith:rand_int(0, ?SEED_RANGE - 1)}, create_fun(Arity, RetType, FunSeed). %% @private -spec any_gen(size()) -> imm_instance(). any_gen(Size) -> case get('$any_type') of undefined -> real_any_gen(Size); {type,AnyType} -> generate(proper_types:resize(Size, AnyType)) end. -spec real_any_gen(size()) -> imm_instance(). real_any_gen(0) -> SimpleTypes = [proper_types:integer(), proper_types:float(), proper_types:atom()], union_gen(SimpleTypes); real_any_gen(Size) -> FreqChoices = [{?ANY_SIMPLE_PROB,simple}, {?ANY_BINARY_PROB,binary}, {?ANY_EXPAND_PROB,expand}], case proper_arith:freq_choose(FreqChoices) of {_,simple} -> real_any_gen(0); {_,binary} -> generate(proper_types:resize(Size, proper_types:bitstring())); {_,expand} -> %% TODO: statistics of produced terms? NumElems = proper_arith:rand_int(0, Size - 1), ElemSizes = proper_arith:distribute(Size - 1, NumElems), ElemTypes = [?LAZY(real_any_gen(S)) || S <- ElemSizes], case proper_arith:rand_int(1,2) of 1 -> fixed_list_gen(ElemTypes); 2 -> tuple_gen(ElemTypes) end end. %% @private -spec native_type_gen(mod_name(), string()) -> proper_types:type(). native_type_gen(Mod, TypeStr) -> case proper_typeserver:translate_type({Mod,TypeStr}) of {ok,Type} -> Type; {error,Reason} -> throw({'$typeserver',Reason}) end. %%------------------------------------------------------------------------------ %% Function-generation functions %%------------------------------------------------------------------------------ -spec create_fun(arity(), proper_types:type(), fun_seed()) -> function(). create_fun(Arity, RetType, FunSeed) -> Handler = fun(Args) -> function_body(Args, RetType, FunSeed) end, Err = fun() -> throw('$arity_limit') end, 'MAKE_FUN'(Arity, Handler, Err). %% @private -spec get_ret_type(function()) -> proper_types:type(). get_ret_type(Fun) -> {arity,Arity} = erlang:fun_info(Fun, arity), put('$get_ret_type', true), RetType = apply(Fun, lists:duplicate(Arity,dummy)), erase('$get_ret_type'), RetType. -spec function_body([term()], proper_types:type(), fun_seed()) -> proper_types:type() | instance(). function_body(Args, RetType, {Seed1,Seed2}) -> case get('$get_ret_type') of true -> RetType; _ -> SavedSeed = get(?SEED_NAME), update_seed({Seed1,Seed2,erlang:phash2(Args,?SEED_RANGE)}), Ret = clean_instance(generate(RetType)), put(?SEED_NAME, SavedSeed), proper_symb:internal_eval(Ret) end. -ifdef(USE_SFMT). update_seed(Seed) -> sfmt:seed(Seed). -else. update_seed(Seed) -> put(random_seed, Seed). -endif. erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_orddict.erl000066400000000000000000000077141255446327200236400ustar00rootroot00000000000000%%% Copyright 2010-2013 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc Parametric wrapper to orddict module. %%% @private -module(proper_orddict). -export([new/0,is_key/2,to_list/1,from_list/1,size/1]). -export([fetch/2,find/2,fetch_keys/1,erase/2]). -export([store/3,append/3,append_list/3,update/3,update/4,update_counter/3]). -export([fold/3,map/2,filter/2,merge/3]). -export_type([orddict/2]). %% When parsed by the typeserver, this becomes opaque (it's declared as a simple %% type because dialyzer can't handle parametric opaque types yet). -type orddict(K,V) :: [{K,V}]. %% This header is only included so that the strip_types parse transform will be %% applied to this file as well. -include("proper_internal.hrl"). %%------------------------------------------------------------------------------ %% API functions %%------------------------------------------------------------------------------ -spec new() -> orddict(_K,_V). new() -> orddict:new(). -spec is_key(K, orddict(K,_V)) -> boolean(). is_key(Key, Dict) -> orddict:is_key(Key, Dict). -spec to_list(orddict(K,V)) -> [{K,V}]. to_list(Dict) -> orddict:to_list(Dict). -spec from_list([{K,V}]) -> orddict(K,V). from_list(List) -> orddict:from_list(List). -spec size(orddict(_K,_V)) -> non_neg_integer(). size(Dict) -> orddict:size(Dict). -spec fetch(K, orddict(K,V)) -> V. fetch(Key, Dict) -> orddict:fetch(Key, Dict). -spec find(K, orddict(K,V)) -> {'ok', V} | 'error'. find(Key, Dict) -> orddict:find(Key, Dict). -spec fetch_keys(orddict(K,_V)) -> [K]. fetch_keys(Dict) -> orddict:fetch_keys(Dict). -spec erase(K, orddict(K,V)) -> orddict(K,V). erase(Key, Dict) -> orddict:erase(Key, Dict). -spec store(K, V, orddict(K,V)) -> orddict(K,V). store(Key, Value, Dict) -> orddict:store(Key, Value, Dict). %% TODO: This is too restricting. -spec append(K, V, orddict(K,[V])) -> orddict(K,[V]). append(Key, Value, Dict) -> orddict:append(Key, Value, Dict). %% TODO: This is too restricting. -spec append_list(K, [V], orddict(K,[V])) -> orddict(K,[V]). append_list(Key, Values, Dict) -> orddict:append_list(Key, Values, Dict). -spec update(K, fun((V) -> V), orddict(K,V)) -> orddict(K,V). update(Key, Fun, Dict) -> orddict:update(Key, Fun, Dict). -spec update(K, fun((V) -> V), V, orddict(K,V)) -> orddict(K,V). update(Key, Fun, InitVal, Dict) -> orddict:update(Key, Fun, InitVal, Dict). %% TODO: This is too restricting. -spec update_counter(K, number(), orddict(K,number())) -> orddict(K,number()). update_counter(Key, Incr, Dict) -> orddict:update_counter(Key, Incr, Dict). -spec fold(fun((K,V,A) -> A), A, orddict(K,V)) -> A. fold(Fun, Acc0, Dict) -> orddict:fold(Fun, Acc0, Dict). -spec map(fun((K,V1) -> V2), orddict(K,V1)) -> orddict(K,V2). map(Fun, Dict) -> orddict:map(Fun, Dict). -spec filter(fun((K,V) -> boolean()), orddict(K,V)) -> orddict(K,V). filter(Pred, Dict) -> orddict:filter(Pred, Dict). -spec merge(fun((K,V,V) -> V), orddict(K,V), orddict(K,V)) -> orddict(K,V). merge(Fun, Dict1, Dict2) -> orddict:merge(Fun, Dict1, Dict2). erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_ordsets.erl000066400000000000000000000066761255446327200237010ustar00rootroot00000000000000%%% Copyright 2010-2013 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc Parametric wrapper to ordsets module. %%% @private -module(proper_ordsets). -export([new/0,is_set/1,size/1,to_list/1,from_list/1]). -export([is_element/2,add_element/2,del_element/2]). -export([union/2,union/1,intersection/2,intersection/1]). -export([is_disjoint/2]). -export([subtract/2,is_subset/2]). -export([fold/3,filter/2]). -export_type([ordset/1]). %% When parsed by the typeserver, this becomes opaque (it's declared as a %% simple type because dialyzer can't handle parametric opaque types yet). -type ordset(T) :: [T]. %% This header is only included so that the strip_types parse transform will be %% applied to this file as well. -include("proper_internal.hrl"). %%----------------------------------------------------------------------------- %% API functions %%----------------------------------------------------------------------------- -spec new() -> ordset(_T). new() -> ordsets:new(). -spec is_set(term()) -> boolean(). is_set(X) -> ordsets:is_set(X). -spec size(ordset(_T)) -> non_neg_integer(). size(Set) -> ordsets:size(Set). -spec to_list(ordset(T)) -> [T]. to_list(Set) -> ordsets:to_list(Set). -spec from_list([T]) -> ordset(T). from_list(List) -> ordsets:from_list(List). -spec is_element(T, ordset(T)) -> boolean(). is_element(X, Set) -> ordsets:is_element(X, Set). -spec add_element(T, ordset(T)) -> ordset(T). add_element(X, Set) -> ordsets:add_element(X, Set). -spec del_element(T, ordset(T)) -> ordset(T). del_element(X, Set) -> ordsets:del_element(X, Set). -spec union(ordset(T), ordset(T)) -> ordset(T). union(Set1, Set2) -> ordsets:union(Set1, Set2). -spec union([ordset(T)]) -> ordset(T). union(Sets) -> ordsets:union(Sets). -spec intersection(ordset(T), ordset(T)) -> ordset(T). intersection(Set1, Set2) -> ordsets:intersection(Set1, Set2). -spec intersection([ordset(T),...]) -> ordset(T). intersection(Sets) -> ordsets:intersection(Sets). -spec is_disjoint(ordset(T), ordset(T)) -> boolean(). is_disjoint(Set1, Set2) -> ordsets:is_disjoint(Set1, Set2). -spec subtract(ordset(T), ordset(T)) -> ordset(T). subtract(Set1, Set2) -> ordsets:subtract(Set1, Set2). -spec is_subset(ordset(T), ordset(T)) -> boolean(). is_subset(Set1, Set2) -> ordsets:is_subset(Set1, Set2). -spec fold(fun((T,S) -> S), S, ordset(T)) -> S. fold(Fun, Acc0, Set) -> ordsets:fold(Fun, Acc0, Set). -spec filter(fun((T) -> boolean()), ordset(T)) -> ordset(T). filter(Pred, Set) -> ordsets:filter(Pred, Set). erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_prop_remover.erl000066400000000000000000000121431255446327200247170ustar00rootroot00000000000000%%% Copyright 2010-2013 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc This module contains PropEr's helper parse transformer. It is %%% automatically applied to modules when compiled internally by the %%% typeserver. It essentially removes all functions that contain ?FORALLs, %%% to counter an obscure bug. %%% @private -module(proper_prop_remover). -export([parse_transform/2]). -export_type([]). -include("proper_internal.hrl"). %%------------------------------------------------------------------------------ %% Top-level functions %%------------------------------------------------------------------------------ -spec parse_transform([abs_form()], [compile:option()]) -> [abs_form()]. parse_transform(Forms, _Options) -> [Form || Form <- Forms, safe_form(Form)]. -spec safe_form(abs_form()) -> boolean(). safe_form({function,_Line,_Name,_Arity,Clauses}) -> lists:all(fun safe_clause/1, Clauses); safe_form(_Form) -> true. -spec safe_clause(abs_clause()) -> boolean(). safe_clause({clause,_Line,PatSeq,_Guards,Body}) -> lists:all(fun safe_expr/1, PatSeq) andalso lists:all(fun safe_expr/1, Body). %% This also covers some other constructs that don't clash with expressions: %% binary element specifications, list and binary comprehension generators and %% filters, remote function references. It also covers patterns. -spec safe_expr(abs_expr()) -> boolean(). safe_expr({match,_Line,Pattern,Expr}) -> safe_expr(Pattern) andalso safe_expr(Expr); safe_expr({tuple,_Line,FieldExprs}) -> lists:all(fun safe_expr/1, FieldExprs); safe_expr({cons,_Line,HeadExpr,TailExpr}) -> safe_expr(HeadExpr) andalso safe_expr(TailExpr); safe_expr({bin,_Line,BinElems}) -> lists:all(fun safe_expr/1, BinElems); safe_expr({bin_element,_Line,ValueExpr,_Size,_TSL}) -> safe_expr(ValueExpr); safe_expr({op,_Line,_Op,LeftExpr,RightExpr}) -> safe_expr(LeftExpr) andalso safe_expr(RightExpr); safe_expr({op,_Line,_Op,Expr}) -> safe_expr(Expr); safe_expr({record,_Line,_RecName,FieldInits}) -> lists:all(fun safe_field_init/1, FieldInits); safe_expr({record,_Line,RecExpr,_RecName,FieldInits}) -> safe_expr(RecExpr) andalso lists:all(fun safe_field_init/1, FieldInits); safe_expr({record_field,_Line,RecExpr,_RecName,_FieldName}) -> safe_expr(RecExpr); safe_expr({'catch',_Line,Expr}) -> safe_expr(Expr); safe_expr({call,_Line,FunRef,Args}) -> safe_expr(FunRef) andalso lists:all(fun safe_expr/1, Args); safe_expr({remote,_Line,{atom,_,proper},{atom,_,forall}}) -> false; safe_expr({remote,_Line,ModExpr,FunExpr}) -> safe_expr(ModExpr) andalso safe_expr(FunExpr); safe_expr({lc,_Line,Expr,GensAndFilters}) -> safe_expr(Expr) andalso lists:all(fun safe_expr/1, GensAndFilters); safe_expr({bc,_Line,Expr,GensAndFilters}) -> safe_expr(Expr) andalso lists:all(fun safe_expr/1, GensAndFilters); safe_expr({generate,_Line,Pattern,Expr}) -> safe_expr(Pattern) andalso safe_expr(Expr); safe_expr({b_generate,_Line,Pattern,Expr}) -> safe_expr(Pattern) andalso safe_expr(Expr); safe_expr({block,_Line,Body}) -> lists:all(fun safe_expr/1, Body); safe_expr({'if',_Line,Clauses}) -> lists:all(fun safe_clause/1, Clauses); safe_expr({'case',_Line,Expr,Clauses}) -> safe_expr(Expr) andalso lists:all(fun safe_clause/1, Clauses); safe_expr({'try',_Line,Body1,Clauses1,Clauses2,Body2}) -> lists:all(fun safe_expr/1, Body1) andalso lists:all(fun safe_clause/1, Clauses1) andalso lists:all(fun safe_clause/1, Clauses2) andalso lists:all(fun safe_expr/1, Body2); safe_expr({'receive',_Line,Clauses}) -> lists:all(fun safe_clause/1, Clauses); safe_expr({'receive',_Line,Clauses,AfterExpr,AfterBody}) -> lists:all(fun safe_clause/1, Clauses) andalso safe_expr(AfterExpr) andalso lists:all(fun safe_expr/1, AfterBody); safe_expr({'fun',_Line,{clauses,Clauses}}) -> lists:all(fun safe_clause/1, Clauses); safe_expr({'query',_Line,ListCompr}) -> safe_expr(ListCompr); safe_expr({record_field,_Line,Expr,_FieldName}) -> safe_expr(Expr); safe_expr(_Expr) -> true. -spec safe_field_init(abs_rec_field()) -> boolean(). safe_field_init({record_field,_Line,_FieldName}) -> true; safe_field_init({record_field,_Line,_FieldName,InitExpr}) -> safe_expr(InitExpr). erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_queue.erl000066400000000000000000000105211255446327200233220ustar00rootroot00000000000000%%% Copyright 2010-2015 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2015 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc Parametric wrapper to queue module. %%% @private -module(proper_queue). -export([new/0,is_queue/1,is_empty/1,len/1,to_list/1,from_list/1,member/2]). -export([in/2,in_r/2,out/1,out_r/1]). -export([get/1,get_r/1,peek/1,peek_r/1,drop/1,drop_r/1]). -export([reverse/1,join/2,split/2,filter/2]). -export([cons/2,head/1,tail/1,snoc/2,last/1,daeh/1,init/1,liat/1,lait/1]). -export_type([queue/1]). %% This header is included for the ifdef below and so that the %% strip_types parse transform will be applied to this file as well. -include("proper_internal.hrl"). -ifdef(NO_MODULES_IN_OPAQUES). %% When parsed by the typeserver, this becomes opaque (it's declared as a simple %% type because dialyzer can't handle parametric opaque types yet). -type queue(_T) :: queue(). -else. -opaque queue(T) :: queue:queue(T). -endif. %%------------------------------------------------------------------------------ %% API functions %%------------------------------------------------------------------------------ -spec new() -> queue(_T). new() -> queue:new(). -spec is_queue(term()) -> boolean(). is_queue(X) -> queue:is_queue(X). -spec is_empty(queue(_T)) -> boolean(). is_empty(Queue) -> queue:is_empty(Queue). -spec len(queue(_T)) -> non_neg_integer(). len(Queue) -> queue:len(Queue). -spec to_list(queue(T)) -> [T]. to_list(Queue) -> queue:to_list(Queue). -spec from_list([T]) -> queue(T). from_list(L) -> queue:from_list(L). -spec member(T, queue(T)) -> boolean(). member(X, Queue) -> queue:member(X, Queue). -spec in(T, queue(T)) -> queue(T). in(X, Queue) -> queue:in(X, Queue). -spec in_r(T, queue(T)) -> queue(T). in_r(X, Queue) -> queue:in_r(X, Queue). -spec out(queue(T)) -> {'empty' | {'value',T}, queue(T)}. out(Queue) -> queue:out(Queue). -spec out_r(queue(T)) -> {'empty' | {'value',T}, queue(T)}. out_r(Queue) -> queue:out_r(Queue). -spec get(queue(T)) -> T. get(Queue) -> queue:get(Queue). -spec get_r(queue(T)) -> T. get_r(Queue) -> queue:get_r(Queue). -spec peek(queue(T)) -> 'empty' | {'value',T}. peek(Queue) -> queue:peek(Queue). -spec peek_r(queue(T)) -> 'empty' | {'value',T}. peek_r(Queue) -> queue:peek_r(Queue). -spec drop(queue(T)) -> queue(T). drop(Queue) -> queue:drop(Queue). -spec drop_r(queue(T)) -> queue(T). drop_r(Queue) -> queue:drop_r(Queue). -spec reverse(queue(T)) -> queue(T). reverse(Queue) -> queue:reverse(Queue). -spec join(queue(T), queue(T)) -> queue(T). join(Queue1, Queue2) -> queue:join(Queue1, Queue2). -spec split(non_neg_integer(), queue(T)) -> {queue(T),queue(T)}. split(N, Queue) -> queue:split(N, Queue). -spec filter(fun((T) -> boolean() | [T]), queue(T)) -> queue(T). filter(Pred, Queue) -> queue:filter(Pred, Queue). -spec cons(T, queue(T)) -> queue(T). cons(X, Queue) -> queue:cons(X, Queue). -spec head(queue(T)) -> T. head(Queue) -> queue:head(Queue). -spec tail(queue(T)) -> queue(T). tail(Queue) -> queue:tail(Queue). -spec snoc(queue(T), T) -> queue(T). snoc(Queue, X) -> queue:snoc(Queue, X). -spec daeh(queue(T)) -> T. daeh(Queue) -> queue:daeh(Queue). -spec last(queue(T)) -> T. last(Queue) -> queue:last(Queue). -spec liat(queue(T)) -> queue(T). liat(Queue) -> queue:liat(Queue). -spec lait(queue(T)) -> queue(T). lait(Queue) -> queue:lait(Queue). -spec init(queue(T)) -> queue(T). init(Queue) -> queue:init(Queue). erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_sets.erl000066400000000000000000000065751255446327200231720ustar00rootroot00000000000000%%% Copyright 2010-2015 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2015 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc Parametric wrapper to sets module. %%% @private -module(proper_sets). -export([new/0,is_set/1,size/1,to_list/1,from_list/1]). -export([is_element/2,add_element/2,del_element/2]). -export([union/2,union/1,intersection/2,intersection/1]). -export([is_disjoint/2]). -export([subtract/2,is_subset/2]). -export([fold/3,filter/2]). -export_type([set/1]). %% This header is included for the ifdef below and so that the %% strip_types parse transform will be applied to this file as well. -include("proper_internal.hrl"). -ifdef(NO_MODULES_IN_OPAQUES). %% When parsed by the typeserver, this becomes opaque (it's declared as a simple %% type because dialyzer can't handle parametric opaque types yet). -type set(_T) :: set(). -else. -opaque set(T) :: sets:set(T). -endif. %%------------------------------------------------------------------------------ %% API functions %%------------------------------------------------------------------------------ -spec new() -> set(_T). new() -> sets:new(). -spec is_set(term()) -> boolean(). is_set(X) -> sets:is_set(X). -spec size(set(_T)) -> non_neg_integer(). size(Set) -> sets:size(Set). -spec to_list(set(T)) -> [T]. to_list(Set) -> sets:to_list(Set). -spec from_list([T]) -> set(T). from_list(L) -> sets:from_list(L). -spec is_element(T, set(T)) -> boolean(). is_element(X, Set) -> sets:is_element(X, Set). -spec add_element(T, set(T)) -> set(T). add_element(X, Set) -> sets:add_element(X, Set). -spec del_element(T, set(T)) -> set(T). del_element(X, Set) -> sets:del_element(X, Set). -spec union(set(T), set(T)) -> set(T). union(Set1, Set2) -> sets:union(Set1, Set2). -spec union([set(T)]) -> set(T). union(Sets) -> sets:union(Sets). -spec intersection(set(T), set(T)) -> set(T). intersection(Set1, Set2) -> sets:intersection(Set1, Set2). -spec intersection([set(T),...]) -> set(T). intersection(Sets) -> sets:intersection(Sets). -spec is_disjoint(set(T), set(T)) -> boolean(). is_disjoint(Set1, Set2) -> sets:is_disjoint(Set1, Set2). -spec subtract(set(T), set(T)) -> set(T). subtract(Set1, Set2) -> sets:subtract(Set1, Set2). -spec is_subset(set(T), set(T)) -> boolean(). is_subset(S1, S2) -> sets:is_subset(S1, S2). -spec fold(fun((T,A) -> A), A, set(T)) -> A. fold(Fun, Acc, Set) -> sets:fold(Fun, Acc, Set). -spec filter(fun((T) -> boolean()), set(T)) -> set(T). filter(Pred, Set) -> sets:filter(Pred, Set). erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_shrink.erl000066400000000000000000000477061255446327200235130ustar00rootroot00000000000000%%% Copyright 2010-2013 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc The shrinking subsystem and all predefined shrinkers are contained in %%% this module. %%% @private -module(proper_shrink). -export([shrink/3]). -export([number_shrinker/4, union_first_choice_shrinker/3, union_recursive_shrinker/3]). -export([split_shrinker/3, remove_shrinker/3]). -export_type([state/0, shrinker/0]). -include("proper_internal.hrl"). %%------------------------------------------------------------------------------ %% Types %%------------------------------------------------------------------------------ -type state() :: 'init' | 'done' | {'shrunk',position(),state()} | term(). -type shrinker() :: fun((proper_gen:imm_instance(), proper_types:type(), state()) -> {[proper_gen:imm_instance()],state()}). %%------------------------------------------------------------------------------ %% Main shrinking functions %%------------------------------------------------------------------------------ -spec shrink(proper_gen:imm_instance(), proper_types:type(), state()) -> {[proper_gen:imm_instance()],state()}. %% We reject all shrunk instances that don't satisfy all constraints. A full %% is_instance check is not necessary if we assume that generators and shrinkers %% always return valid instances of the base type. shrink(ImmInstance, Type, init) -> Shrinkers = get_shrinkers(Type), shrink(ImmInstance, Type, {shrinker,Shrinkers,dummy,init}); shrink(_ImmInstance, _Type, {shrinker,[],_Lookup,init}) -> {[], done}; shrink(ImmInstance, Type, {shrinker,[_Shrinker | Rest],_Lookup,done}) -> shrink(ImmInstance, Type, {shrinker,Rest,dummy,init}); shrink(ImmInstance, Type, {shrinker,Shrinkers,_Lookup,State}) -> [Shrinker | _Rest] = Shrinkers, {DirtyImmInstances,NewState} = Shrinker(ImmInstance, Type, State), SatisfiesAll = fun(I) -> Instance = proper_gen:clean_instance(I), proper_types:weakly(proper_types:satisfies_all(Instance, Type)) end, {NewImmInstances,NewLookup} = proper_arith:filter(SatisfiesAll, DirtyImmInstances), {NewImmInstances, {shrinker,Shrinkers,NewLookup,NewState}}; shrink(ImmInstance, Type, {shrunk,N,{shrinker,Shrinkers,Lookup,State}}) -> ActualN = lists:nth(N, Lookup), shrink(ImmInstance, Type, {shrinker,Shrinkers,dummy,{shrunk,ActualN,State}}). -spec get_shrinkers(proper_types:type()) -> [shrinker()]. get_shrinkers(Type) -> case proper_types:find_prop(noshrink, Type) of {ok, true} -> []; _ -> CustomShrinkers = case proper_types:find_prop(shrinkers, Type) of {ok, Shrinkers} -> Shrinkers; error -> [] end, StandardShrinkers = case proper_types:get_prop(kind, Type) of basic -> []; wrapper -> [fun alternate_shrinker/3, fun unwrap_shrinker/3]; constructed -> case proper_types:get_prop(shrink_to_parts, Type) of true -> [fun to_part_shrinker/3, fun parts_shrinker/3, fun in_shrinker/3]; false -> [fun parts_shrinker/3, fun in_shrinker/3] end; container -> [fun split_shrinker/3, fun remove_shrinker/3, fun elements_shrinker/3]; _Other -> [] end, CustomShrinkers ++ StandardShrinkers end. %%------------------------------------------------------------------------------ %% Wrapper type shrinkers %%------------------------------------------------------------------------------ %% Since shrinking only happens for generated values, any native types have %% already been produced by the typeserver, thus we are sure we won't get a %% typeserver exception. -spec alternate_shrinker(proper_gen:imm_instance(), proper_types:type(), state()) -> {[proper_gen:imm_instance()],state()}. %% we stop at the smaller alternative shrinker %% TODO: 'is_raw_type' check? alternate_shrinker(Instance, Type, init) -> Choices = proper_types:unwrap(Type), union_first_choice_shrinker(Instance, Choices, init); alternate_shrinker(_Instance, _Type, _State) -> {[], done}. -spec unwrap_shrinker(proper_gen:imm_instance(), proper_types:type(), state()) -> {[proper_gen:imm_instance()],state()}. unwrap_shrinker(Instance, Type, init) -> Choices = proper_types:unwrap(Type), union_recursive_shrinker(Instance, Choices, init); unwrap_shrinker(Instance, _Type, State) -> union_recursive_shrinker(Instance, [], State). %%------------------------------------------------------------------------------ %% Constructed type shrinkers %%------------------------------------------------------------------------------ -spec to_part_shrinker(proper_gen:imm_instance(), proper_types:type(), state()) -> {[proper_gen:imm_instance()],state()}. to_part_shrinker({'$used',ImmParts,_ImmInstance}, _Type, init) -> {[{'$to_part',P} || P <- ImmParts], done}; to_part_shrinker(_Instance, _Type, _State) -> {[], done}. -spec parts_shrinker(proper_gen:imm_instance(), proper_types:type(), state()) -> {[proper_gen:imm_instance()],state()}. %% TODO: move some of the generation code in the proper_gen module parts_shrinker(Instance = {'$used',_ImmParts,_ImmInstance}, Type, init) -> PartsType = proper_types:get_prop(parts_type, Type), parts_shrinker(Instance, Type, {parts,PartsType,dummy,init}); parts_shrinker(_CleanInstance, _Type, init) -> {[], done}; parts_shrinker(_Instance, _Type, {parts,_PartsType,_Lookup,done}) -> {[], done}; parts_shrinker({'$used',ImmParts,ImmInstance}, Type, {parts,PartsType,_Lookup,PartsState}) -> {NewImmParts,NewPartsState} = shrink(ImmParts, PartsType, PartsState), Combine = proper_types:get_prop(combine, Type), DirtyInstances = [try_combine(P, ImmInstance, Combine) || P <- NewImmParts], NotError = fun({ok,_}) -> true; (error) -> false end, {NewOKInstances,NewLookup} = proper_arith:filter(NotError, DirtyInstances), NewInstances = [X || {ok,X} <- NewOKInstances], {NewInstances, {parts,PartsType,NewLookup,NewPartsState}}; parts_shrinker(Instance, Type, {shrunk,N,{parts,PartsType,Lookup,PartsState}}) -> ActualN = lists:nth(N, Lookup), parts_shrinker(Instance, Type, {parts,PartsType,dummy,{shrunk,ActualN,PartsState}}). -spec try_combine(proper_gen:imm_instance(), proper_gen:imm_instance(), proper_gen:combine_fun()) -> {'ok',proper_gen:imm_instance()} | 'error'. try_combine(ImmParts, OldImmInstance, Combine) -> Parts = proper_gen:clean_instance(ImmParts), ImmInstance = Combine(Parts), case proper_types:is_raw_type(ImmInstance) of true -> InnerType = proper_types:cook_outer(ImmInstance), %% TODO: special case if the immediately internal is a LET? %% TODO: more specialized is_instance check here? %% This should never throw an exception, provided the instance %% has already been instance-checked. case proper_types:is_instance(OldImmInstance, InnerType) of true -> {ok,{'$used',ImmParts,OldImmInstance}}; false -> %% TODO: return more than one? then we must flatten case proper_gen:safe_generate(InnerType) of {ok,NewImmInstance} -> {ok,{'$used',ImmParts,NewImmInstance}}; {error,_Reason} -> error end end; false -> {ok,{'$used',ImmParts,ImmInstance}} end. -spec in_shrinker(proper_gen:imm_instance(), proper_types:type(), state()) -> {[proper_gen:imm_instance()],state()}. in_shrinker(Instance = {'$used',ImmParts,_ImmInstance}, Type, init) -> Combine = proper_types:get_prop(combine, Type), Parts = proper_gen:clean_instance(ImmParts), ImmInstance = Combine(Parts), %% TODO: more specialized raw_type check here? case proper_types:is_raw_type(ImmInstance) of true -> InnerType = proper_types:cook_outer(ImmInstance), in_shrinker(Instance, Type, {inner,InnerType,init}); false -> {[], done} end; in_shrinker(Instance = {'$to_part',ImmInstance}, Type, init) -> %% TODO: move this to proper_types PartsType = proper_types:get_prop(parts_type, Type), case {proper_types:find_prop(internal_type,PartsType), proper_types:find_prop(internal_types,PartsType)} of {{ok,EachPartType},error} -> in_shrinker(Instance, Type, {part_rec,EachPartType,init}); {error,{ok,PartTypesList}} -> IsInst = fun(T) -> proper_types:is_instance(ImmInstance,T) end, {_Pos,PartType} = proper_arith:find_first(IsInst, PartTypesList), in_shrinker(Instance, Type, {part_rec,PartType,init}) end; in_shrinker(_CleanInstance, _Type, init) -> {[], done}; in_shrinker(_Instance, _Type, {_Decl,_RecType,done}) -> {[], done}; in_shrinker({'$used',ImmParts,ImmInstance}, _Type, {inner,InnerType,InnerState}) -> {NewImmInstances,NewInnerState} = shrink(ImmInstance, InnerType, InnerState), NewInstances = [{'$used',ImmParts,I} || I <- NewImmInstances], {NewInstances, {inner,InnerType,NewInnerState}}; in_shrinker({'$to_part',ImmInstance}, _Type, {part_rec,PartType,PartState}) -> {NewImmInstances,NewPartState} = shrink(ImmInstance, PartType, PartState), NewInstances = [{'$to_part',I} || I <- NewImmInstances], {NewInstances, {part_rec,PartType,NewPartState}}; in_shrinker(Instance, Type, {shrunk,N,{Decl,RecType,InnerState}}) -> in_shrinker(Instance, Type, {Decl,RecType,{shrunk,N,InnerState}}). %%------------------------------------------------------------------------------ %% Container type shrinkers %%------------------------------------------------------------------------------ -spec split_shrinker(proper_gen:imm_instance(), proper_types:type(), state()) -> {[proper_gen:imm_instance()],state()}. split_shrinker(Instance, Type, init) -> case {proper_types:find_prop(split, Type), proper_types:find_prop(get_length, Type), proper_types:find_prop(join, Type)} of {error, _, _} -> {[], done}; {{ok,_Split}, error, _} -> split_shrinker(Instance, Type, no_pos); {{ok,_Split}, {ok,GetLength}, {ok,_Join}} -> split_shrinker(Instance, Type, {slices,2,GetLength(Instance)}) end; split_shrinker(Instance, Type, no_pos) -> Split = proper_types:get_prop(split, Type), {Split(Instance), done}; split_shrinker(Instance, Type, {shrunk,done}) -> split_shrinker(Instance, Type, no_pos); %% implementation of the ddmin algorithm, but stopping before the granularity %% reaches 1, since we run a 'remove' shrinker after this %% TODO: on success, start over with the whole testcase or keep removing slices? split_shrinker(Instance, Type, {slices,N,Len}) -> case Len < 2 * N of true -> {[], done}; false -> {SmallSlices,BigSlices} = slice(Instance, Type, N, Len), {SmallSlices ++ BigSlices, {slices,2*N,Len}} end; split_shrinker(Instance, Type, {shrunk,Pos,{slices,DoubleN,_Len}}) -> N = DoubleN div 2, GetLength = proper_types:get_prop(get_length, Type), case Pos =< N of true -> split_shrinker(Instance, Type, {slices,2,GetLength(Instance)}); false -> split_shrinker(Instance, Type, {slices,N-1,GetLength(Instance)}) end. -spec slice(proper_gen:imm_instance(), proper_types:type(), pos_integer(), length()) -> {[proper_gen:imm_instance()],[proper_gen:imm_instance()]}. slice(Instance, Type, Slices, Len) -> BigSlices = Len rem Slices, SmallSlices = Slices - BigSlices, SmallSliceLen = Len div Slices, BigSliceLen = SmallSliceLen + 1, BigSliceTotal = BigSlices * BigSliceLen, WhereToSlice = [{1 + X * BigSliceLen, BigSliceLen} || X <- lists:seq(0, BigSlices - 1)] ++ [{BigSliceTotal + 1 + X * SmallSliceLen, SmallSliceLen} || X <- lists:seq(0, SmallSlices - 1)], lists:unzip([take_slice(Instance, Type, From, SliceLen) || {From,SliceLen} <- WhereToSlice]). -spec take_slice(proper_gen:imm_instance(), proper_types:type(), pos_integer(), length()) -> {proper_gen:imm_instance(),proper_gen:imm_instance()}. take_slice(Instance, Type, From, SliceLen) -> Split = proper_types:get_prop(split, Type), Join = proper_types:get_prop(join, Type), {Front,ImmBack} = Split(From - 1, Instance), {Slice,Back} = Split(SliceLen, ImmBack), {Slice, Join(Front, Back)}. -spec remove_shrinker(proper_gen:imm_instance(), proper_types:type(), state()) -> {[proper_gen:imm_instance()], state()}. %% TODO: try removing more than one elemnent: 2,4,... or 2,3,... - when to stop? remove_shrinker(Instance, Type, init) -> case {proper_types:find_prop(get_indices, Type), proper_types:find_prop(remove, Type)} of {{ok,_GetIndices}, {ok,_Remove}} -> remove_shrinker(Instance, Type, {shrunk,1,{indices,ordsets:from_list([]),dummy}}); _ -> {[], done} end; remove_shrinker(_Instance, _Type, {indices,_Checked,[]}) -> {[], done}; remove_shrinker(Instance, Type, {indices,Checked,[Index | Rest]}) -> Remove = proper_types:get_prop(remove, Type), {[Remove(Index, Instance)], {indices,ordsets:add_element(Index, Checked),Rest}}; remove_shrinker(Instance, Type, {shrunk,1,{indices,Checked,_ToCheck}}) -> %% TODO: normally, indices wouldn't be expected to change for the remaining %% elements, but this happens for lists, so we'll just avoid %% re-checking any indices we have already tried (even though these %% might correspond to new elements now - at least they don't in the %% case of lists) %% TODO: ordsets are used to ensure efficiency, but the ordsets module %% compares elements with == instead of =:=, that could cause us to %% miss some elements in some cases GetIndices = proper_types:get_prop(get_indices, Type), Indices = ordsets:from_list(GetIndices(Type, Instance)), NewToCheck = ordsets:subtract(Indices, Checked), remove_shrinker(Instance, Type, {indices,Checked,NewToCheck}). -spec elements_shrinker(proper_gen:imm_instance(), proper_types:type(), state()) -> {[proper_gen:imm_instance()],state()}. %% TODO: is it safe to assume that all functions and the indices will not change %% after any update? %% TODO: shrink many elements concurrently? elements_shrinker(Instance, Type, init) -> case {proper_types:find_prop(get_indices, Type), proper_types:find_prop(retrieve, Type), proper_types:find_prop(update, Type)} of {{ok,GetIndices}, {ok,Retrieve}, {ok,_Update}} -> GetElemType = case proper_types:find_prop(internal_type, Type) of {ok,RawInnerType} -> InnerType = proper_types:cook_outer(RawInnerType), fun(_I) -> InnerType end; error -> InnerTypes = proper_types:get_prop(internal_types, Type), fun(I) -> Retrieve(I, InnerTypes) end end, Indices = GetIndices(Type, Instance), elements_shrinker(Instance, Type, {inner,Indices,GetElemType,init}); _ -> {[], done} end; elements_shrinker(_Instance, _Type, {inner,[],_GetElemType,init}) -> {[], done}; elements_shrinker(Instance, Type, {inner,[_Index | Rest],GetElemType,done}) -> elements_shrinker(Instance, Type, {inner,Rest,GetElemType,init}); elements_shrinker(Instance, Type, {inner,Indices = [Index | _Rest],GetElemType,InnerState}) -> Retrieve = proper_types:get_prop(retrieve, Type), Update = proper_types:get_prop(update, Type), ImmElem = Retrieve(Index, Instance), InnerType = GetElemType(Index), {NewImmElems,NewInnerState} = shrink(ImmElem, InnerType, InnerState), NewInstances = [Update(Index, E, Instance) || E <- NewImmElems], {NewInstances, {inner,Indices,GetElemType,NewInnerState}}; elements_shrinker(Instance, Type, {shrunk,N,{inner,Indices,GetElemType,InnerState}}) -> elements_shrinker(Instance, Type, {inner,Indices,GetElemType,{shrunk,N,InnerState}}). %%------------------------------------------------------------------------------ %% Custom shrinkers %%------------------------------------------------------------------------------ -spec number_shrinker(number(), proper_types:extnum(), proper_types:extnum(), state()) -> {[number()],state()}. number_shrinker(X, Low, High, init) -> {Target,Inc,OverLimit} = find_target(X, Low, High), case X =:= Target of true -> {[], done}; false -> {[Target], {inc,Target,Inc,OverLimit}} end; number_shrinker(_X, _Low, _High, {inc,Last,Inc,OverLimit}) -> NewLast = Inc(Last), case OverLimit(NewLast) of true -> {[], done}; false -> {[NewLast], {inc,NewLast,Inc,OverLimit}} end; number_shrinker(_X, _Low, _High, {shrunk,_Pos,_State}) -> {[], done}. -spec find_target(number(), number(), number()) -> {number(),fun((number()) -> number()),fun((number()) -> boolean())}. find_target(X, Low, High) -> case {proper_types:le(Low,0), proper_types:le(0,High)} of {false, _} -> Limit = find_limit(X, Low, High, High), {Low, fun(Y) -> Y + 1 end, fun(Y) -> Y > Limit end}; {true,false} -> Limit = find_limit(X, Low, High, Low), {High, fun(Y) -> Y - 1 end, fun(Y) -> Y < Limit end}; {true,true} -> Sign = sign(X), OverLimit = case X >= 0 of true -> Limit = find_limit(X, Low, High, High), fun(Y) -> Y > Limit end; false -> Limit = find_limit(X, Low, High, Low), fun(Y) -> Y < Limit end end, {zero(X), fun(Y) -> Y + Sign end, OverLimit} end. -spec find_limit(number(), number(), number(), number()) -> number(). find_limit(X, Low, High, FallBack) -> case proper_types:le(Low, X) andalso proper_types:le(X, High) of true -> X; false -> FallBack end. -spec sign(number()) -> number(). sign(X) -> if X > 0 -> 1; X < 0 -> -1; true -> zero(X) end. -spec zero(number()) -> number(). zero(X) when is_integer(X) -> 0; zero(X) when is_float(X) -> 0.0. -spec union_first_choice_shrinker(proper_gen:imm_instance(), [proper_types:type()], state()) -> {[proper_gen:imm_instance()],state()}. %% TODO: do this incrementally? union_first_choice_shrinker(Instance, Choices, init) -> case first_plausible_choice(Instance, Choices) of none -> {[],done}; {N,_Type} -> PriorChoices = lists:sublist(Choices, N - 1), DirtyInstances = [proper_gen:safe_generate(T) || T <- PriorChoices], NewInstances = [X || {ok,X} <- DirtyInstances], {NewInstances,done} end; union_first_choice_shrinker(_Instance, _Choices, {shrunk,_Pos,done}) -> {[], done}. -spec union_recursive_shrinker(proper_gen:imm_instance(), [proper_types:type()], state()) -> {[proper_gen:imm_instance()],state()}. union_recursive_shrinker(Instance, Choices, init) -> case first_plausible_choice(Instance, Choices) of none -> {[],done}; {N,Type} -> union_recursive_shrinker(Instance, Choices, {inner,N,Type,init}) end; union_recursive_shrinker(_Instance, _Choices, {inner,_N,_Type,done}) -> {[],done}; union_recursive_shrinker(Instance, _Choices, {inner,N,Type,InnerState}) -> {NewInstances,NewInnerState} = shrink(Instance, Type, InnerState), {NewInstances, {inner,N,Type,NewInnerState}}; union_recursive_shrinker(Instance, Choices, {shrunk,Pos,{inner,N,Type,InnerState}}) -> union_recursive_shrinker(Instance, Choices, {inner,N,Type,{shrunk,Pos,InnerState}}). -spec first_plausible_choice(proper_gen:imm_instance(), [proper_types:type()]) -> {position(),proper_types:type()} | 'none'. first_plausible_choice(Instance, Choices) -> %% This should never throw an exception, provided the instance has already %% been instance-checked. IsInstance = fun(Type) -> proper_types:is_instance(Instance, Type) end, proper_arith:find_first(IsInstance, Choices). erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_statem.erl000066400000000000000000001162771255446327200235120ustar00rootroot00000000000000%%% Copyright 2010-2013 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Eirini Arvaniti %%% @doc This module defines the `proper_statem' behaviour, useful for testing %%% stateful reactive systems whose internal state and side-effects are %%% specified via an abstract state machine. Given a callback module %%% implementing the `proper_statem' behaviour (i.e. defining an abstract state %%% machine of the system under test), PropEr can generate random symbolic %%% sequences of calls to that system. %%% As a next step, generated symbolic calls are actually performed, while %%% monitoring the system's responses to ensure it behaves as expected. Upon %%% failure, the shrinking mechanism attempts to find a minimal sequence of %%% calls provoking the same error. %%% %%% When including the "proper/include/proper.hrl" header file, %%% all API functions of {@module} are automatically %%% imported, unless `PROPER_NO_IMPORTS' is defined. %%% %%% === The role of commands === %%% Testcases generated for testing a stateful system are lists of symbolic API %%% calls to that system. Symbolic representation has several benefits, which %%% are listed here in increasing order of importance: %%%
    %%%
  • Generated testcases are easier to read and understand.
  • %%%
  • Failing testcases are easier to shrink.
  • %%%
  • The generation phase is side-effect free and this results in %%% repeatable testcases, which is essential for correct shrinking.
  • %%%
%%% Since the actual results of symbolic calls are not known at generation time, %%% we use symbolic variables ({@type symb_var()}) to refer to them. %%% A command ({@type command()}) is a symbolic term, used to bind a symbolic %%% variable to the result of a symbolic call. For example: %%% %%% ```[{set, {var,1}, {call,erlang,put,[a,42]}}, %%% {set, {var,2}, {call,erlang,erase,[a]}}, %%% {set, {var,3}, {call,erlang,put,[b,{var,2}]}}]''' %%% %%% is a command sequence that could be used to test the process dictionary. %%% In this example, the first call stores the pair `{a,42}' in the process %%% dictionary, while the second one deletes it. Then, a new pair `{b,{var,2}}' %%% is stored. `{var,2}' is a symbolic variable bound to the result of %%% `erlang:erase/1'. This result is not known at generation time, since none of %%% these operations is performed at that time. After evaluating the command %%% sequence at runtime, the process dictionary will eventually contain the %%% pair `{b,42}'. %%% %%% === The abstract model-state === %%% In order to be able to test impure code, we need a way to track its %%% internal state (at least the useful part of it). To this end, we use an %%% abstract state machine representing the possible configurations of the %%% system under test. When referring to the model state, we mean the %%% state of the abstract state machine. The model state can be either %%% symbolic or dynamic: %%%
    %%%
  • During command generation, we use symbolic variables to bind the %%% results of symbolic calls. Therefore, the model state might %%% (and usually does) contain symbolic variables and/or symbolic calls, which %%% are necessary to operate on symbolic variables. Thus, we refer to it as %%% symbolic state. For example, assuming that the internal state of the %%% process dictionary is modeled as a proplist, the model state after %%% generating the previous command sequence will be `[{b,{var,2}}]'.
  • %%%
  • During runtime, symbolic calls are evaluated and symbolic variables are %%% replaced by their corresponding real values. Now we refer to the state as %%% dynamic state. After running the previous command sequence, the model state %%% will be `[{b,42}]'.
  • %%%
%%% %%% === The callback functions === %%% The following functions must be exported from the callback module %%% implementing the abstract state machine: %%%
    %%%
  • `initial_state() ::' {@type symbolic_state()} %%%

    Specifies the symbolic initial state of the state machine. This state %%% will be evaluated at command execution time to produce the actual initial %%% state. The function is not only called at command generation time, but %%% also in order to initialize the state every time the command sequence is %%% run (i.e. during normal execution, while shrinking and when checking a %%% counterexample). For this reason, it should be deterministic and %%% self-contained.

  • %%%
  • `command(S::'{@type symbolic_state()}`) ::' {@type proper_types:type()} %%%

    Generates a symbolic call to be included in the command sequence, %%% given the current state `S' of the abstract state machine. However, %%% before the call is actually included, a precondition is checked. This %%% function will be repeatedly called to produce the next call to be %%% included in the test case.

  • %%%
  • `precondition(S::'{@type symbolic_state()}`, %%% Call::'{@type symb_call()}`) :: boolean()' %%%

    Specifies the precondition that should hold so that `Call' can be %%% included in the command sequence, given the current state `S' of the %%% abstract state machine. In case precondition doesn't hold, a new call is %%% chosen using the `command/1' generator. If preconditions are very strict, %%% it will take a lot of tries for PropEr to randomly choose a valid command. %%% Testing will be stopped in case the `constraint_tries' limit is reached %%% (see the 'Options' section in the {@link proper} module documentation). %%% Preconditions are also important for correct shrinking of failing %%% testcases. When shrinking command sequences, we try to eliminate commands %%% that do not contribute to failure, ensuring that all preconditions still %%% hold. Validating preconditions is necessary because during shrinking we %%% usually attempt to perform a call with the system being in a state %%% different from the state it was when initially running the test.

  • %%%
  • `postcondition(S::'{@type dynamic_state()}`, %%% Call::'{@type symbolic_call()}`, %%% Res::term()) :: boolean()' %%%

    Specifies the postcondition that should hold about the result `Res' of %%% performing `Call', given the dynamic state `S' of the abstract state %%% machine prior to command execution. This function is called during %%% runtime, this is why the state is dynamic.

  • %%%
  • `next_state(S::'{@type symbolic_state()} `|' {@type dynamic_state()}`, %%% Res::term(), %%% Call::'{@type symbolic_call()}`) ::' %%% {@type symbolic_state()} `|' {@type dynamic_state()} %%%

    Specifies the next state of the abstract state machine, given the %%% current state `S', the symbolic `Call' chosen and its result `Res'. This %%% function is called both at command generation and command execution time %%% in order to update the model state, therefore the state `S' and the %%% result `Res' can be either symbolic or dynamic.

  • %%%
%%% %%% === The property used === %%% Each test consists of two phases: %%%
    %%%
  • As a first step, PropEr generates random symbolic command sequences %%% deriving information from the callback module implementing the abstract %%% state machine. This is the role of {@link commands/1} generator.
  • %%%
  • As a second step, command sequences are executed so as to check that %%% the system behaves as expected. This is the role of %%% {@link run_commands/2}, a function that evaluates a symbolic command %%% sequence according to an abstract state machine specification.
  • %%%
%%% %%% These two phases are encapsulated in the following property, which can be %%% used for testing the process dictionary: %%% %%% ```prop_pdict() -> %%% ?FORALL(Cmds, proper_statem:commands(?MODULE), %%% begin %%% {_History, _State, Result} = proper_statem:run_commands(?MODULE, Cmds), %%% cleanup(), %%% Result =:= ok %%% end).''' %%% %%% When testing impure code, it is very important to keep each test %%% self-contained. For this reason, almost every property for testing stateful %%% systems contains some clean-up code. Such code is necessary to put the %%% system in a known state, so that the next test can be executed %%% independently from previous ones. %%% %%% == Parallel testing == %%% After ensuring that a system's behaviour can be described via an abstract %%% state machine when commands are executed sequentially, it is possible to %%% move to parallel testing. The same state machine can be used to generate %%% command sequences that will be executed in parallel to test for race %%% conditions. A parallel testcase ({@type parallel_testcase()}) consists of %%% a sequential and a parallel component. The sequential component is a %%% command sequence that is run first to put the system in a random state. %%% The parallel component is a list containing 2 command sequences to be %%% executed in parallel, each of them in a separate newly-spawned process. %%% %%% Generating parallel test cases involves the following actions. Initially, %%% we generate a command sequence deriving information from the abstract %%% state machine specification, as in the case of sequential statem testing. %%% Then, we parallelize a random suffix (up to 12 commands) of the initial %%% sequence by splitting it into 2 subsequences that will be executed %%% concurrently. Limitations arise from the fact that each subsequence should %%% be a valid command sequence (i.e. all commands should satisfy %%% preconditions and use only symbolic variables bound to the results of %%% preceding calls in the same sequence). Furthermore, we apply an additional %%% check: we have to ensure that preconditions are satisfied in all possible %%% interleavings of the concurrent tasks. Otherwise, an exception might be %%% raised during parallel execution and lead to unexpected (and unwanted) test %%% failure. In case these constraints cannot be satisfied for a specific test %%% case, the test case will be executed sequentially. Then an `f' is printed %%% on screen to inform the user. This usually means that preconditions need %%% to become less strict for parallel testing to work. %%% %%% After running a parallel testcase, PropEr uses the state machine %%% specification to check if the results observed could have been produced by %%% a possible serialization of the parallel component. If no such serialization %%% is possible, then an atomicity violation has been detected. In this case, %%% the shrinking mechanism attempts to produce a counterexample that is minimal %%% in terms of concurrent operations. Properties for parallel testing are very %%% similar to those used for sequential testing. %%% %%% ```prop_parallel_testing() -> %%% ?FORALL(Testcase, proper_statem:parallel_commands(?MODULE), %%% begin %%% {_Sequential, _Parallel, Result} = proper_statem:run_parallel_commands(?MODULE, Testcase), %%% cleanup(), %%% Result =:= ok %%% end).''' %%% %%% Please note that the actual interleaving of commands of the parallel %%% component depends on the Erlang scheduler, which is too deterministic. %%% For PropEr to be able to detect race conditions, the code of the system %%% under test should be instrumented with `erlang:yield/0' calls to the %%% scheduler. %%% @end -module(proper_statem). -export([behaviour_info/1]). -export([commands/1, commands/2, parallel_commands/1, parallel_commands/2, more_commands/2]). -export([run_commands/2, run_commands/3, run_parallel_commands/2, run_parallel_commands/3]). -export([state_after/2, command_names/1, zip/2]). -include("proper_internal.hrl"). -define(WORKERS, 2). -define(LIMIT, 12). %% ----------------------------------------------------------------------------- %% Exported only for testing purposes %% ----------------------------------------------------------------------------- -export([index/2, all_insertions/3, insert_all/2]). -export([is_valid/4, args_defined/2]). -export([get_next/6, mk_first_comb/3]). -export([execute/4, check/6, run/3, get_initial_state/2]). %% ----------------------------------------------------------------------------- %% Type declarations %% ----------------------------------------------------------------------------- %% @type symbolic_state() -type symbolic_state() :: term(). %% @type dynamic_state() -type dynamic_state() :: term(). -type symb_var() :: {'var',pos_integer()}. -type symb_call() :: {'call',mod_name(),fun_name(),[term()]}. -type command() :: {'set',symb_var(),symb_call()} | {'init',symbolic_state()}. -type command_list() :: [command()]. -type parallel_testcase() :: {command_list(),[command_list()]}. -type parallel_history() :: [{command(),term()}]. -type history() :: [{dynamic_state(),term()}]. -type statem_result() :: 'ok' | 'initialization_error' | {'precondition', 'false' | proper:exception()} | {'postcondition', 'false' | proper:exception()} | proper:exception() | 'no_possible_interleaving'. -type index() :: pos_integer(). -type indices() :: [index()]. -type combination() :: [{pos_integer(),indices()}]. -type lookup() :: orddict:orddict(). -export_type([symb_var/0, symb_call/0, statem_result/0]). %% ----------------------------------------------------------------------------- %% Proper_statem behaviour %% ---------------------------------------------------------------------------- %% @doc Specifies the callback functions that should be exported from a module %% implementing the `proper_statem' behaviour. -spec behaviour_info('callbacks') -> [{fun_name(),arity()}]. behaviour_info(callbacks) -> [{initial_state,0}, {command,1}, {precondition,2}, {postcondition,3}, {next_state,3}]; behaviour_info(_Attribute) -> undefined. %% ----------------------------------------------------------------------------- %% Sequential command generation %% ----------------------------------------------------------------------------- %% @doc A special PropEr type which generates random command sequences, %% according to an absract state machine specification. The function takes as %% input the name of a callback module, which contains the state machine %% specification. The initial state is computed by `Mod:initial_state/0'. -spec commands(mod_name()) -> proper_types:type(). commands(Mod) -> ?LET(InitialState, ?LAZY(Mod:initial_state()), ?SUCHTHAT( Cmds, ?LET(List, ?SIZED(Size, proper_types:noshrink( commands(Size, Mod, InitialState, 1))), proper_types:shrink_list(List)), is_valid(Mod, InitialState, Cmds, []))). %% @doc Similar to {@link commands/1}, but generated command sequences always %% start at a given state. In this case, the first command is always %% `{init,InitialState}' and is used to correctly initialize the state %% every time the command sequence is run (i.e. during normal execution, %% while shrinking and when checking a counterexample). In this case, %% `Mod:initial_state/0' is never called. -spec commands(mod_name(), symbolic_state()) -> proper_types:type(). commands(Mod, InitialState) -> ?SUCHTHAT( Cmds, ?LET(CmdTail, ?LET(List, ?SIZED(Size, proper_types:noshrink( commands(Size, Mod, InitialState, 1))), proper_types:shrink_list(List)), [{init,InitialState}|CmdTail]), is_valid(Mod, InitialState, Cmds, [])). -spec commands(size(), mod_name(), symbolic_state(), pos_integer()) -> proper_types:type(). commands(Size, Mod, State, Count) -> ?LAZY( proper_types:frequency( [{1, []}, {Size, ?LET(Call, ?SUCHTHAT(X, Mod:command(State), Mod:precondition(State, X)), begin Var = {var,Count}, NextState = Mod:next_state(State, Var, Call), ?LET( Cmds, commands(Size-1, Mod, NextState, Count+1), [{set,Var,Call}|Cmds]) end)}])). %% @doc Increases the expected length of command sequences generated from %% `CmdType' by a factor `N'. -spec more_commands(pos_integer(), proper_types:type()) -> proper_types:type(). more_commands(N, CmdType) -> ?SIZED(Size, proper_types:resize(Size * N, CmdType)). %% ----------------------------------------------------------------------------- %% Parallel command generation %% ----------------------------------------------------------------------------- %% @doc A special PropEr type which generates parallel testcases, %% according to an absract state machine specification. The function takes as %% input the name of a callback module, which contains the state machine %% specification. The initial state is computed by `Mod:initial_state/0'. -spec parallel_commands(mod_name()) -> proper_types:type(). parallel_commands(Mod) -> ?LET({ShrunkSeq, ShrunkPar}, ?LET({Seq, Par}, proper_types:noshrink(parallel_gen(Mod)), parallel_shrinker(Mod, Seq, Par)), move_shrinker(ShrunkSeq, ShrunkPar, ?WORKERS)). %% @doc Similar to {@link parallel_commands/1}, but generated command sequences %% always start at a given state. -spec parallel_commands(mod_name(), symbolic_state()) -> proper_types:type(). parallel_commands(Mod, InitialState) -> ?LET({ShrunkSeq, ShrunkPar}, ?LET({Seq, Par}, proper_types:noshrink(parallel_gen(Mod, InitialState)), parallel_shrinker(Mod, Seq, Par)), move_shrinker(ShrunkSeq, ShrunkPar, ?WORKERS)). -spec parallel_gen(mod_name()) -> proper_types:type(). parallel_gen(Mod) -> ?LET(Seq, commands(Mod), mk_parallel_testcase(Mod, Seq)). -spec parallel_gen(mod_name(), symbolic_state()) -> proper_types:type(). parallel_gen(Mod, InitialState) -> ?LET(Seq, commands(Mod, InitialState), mk_parallel_testcase(Mod, Seq)). -spec mk_parallel_testcase(mod_name(), command_list()) -> proper_types:type(). mk_parallel_testcase(Mod, Seq) -> {State, SymbEnv} = state_env_after(Mod, Seq), Count = case SymbEnv of [] -> 1; [{var,N}|_] -> N + 1 end, ?LET(Parallel, ?SUCHTHAT(C, commands(?LIMIT, Mod, State, Count), length(C) > ?WORKERS), begin LenPar = length(Parallel), Len = LenPar div ?WORKERS, Comb = mk_first_comb(LenPar, Len, ?WORKERS), LookUp = orddict:from_list(mk_dict(Parallel, 1)), {Seq, fix_parallel(LenPar, Len, Comb, LookUp, Mod, State, SymbEnv, ?WORKERS)} end). -spec parallel_shrinker(mod_name(), command_list(), [command_list()]) -> proper_types:type(). parallel_shrinker(Mod, [{init,I} = Init|Seq], Parallel) -> ?SUCHTHAT({Seq1, Parallel1}, ?LET(ParInstances, [proper_types:shrink_list(P) || P <- Parallel], ?LET(SeqInstance, proper_types:shrink_list(Seq), {[Init|SeqInstance], ParInstances})), lists:all( fun(P) -> is_valid(Mod, I, Seq1 ++ P, []) end, Parallel1)); parallel_shrinker(Mod, Seq, Parallel) -> I = Mod:initial_state(), ?SUCHTHAT({Seq1, Parallel1}, ?LET(ParInstances, [proper_types:shrink_list(P) || P <- Parallel], ?LET(SeqInstance, proper_types:shrink_list(Seq), {SeqInstance, ParInstances})), lists:all( fun(P) -> is_valid(Mod, I, Seq1 ++ P, []) end, Parallel1)). -spec move_shrinker(command_list(), [command_list()], index()) -> proper_types:type(). move_shrinker(Seq, Par, 1) -> ?SHRINK({Seq, Par}, [{Seq ++ Slice, remove_slice(1, Slice, Par)} || Slice <- get_slices(lists:nth(1, Par))]); move_shrinker(Seq, Par, I) -> ?LET({NewSeq, NewPar}, ?SHRINK({Seq, Par}, [{Seq ++ Slice, remove_slice(I, Slice, Par)} || Slice <- get_slices(lists:nth(I, Par))]), move_shrinker(NewSeq, NewPar, I-1)). %% ----------------------------------------------------------------------------- %% Sequential command execution %% ----------------------------------------------------------------------------- %% @doc Evaluates a given symbolic command sequence `Cmds' according to the %% state machine specified in `Mod'. The result is a triple of the form
%% `{History, DynamicState, Result}', where: %%
    %%
  • `History' contains the execution history of all commands that were %% executed without raising an exception. It contains tuples of the form %% {{@type dynamic_state()}, {@type term()}}, specifying the state prior to %% command execution and the actual result of the command.
  • %%
  • `DynamicState' contains the state of the abstract state machine at %% the moment when execution stopped. In case execution has stopped due to a %% false postcondition, `DynamicState' corresponds to the state prior to %% execution of the last command.
  • %%
  • `Result' specifies the outcome of command execution. It can be %% classified in one of the following categories: %%
      %%
    • ok %%

      All commands were successfully run and all postconditions were true. %%

    • %%
    • initialization error %%

      There was an error while evaluating the initial state.

    • %%
    • postcondition error %%

      A postcondition was false or raised an exception.

    • %%
    • precondition error %%

      A precondition was false or raised an exception.

    • %%
    • exception %%

      An exception was raised while running a command.

    • %%
  • %%
-spec run_commands(mod_name(), command_list()) -> {history(),dynamic_state(),statem_result()}. run_commands(Mod, Cmds) -> run_commands(Mod, Cmds, []). %% @doc Similar to {@link run_commands/2}, but also accepts an environment, %% used for symbolic variable evaluation during command execution. The %% environment consists of `{Key::atom(), Value::term()}' pairs. Keys may be %% used in symbolic variables (i.e. `{var,Key}') whithin the command sequence %% `Cmds'. These symbolic variables will be replaced by their corresponding %% `Value' during command execution. -spec run_commands(mod_name(), command_list(), proper_symb:var_values()) -> {history(),dynamic_state(),statem_result()}. run_commands(Mod, Cmds, Env) -> element(1, run(Mod, Cmds, Env)). %% @private -spec run(mod_name(), command_list(), proper_symb:var_values()) -> {{history(),dynamic_state(),statem_result()}, proper_symb:var_values()}. run(Mod, Cmds, Env) -> InitialState = get_initial_state(Mod, Cmds), try proper_symb:eval(Env, InitialState) of DynState -> run_commands(Cmds, Env, Mod, [], DynState) catch _Exc:_Reason -> {{[], undefined, initialization_error}, []} end. -spec run_commands(command_list(), proper_symb:var_values(), mod_name(), history(), dynamic_state()) -> {{history(),dynamic_state(),statem_result()}, proper_symb:var_values()}. run_commands(Cmds, Env, Mod, History, State) -> case Cmds of [] -> {{lists:reverse(History), State, ok}, Env}; [{init,_S}|Rest] -> run_commands(Rest, Env, Mod, History, State); [{set, {var,V}, {call,M,F,A}}|Rest] -> M2 = proper_symb:eval(Env, M), F2 = proper_symb:eval(Env, F), A2 = proper_symb:eval(Env, A), Call = {call,M2,F2,A2}, case check_precondition(Mod, State, Call) of true -> case safe_apply(M2, F2, A2) of {ok,Res} -> Env2 = [{V,Res}|Env], History2 = [{State,Res}|History], case check_postcondition(Mod, State, Call, Res) of true -> State2 = proper_symb:eval(Env2, Mod:next_state(State, Res, Call)), run_commands(Rest, Env2, Mod, History2, State2); false -> {{lists:reverse(History2), State, {postcondition,false}}, []}; {exception,_,_,_} = Exception -> {{lists:reverse(History2), State, {postcondition,Exception}}, []} end; {error,Exception} -> {{lists:reverse(History), State, Exception}, []} end; false -> {{lists:reverse(History), State, {precondition,false}}, []}; {exception,_,_,_} = Exc -> {{lists:reverse(History), State, {precondition,Exc}}, []} end end. -spec check_precondition(mod_name(), dynamic_state(), symb_call()) -> boolean() | proper:exception(). check_precondition(Mod, State, Call) -> try Mod:precondition(State, Call) catch Kind:Reason -> {exception, Kind, Reason, erlang:get_stacktrace()} end. -spec check_postcondition(mod_name(), dynamic_state(), symb_call(), term()) -> boolean() | proper:exception(). check_postcondition(Mod, State, Call, Res) -> try Mod:postcondition(State, Call, Res) catch Kind:Reason -> {exception, Kind, Reason, erlang:get_stacktrace()} end. -spec safe_apply(mod_name(), fun_name(), [term()]) -> {'ok', term()} | {'error', proper:exception()}. safe_apply(M, F, A) -> try apply(M, F, A) of Result -> {ok, Result} catch Kind:Reason -> {error, {exception, Kind, Reason, erlang:get_stacktrace()}} end. %% ----------------------------------------------------------------------------- %% Parallel command execution %% ----------------------------------------------------------------------------- %% @doc Runs a given parallel testcase according to the state machine %% specified in `Mod'. The result is a triple of the form
%% `@{Sequential_history, Parallel_history, Result@}', where: %%
    %%
  • `Sequential_history' contains the execution history of the %% sequential component.
  • %%
  • `Parallel_history' contains the execution history of each of the %% concurrent tasks.
  • %%
  • `Result' specifies the outcome of the attemp to serialize command %% execution, based on the results observed. It can be one of the following: %%
    • `ok'
    • `no_possible_interleaving'
  • %%
-spec run_parallel_commands(mod_name(), parallel_testcase()) -> {history(),[parallel_history()],statem_result()}. run_parallel_commands(Mod, {_Sequential, _Parallel} = Testcase) -> run_parallel_commands(Mod, Testcase, []). %% @doc Similar to {@link run_parallel_commands/2}, but also accepts an %% environment used for symbolic variable evaluation, exactly as described in %% {@link run_commands/3}. -spec run_parallel_commands(mod_name(), parallel_testcase(), proper_symb:var_values()) -> {history(),[parallel_history()],statem_result()}. run_parallel_commands(Mod, {Sequential, Parallel}, Env) -> case run(Mod, Sequential, Env) of {{Seq_history, State, ok}, SeqEnv} -> F = fun(T) -> execute(T, SeqEnv, Mod, []) end, Parallel_history = pmap(F, Parallel), case check(Mod, State, SeqEnv, false, [], Parallel_history) of true -> {Seq_history, Parallel_history, ok}; false -> {Seq_history, Parallel_history, no_possible_interleaving} end; {{Seq_history, _, Res}, _} -> {Seq_history, [], Res} end. %% @private -spec execute(command_list(), proper_symb:var_values(), mod_name(), parallel_history()) -> parallel_history(). execute(Cmds, Env, Mod, History) -> case Cmds of [] -> lists:reverse(History); [{set, {var,V}, {call,M,F,A}} = Cmd|Rest] -> M2 = proper_symb:eval(Env, M), F2 = proper_symb:eval(Env, F), A2 = proper_symb:eval(Env, A), Res = apply(M2, F2, A2), Env2 = [{V,Res}|Env], History2 = [{Cmd,Res}|History], execute(Rest, Env2, Mod, History2) end. -spec pmap(fun((command_list()) -> parallel_history()), [command_list()]) -> [parallel_history()]. pmap(F, L) -> await(spawn_jobs(F,L)). -spec spawn_jobs(fun((command_list()) -> parallel_history()), [command_list()]) -> [pid()]. spawn_jobs(F, L) -> Parent = self(), [spawn_link_cp(fun() -> Parent ! {self(),catch {ok,F(X)}} end) || X <- L]. -spec await([pid()]) -> [parallel_history()]. await([]) -> []; await([H|T]) -> receive {H, {ok, Res}} -> [Res|await(T)]; {H, {'EXIT',_} = Err} -> _ = [exit(Pid, kill) || Pid <- T], _ = [receive {P,_} -> d_ after 0 -> i_ end || P <- T], erlang:error(Err) end. %% @private -spec check(mod_name(), dynamic_state(), proper_symb:var_values(), boolean(), [parallel_history()], [parallel_history()]) -> boolean(). check(_Mod, _State, _Env, _Changed, [], []) -> true; check(_Mod, _State, _Env, false, _Tried, []) -> false; check(Mod, State, Env, true, Tried, []) -> check(Mod, State, Env, false, [], Tried); check(Mod, State, Env, Changed, Tried, [P|ToTry]) -> case P of [] -> check(Mod, State, Env, Changed, Tried, ToTry); [H|Tail] -> {{set, {var,N}, {call,M,F,A}}, Res} = H, M_ = proper_symb:eval(Env, M), F_ = proper_symb:eval(Env, F), A_ = proper_symb:eval(Env, A), Call = {call,M_,F_,A_}, case Mod:postcondition(State, Call, Res) of true -> Env2 = [{N, Res}|Env], NextState = proper_symb:eval( Env2, Mod:next_state(State, Res, Call)), check(Mod, NextState, Env2, true, Tried, [Tail|ToTry]) orelse check(Mod, State, Env, Changed, [P|Tried], ToTry); false -> check(Mod, State, Env, Changed, [P|Tried], ToTry) end end. %% ----------------------------------------------------------------------------- %% Other API functions %% ----------------------------------------------------------------------------- %% @doc Extracts the names of the commands from a given command sequence, in %% the form of MFAs. It is useful in combination with functions such as %% {@link proper:aggregate/2} in order to collect statistics about command %% execution. -spec command_names(command_list() | parallel_testcase()) -> [mfa()]. command_names({Cmds, L}) -> lists:flatten([command_names(Cmds)|[ command_names(Cs) || Cs <- L ]]); command_names(Cmds) -> [{M, F, length(Args)} || {set, _Var, {call,M,F,Args}} <- Cmds]. %% @doc Returns the symbolic state after running a given command sequence, %% according to the state machine specification found in `Mod'. The commands %% are not actually executed. -spec state_after(mod_name(), command_list()) -> symbolic_state(). state_after(Mod, Cmds) -> element(1, state_env_after(Mod, Cmds)). -spec state_env_after(mod_name(), command_list()) -> {symbolic_state(), [symb_var()]}. state_env_after(Mod, Cmds) -> lists:foldl(fun({init,S}, _) -> {S, []}; ({set,Var,Call}, {S,Vars}) -> {Mod:next_state(S, Var, Call), [Var|Vars]} end, {get_initial_state(Mod, Cmds), []}, Cmds). %% @doc Behaves like `lists:zip/2', but the input lists do no not necessarily %% have equal length. Zipping stops when the shortest list stops. This is %% useful for zipping a command sequence with its (failing) execution history. -spec zip([A], [B]) -> [{A,B}]. zip([A|X], [B|Y]) -> [{A,B}|zip(X, Y)]; zip(_, []) -> []; zip([], _) -> []. %% ----------------------------------------------------------------------------- %% Utility functions %% ----------------------------------------------------------------------------- %% @private -spec is_valid(mod_name(), symbolic_state(), command_list(), [symb_var()]) -> boolean(). is_valid(_Mod, _State, [], _SymbEnv) -> true; is_valid(Mod, _State, [{init,S}|Cmds], _SymbEnv) -> is_valid(Mod, S, Cmds, _SymbEnv); is_valid(Mod, State, [{set, Var, {call,_M,_F,A} = Call}|Cmds], SymbEnv) -> args_defined(A, SymbEnv) andalso Mod:precondition(State, Call) andalso is_valid(Mod, Mod:next_state(State, Var, Call), Cmds, [Var|SymbEnv]). %% @private -spec args_defined([term()], [symb_var()]) -> boolean(). args_defined(List, SymbEnv) -> lists:all(fun (A) -> arg_defined(A, SymbEnv) end, List). -spec arg_defined(term(), [symb_var()]) -> boolean(). arg_defined({var,I} = V, SymbEnv) when is_integer(I) -> lists:member(V, SymbEnv); arg_defined(Tuple, SymbEnv) when is_tuple(Tuple) -> args_defined(tuple_to_list(Tuple), SymbEnv); arg_defined(List, SymbEnv) when is_list(List) -> args_defined(List, SymbEnv); arg_defined(_, _) -> true. %% @private -spec get_initial_state(mod_name(), command_list()) -> symbolic_state(). get_initial_state(_, [{init,S}|_]) -> S; get_initial_state(Mod, Cmds) when is_list(Cmds) -> Mod:initial_state(). %% @private -spec fix_parallel(index(), non_neg_integer(), combination() | 'done', lookup(), mod_name(), symbolic_state(), [symb_var()], pos_integer()) -> [command_list()]. fix_parallel(_, 0, done, _, _, _, _, _) -> exit(error); %% not supposed to reach here fix_parallel(MaxIndex, Len, done, LookUp, Mod, State, SymbEnv, W) -> Comb = mk_first_comb(MaxIndex, Len-1, W), case Len of 1 -> io:format("f"); _ -> ok end, fix_parallel(MaxIndex, Len-1, Comb , LookUp, Mod, State, SymbEnv, W); fix_parallel(MaxIndex, Len, Comb, LookUp, Mod, State, SymbEnv, W) -> CmdLists = lookup_cmd_lists(Comb, LookUp), case can_parallelize(CmdLists, Mod, State, SymbEnv) of true -> lists:reverse(CmdLists); false -> C1 = proplists:get_value(1, Comb), C2 = proplists:get_value(2, Comb), Next = get_next(Comb, Len, MaxIndex, lists:sort(C1 ++ C2), W, 2), fix_parallel(MaxIndex, Len, Next, LookUp, Mod, State, SymbEnv, W) end. -spec can_parallelize([command_list()], mod_name(), symbolic_state(), [symb_var()]) -> boolean(). can_parallelize(CmdLists, Mod, State, SymbEnv) -> lists:all(fun(C) -> is_valid(Mod, State, C, SymbEnv) end, CmdLists) andalso lists:all(fun(C) -> is_valid(Mod, State, C, SymbEnv) end, possible_interleavings(CmdLists)). %% @private -spec possible_interleavings([command_list()]) -> [command_list()]. possible_interleavings([P1,P2]) -> insert_all(P1, P2); possible_interleavings([P1|Rest]) -> [I || L <- possible_interleavings(Rest), I <- insert_all(P1, L)]. %% @private %% Returns all possible insertions of the elements of the first list, %% preserving their order, inside the second list, i.e. all possible %% command interleavings between two parallel processes -spec insert_all([term()], [term()]) -> [[term()]]. insert_all([], List) -> [List]; insert_all([X], List) -> all_insertions(X, length(List) + 1, List); insert_all([X|[Y|Rest]], List) -> [L2 || L1 <- insert_all([Y|Rest], List), L2 <- all_insertions(X, index(Y, L1), L1)]. %% @private -spec all_insertions(term(), pos_integer(), [term()]) -> [[term()]]. all_insertions(X, Limit, List) -> all_insertions_tr(X, Limit, 0, [], List, []). -spec all_insertions_tr(term(), pos_integer(), non_neg_integer(), [term()], [term()], [[term()]]) -> [[term()]]. all_insertions_tr(X, Limit, LengthFront, Front, [], Acc) -> case LengthFront < Limit of true -> [Front ++ [X] | Acc]; false -> Acc end; all_insertions_tr(X, Limit, LengthFront, Front, Back = [BackH|BackT], Acc) -> case LengthFront < Limit of true -> all_insertions_tr(X, Limit, LengthFront+1, Front ++ [BackH], BackT, [Front ++ [X] ++ Back | Acc]); false -> Acc end. %% @private -spec index(term(), [term(),...]) -> index(). index(X, List) -> index(X, List, 1). -spec index(term(), [term(),...], index()) -> index(). index(X, [X|_], N) -> N; index(X, [_|Rest], N) -> index(X, Rest, N+1). %% @private -spec mk_dict(command_list(), pos_integer()) -> [{pos_integer(), command()}]. mk_dict([], _) -> []; mk_dict([{init,_}|T], N) -> mk_dict(T, N); mk_dict([H|T], N) -> [{N,H}|mk_dict(T, N+1)]. %% @private -spec mk_first_comb(pos_integer(), non_neg_integer(), pos_integer()) -> combination(). mk_first_comb(N, Len, W) -> mk_first_comb_tr(1, N, Len, [], W). -spec mk_first_comb_tr(pos_integer(), pos_integer(), non_neg_integer(), combination(), pos_integer()) -> combination(). mk_first_comb_tr(Start, N, _Len, Accum, 1) -> [{1,lists:seq(Start, N)}|Accum]; mk_first_comb_tr(Start, N, Len, Accum, W) -> K = Start + Len, mk_first_comb_tr(K, N, Len, [{W,lists:seq(Start, K-1)}|Accum], W-1). -spec lookup_cmds(indices(), lookup()) -> command_list(). lookup_cmds(Indices, LookUp) -> [orddict:fetch(Index, LookUp) || Index <- Indices]. -spec lookup_cmd_lists(combination(), lookup()) -> [command_list()]. lookup_cmd_lists(Combination, LookUp) -> [lookup_cmds(Indices, LookUp) || {_, Indices} <- Combination]. %% @private -spec get_next(combination(), non_neg_integer(), index(), indices(), pos_integer(), pos_integer()) -> combination() | 'done'. get_next(L, _Len, _MaxIndex, Available, _Workers, 1) -> [{1,Available}|proplists:delete(1, L)]; get_next(L, Len, MaxIndex, Available, Workers, N) -> C = case proplists:is_defined(N, L) of true -> next_comb(MaxIndex, proplists:get_value(N, L), Available); false -> lists:sublist(Available, Len) end, case C of done -> if N =:= Workers -> done; N =/= Workers -> C2 = proplists:get_value(N+1, L), NewList = [E || {M,_}=E <- L, M > N], get_next(NewList, Len, MaxIndex, lists:sort(C2 ++ Available), Workers, N+1) end; _ -> get_next([{N,C}|proplists:delete(N, L)], Len, MaxIndex, Available -- C, Workers, N-1) end. -spec next_comb(index(), indices(), indices()) -> indices() | 'done'. next_comb(MaxIndex, Indices, Available) -> Res = next_comb_tr(MaxIndex, lists:reverse(Indices), []), case is_well_defined(Res, Available) of true -> Res; false -> next_comb(MaxIndex, Res, Available) end. -spec is_well_defined(indices() | 'done', indices()) -> boolean(). is_well_defined(done, _) -> true; is_well_defined(Comb, Available) -> lists:usort(Comb) =:= Comb andalso lists:all(fun(X) -> lists:member(X, Available) end, Comb). -spec next_comb_tr(index(), indices(), indices()) -> indices() | 'done'. next_comb_tr(_MaxIndex, [], _Acc) -> done; next_comb_tr(MaxIndex, [MaxIndex | Rest], Acc) -> next_comb_tr(MaxIndex, Rest, [1 | Acc]); next_comb_tr(_MaxIndex, [X | Rest], Acc) -> lists:reverse(Rest, [X+1|Acc]). -spec remove_slice(index(), command_list(), [command_list(),...]) -> [command_list(),...]. remove_slice(Index, Slice, List) -> remove_slice_tr(Index, Slice, List, [], 1). -spec remove_slice_tr(index(), command_list(), [command_list(),...], [command_list()], pos_integer()) -> [command_list(),...]. remove_slice_tr(Index, Slice, [H|T], Acc, Index) -> lists:reverse(Acc, [H -- Slice] ++ T); remove_slice_tr(Index, Slice, [H|T], Acc, N) -> remove_slice_tr(Index, Slice, T, [H|Acc], N+1). -spec get_slices(command_list()) -> [command_list()]. get_slices(List) -> get_slices_tr(List, List, 1, []). -spec get_slices_tr(command_list(), command_list(), pos_integer(), [command_list()]) -> [command_list()]. get_slices_tr([], _, _, Acc) -> Acc; get_slices_tr([_|Tail], List, N, Acc) -> get_slices_tr(Tail, List, N+1, [lists:sublist(List, N)|Acc]). -spec spawn_link_cp(fun(() -> _)) -> pid(). spawn_link_cp(ActualFun) -> PDictStuff = [Pair || {K,_V} = Pair <- get(), is_atom(K), re:run(atom_to_list(K), ["^[$]"], [{capture,none}]) =:= match], Fun = fun() -> lists:foreach(fun({K,V}) -> put(K,V) end, PDictStuff), proper_arith:rand_reseed(), ActualFun() end, spawn_link(Fun). erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_symb.erl000066400000000000000000000335761255446327200231670ustar00rootroot00000000000000%%% Copyright 2010-2013 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc Symbolic datatypes handling functions. %%% %%% == Symbolic datatypes == %%% When writing properties that involve abstract data types, such as dicts or %%% sets, it is usually best to avoid dealing with the ADTs' internal %%% representation directly. Working, instead, with a symbolic representation of %%% the ADT's construction process (series of API calls) has several benefits: %%%
    %%%
  • Failing testcases are easier to read and understand. Compare: %%% ``` {call,sets,from_list,[[1,2,3]]} ''' %%% with: %%% ``` {set,3,16,16,8,80,48, %%% {[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[]}, %%% {{[],[3],[],[],[],[],[2],[],[],[],[],[1],[],[],[],[]}}} '''
  • %%%
  • Failing testcases are easier to shrink.
  • %%%
  • It is especially useful when testing the datatype itself: Certain %%% implementation errors may depend on some particular selection and %%% ordering of API calls, thus it is important to cover the entire ADT %%% construction API.
  • %%%
%%% %%% PropEr supports the symbolic representation of datatypes, using the %%% following syntax: %%%
%%%
`{call,Module,Function,Arguments}'
%%%
This represents a call to the API function `Module:Function' with %%% arguments `Arguments'. Each of the arguments may be a symbolic call itself %%% or contain other symbolic calls in lists or tuples of arbitrary %%% depth.
%%%
``{'$call',Module,Function,Arguments}''
%%%
Identical to the above, but gets evaluated automatically before being %%% applied to a property.
%%%
`{var,'{@type var_id()}`}'
%%%
This contruct serves as a placeholder for values that are not known at %%% type construction time. It will be replaced by the actual value of the %%% variable during evaluation.
%%%
%%% %%% When including the PropEr header file, all %%% API functions of this module are automatically %%% imported, unless `PROPER_NO_IMPORTS' is defined. %%% %%% == Auto-ADT == %%% To simplify the symbolic testing of ADTs, PropEr comes with the Auto-ADT %%% subsystem: An opaque native type, if exported from its module, is assumed %%% to be an abstract data type, causing PropEr to ignore its internal %%% representation and instead construct symbolic instances of the type. The %%% API functions used in these symbolic instances are extracted from the ADT's %%% defining module, which is expected to contain one or more `-spec'ed and %%% exported functions that can be used to construct instances of the ADT. %%% Specifically, PropEr will use all functions that return at least one %%% instance of the ADT. As with recursive native types, the base case is %%% automatically detected (in the case of ADTs, calls to functions like %%% `new/0' and `from_list/1' would be considered the base case). The produced %%% symbolic calls will be `$call' tuples, which are %%% automatically evaluated, thus no call to {@link eval/1} is required inside %%% the property. Produced instances are guaranteed to evaluate successfully. %%% Parametric ADTs are supported, so long as they appear fully instantiated %%% inside `?FORALL's. %%% %%% ADTs hard-coded in the Erlang type system (`array', `dict', `digraph', %%% `gb_set', `gb_tree', `queue', and `set') are automatically detected and %%% handled as such. PropEr also accepts parametric versions of the above ADTs %%% in `?FORALL's (`array/1', `dict/2', `gb_set/1', `gb_tree/2', `queue/1', %%% `set/1', also `orddict/2' and `ordset/1'). If you would like to use these %%% parametric versions in `-type' and `-spec' declarations as well, to better %%% document your code and facilitate spec testing, you can include the %%% complementary header file `proper/include/proper_param_adts.hrl', which %%% provides the corresponding `-type' definitions. Please note that Dialyzer %%% currenty treats these the same way as their non-parametric counterparts. %%% %%% The use of Auto-ADT is currently subject to the following limitations: %%%
    %%%
  • In the ADT's `-opaque' declaration, as in all types' declarations, %%% only type variables should be used as parameters in the LHS. None of %%% these variables can be the special `_' variable and no variable should %%% appear more than once in the parameters.
  • %%%
  • ADTs inside specs can only have simple variables as parameters. These %%% variables cannot be bound by any is_subtype constraint. Also, the special %%% `_' variable is not allowed in ADT parameters. If this would result in %%% singleton variables, as in the specs of functions like `new/0', use %%% variable names that begin with an underscore.
  • %%%
  • Specs that introduce an implicit binding among the parameters of an %%% ADT are rejected, e.g.: %%% ``` -spec foo(mydict(T,S),mydict(S,T)) -> mydict(T,S). ''' %%% This includes using the same type variable twice in the parameters of %%% an ADT.
  • %%%
  • While parsing the return type of specs in search of ADT references, %%% PropEr only recurses into tuples, unions and lists; all other constructs %%% are ignored. This prohibits, among others, indirect references to the ADT %%% through other custom types and records.
  • %%%
  • When encountering a union in the return type, PropEr will pick the %%% first choice that can return an ADT. This choice must be distinguishable %%% from the others either by having a unique term structure or by having a %%% unique tag (if it's a tagged tuple).
  • %%%
  • When parsing multi-clause specs, only the first clause is considered. %%%
  • %%%
  • The only spec constraints we accept are `is_subtype' constraints whose %%% first argument is a simple, non-`_' variable. It is not checked whether or %%% not these variables actually appear in the spec. The second argument of an %%% `is_subtype' constraint cannot contain any non-`_' variables. Multiple %%% constraints for the same variable are not supported.
  • %%%
  • Unexported opaques and opaques with no suitable specs to serve as API %%% calls are silently discarded. Those will be treated like ordinary types. %%%
  • %%%
  • Unexported or unspecced functions are silently rejected.
  • %%%
  • Functions with unsuitable return values are silently rejected.
  • %%%
  • Specs that make bad use of variables are silently rejected.
  • %%%
%%% %%% For an example on how to write Auto-ADT-compatible parametric specs, see %%% the `examples/stack' module, which contains a simple implementation of a %%% stack, or the `proper/proper_dict module', which wraps the `STDLIB' `dict' %%% ADT. -module(proper_symb). -export([eval/1, eval/2, defined/1, well_defined/1, pretty_print/1, pretty_print/2]). -export([internal_eval/1, internal_well_defined/1]). -export_type([var_values/0]). -include("proper_internal.hrl"). %%------------------------------------------------------------------------------ %% Types %%------------------------------------------------------------------------------ %% -type symb_call() :: {'call' | '$call',mod_name(),fun_name(),[symb_term()]}. %% TODO: only atoms are allowed as variable identifiers? -type var_id() :: atom() | pos_integer(). -type var_values() :: [{var_id(),term()}]. %% @type symb_term() -type symb_term() :: term(). -type handled_term() :: term(). -type caller() :: 'user' | 'system'. -type call_handler() :: fun((mod_name(),fun_name(),[handled_term()]) -> handled_term()). -type term_handler() :: fun((term()) -> handled_term()). -type handle_info() :: {caller(),call_handler(),term_handler()}. %%------------------------------------------------------------------------------ %% Evaluation functions %%------------------------------------------------------------------------------ %% @equiv eval([], SymbTerm) -spec eval(symb_term()) -> term(). eval(SymbTerm) -> eval([], SymbTerm). %% @doc Intended for use inside the property-testing code, this function %% evaluates a symbolic instance `SymbTerm'. It also accepts a proplist %% `VarValues' that maps variable names to values, which is used to replace any %% var tuples inside `SymbTerm' before proceeding with its %% evaluation. -spec eval(var_values(), symb_term()) -> term(). eval(VarValues, SymbTerm) -> eval(VarValues, SymbTerm, user). -spec eval(var_values(), symb_term(), caller()) -> term(). eval(VarValues, SymbTerm, Caller) -> HandleInfo = {Caller, fun erlang:apply/3, fun(X) -> X end}, symb_walk(VarValues, SymbTerm, HandleInfo). %% @private -spec internal_eval(symb_term()) -> term(). internal_eval(SymbTerm) -> eval([], SymbTerm, system). %% @doc Returns true if the `SymbTerm' symbolic instance can be successfully %% evaluated (its evaluation doesn't raise an error or exception). -spec defined(symb_term()) -> boolean(). defined(SymbTerm) -> defined(SymbTerm, user). -spec defined(symb_term(), caller()) -> boolean(). defined(SymbTerm, Caller) -> try eval([], SymbTerm, Caller) of _Term -> true catch _Exception:_Reason -> false end. %% @doc An attribute which can be applied to any symbolic generator `SymbType' %% that may produce invalid sequences of operations when called. The resulting %% generator is guaranteed to only produce well-defined symbolic instances. -spec well_defined(proper_types:raw_type()) -> proper_types:type(). well_defined(SymbType) -> well_defined(SymbType, user). -spec well_defined(proper_types:raw_type(), caller()) -> proper_types:type(). well_defined(SymbType, Caller) -> ?SUCHTHAT(X, SymbType, defined(X,Caller)). %% @private -spec internal_well_defined(proper_types:type()) -> proper_types:type(). internal_well_defined(SymbType) -> well_defined(SymbType, system). %%------------------------------------------------------------------------------ %% Pretty-printing functions %%------------------------------------------------------------------------------ %% @equiv pretty_print([], SymbTerm) -spec pretty_print(symb_term()) -> string(). pretty_print(SymbTerm) -> pretty_print([], SymbTerm). %% @doc Similar in calling convention to {@link eval/2}, but returns a string %% representation of the call sequence `SymbTerm' instead of evaluating it. -spec pretty_print(var_values(), symb_term()) -> string(). pretty_print(VarValues, SymbTerm) -> HandleInfo = {user, fun parse_fun/3, fun parse_term/1}, ExprTree = symb_walk(VarValues, SymbTerm, HandleInfo), lists:flatten(erl_pp:expr(ExprTree)). -spec parse_fun(mod_name(), fun_name(), [abs_expr()]) -> abs_expr(). parse_fun(Module, Function, ArgTreeList) -> {call,0,{remote,0,{atom,0,Module},{atom,0,Function}},ArgTreeList}. -spec parse_term(term()) -> abs_expr(). parse_term(TreeList) when is_list(TreeList) -> {RestOfList, Acc0} = case proper_arith:cut_improper_tail(TreeList) of {_ProperHead,_ImproperTail} = X -> X; ProperList -> {ProperList,{nil,0}} end, lists:foldr(fun(X,Acc) -> {cons,0,X,Acc} end, Acc0, RestOfList); parse_term(TreeTuple) when is_tuple(TreeTuple) -> {tuple,0,tuple_to_list(TreeTuple)}; parse_term(Term) -> %% TODO: pid, port, reference, function value? erl_parse:abstract(Term). %%------------------------------------------------------------------------------ %% Generic symbolic handler function %%------------------------------------------------------------------------------ -spec symb_walk(var_values(), symb_term(), handle_info()) -> handled_term(). symb_walk(VarValues, {call,Mod,Fun,Args}, {user,_HandleCall,_HandleTerm} = HandleInfo) -> symb_walk_call(VarValues, Mod, Fun, Args, HandleInfo); symb_walk(VarValues, {'$call',Mod,Fun,Args}, HandleInfo) -> symb_walk_call(VarValues, Mod, Fun, Args, HandleInfo); symb_walk(VarValues, {var,VarId}, {user,_HandleCall,HandleTerm} = HandleInfo) -> SymbWalk = fun(X) -> symb_walk(VarValues, X, HandleInfo) end, case lists:keyfind(VarId, 1, VarValues) of {VarId,VarValue} -> %% TODO: this allows symbolic calls and vars inside var values, %% which may result in an infinite loop, as in: %% [{a,{call,m,f,[{var,a}]}}], {var,a} SymbWalk(VarValue); false -> HandleTerm({HandleTerm(var),SymbWalk(VarId)}) end; symb_walk(VarValues, SymbTerm, HandleInfo) -> symb_walk_gen(VarValues, SymbTerm, HandleInfo). -spec symb_walk_call(var_values(), mod_name(), fun_name(), [symb_term()], handle_info()) -> handled_term(). symb_walk_call(VarValues, Mod, Fun, Args, {_Caller,HandleCall,_HandleTerm} = HandleInfo) -> SymbWalk = fun(X) -> symb_walk(VarValues, X, HandleInfo) end, HandledArgs = [SymbWalk(A) || A <- Args], HandleCall(Mod, Fun, HandledArgs). -spec symb_walk_gen(var_values(), symb_term(), handle_info()) -> handled_term(). symb_walk_gen(VarValues, SymbTerm, {_Caller,_HandleCall,HandleTerm} = HandleInfo) -> SymbWalk = fun(X) -> symb_walk(VarValues, X, HandleInfo) end, Term = if is_list(SymbTerm) -> proper_arith:safe_map(SymbWalk, SymbTerm); is_tuple(SymbTerm) -> proper_arith:tuple_map(SymbWalk, SymbTerm); true -> SymbTerm end, HandleTerm(Term). erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_transformer.erl000066400000000000000000000377021255446327200245520ustar00rootroot00000000000000%%% Copyright 2010-2015 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2015 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc PropEr's main parse transform. It is automatically applied to modules %%% when including the main PropEr header, unless `PROPER_NO_TRANS' is defined. %%% Applying this transform has the following effects: %%%
    %%%
  • All 0-arity functions whose name begins with `prop_' are automatically %%% exported.
  • %%%
  • Type declarations in `?FORALL's that correspond to native types are %%% properly substituted (with some limitations, see the %%% {@link proper_typeserver} module for details).
  • %%%
-module(proper_transformer). -export([parse_transform/2]). -export_type([]). -include("proper_internal.hrl"). %%------------------------------------------------------------------------------ %% Types %%------------------------------------------------------------------------------ -record(mod_info, {name :: mod_name(), export_all = false :: boolean(), funs = sets:new() :: proper_typeserver:mod_exp_funs(), imports = sets:new() :: proper_typeserver:mod_exp_funs(), no_autos = sets:new() :: proper_typeserver:mod_exp_funs(), exp_types = sets:new() :: proper_typeserver:mod_exp_types(), exp_funs = sets:new() :: proper_typeserver:mod_exp_funs(), helper_pid :: pid() | 'undefined'}). -type mod_info() :: #mod_info{}. -ifdef(NO_MODULES_IN_OPAQUES). -type exp_dict() :: dict(). -else. -type exp_mod_data () :: 'nodata' | {'data', proper_typeserver:mod_exp_types(), proper_typeserver:mod_exp_funs()}. -type exp_dict() :: dict:dict(mod_name(), exp_mod_data()). -endif. %%------------------------------------------------------------------------------ %% Top-level functions %%------------------------------------------------------------------------------ %% @private -spec parse_transform([abs_form()], [compile:option()]) -> [abs_form()]. parse_transform(Forms, Options) -> RawModInfo = collect_info(Forms, Options), #mod_info{name = ModName, export_all = ExportAll, funs = AllFuns, exp_types = ExpTypes, exp_funs = RawExpFuns} = RawModInfo, {ExpFuns,PropsToExport} = case ExportAll of true -> {AllFuns, []}; false -> AllProps = sets:filter(fun is_prop/1, AllFuns), {RawExpFuns, sets:to_list(sets:subtract(AllProps,RawExpFuns))} end, HelperPid = helper_start(ModName, ExpTypes, ExpFuns), ModInfo = RawModInfo#mod_info{helper_pid = HelperPid}, NewForms = [rewrite_form(F,ModInfo) || F <- Forms], helper_stop(HelperPid), add_exports(NewForms, PropsToExport). -spec collect_info([abs_form()], [compile:option()]) -> mod_info(). collect_info(Forms, Options) -> StartModInfo = add_options(#mod_info{}, Options), lists:foldl(fun add_info/2, StartModInfo, Forms). -spec add_options(mod_info(), compile:option() | [compile:option()]) -> mod_info(). add_options(ModInfo, []) -> ModInfo; add_options(ModInfo, [export_all | Rest]) -> add_options(ModInfo#mod_info{export_all = true}, Rest); add_options(#mod_info{no_autos = NoAutos} = ModInfo, [{no_auto_import,FunsList} | Rest]) -> NewNoAutos = sets:union(sets:from_list(FunsList), NoAutos), add_options(ModInfo#mod_info{no_autos = NewNoAutos}, Rest); add_options(ModInfo, [_OtherOption | Rest]) -> add_options(ModInfo, Rest); add_options(ModInfo, SingleOption) -> add_options(ModInfo, [SingleOption]). -spec add_info(abs_form(), mod_info()) -> mod_info(). add_info({attribute,_Line,module,ModName}, ModInfo) -> ModInfo#mod_info{name = ModName}; add_info({function,_Line,Name,Arity,_Clauses}, #mod_info{funs = Funs} = ModInfo) -> NewFuns = sets:add_element({Name,Arity}, Funs), ModInfo#mod_info{funs = NewFuns}; add_info({attribute,_Line,import,{_FromMod,MoreImports}}, #mod_info{imports = Imports} = ModInfo) -> NewImports = sets:union(sets:from_list(MoreImports), Imports), ModInfo#mod_info{imports = NewImports}; add_info({attribute,_Line,export_type,MoreExpTypes}, #mod_info{exp_types = ExpTypes} = ModInfo) -> NewExpTypes = sets:union(sets:from_list(MoreExpTypes), ExpTypes), ModInfo#mod_info{exp_types = NewExpTypes}; add_info({attribute,_Line,export,MoreExpFuns}, #mod_info{exp_funs = ExpFuns} = ModInfo) -> NewExpFuns = sets:union(sets:from_list(MoreExpFuns), ExpFuns), ModInfo#mod_info{exp_funs = NewExpFuns}; add_info({attribute,_Line,compile,Options}, ModInfo) -> add_options(ModInfo, Options); add_info(_Form, ModInfo) -> ModInfo. -spec is_prop({fun_name(),arity()}) -> boolean(). is_prop({Name,0}) -> lists:prefix(?PROPERTY_PREFIX, atom_to_list(Name)); is_prop(_) -> false. -spec add_exports([abs_form()], [{fun_name(),arity()}]) -> [abs_form()]. add_exports([], _ToExport) -> []; add_exports([{attribute,_,module,_} = ModAttr | Rest], ToExport) -> ExpAttr = {attribute,0,export,ToExport}, [ModAttr, ExpAttr | Rest]; add_exports([Form | Rest], ToExport) -> [Form | add_exports(Rest, ToExport)]. %%------------------------------------------------------------------------------ %% Helper server interface %%------------------------------------------------------------------------------ -spec helper_start(mod_name(), proper_typeserver:mod_exp_types(), proper_typeserver:mod_exp_funs()) -> pid(). helper_start(Mod, ModExpTypes, ModExpFuns) -> spawn(fun() -> helper_init(Mod,ModExpTypes,ModExpFuns) end). -spec helper_stop(pid()) -> 'ok'. helper_stop(HelperPid) -> HelperPid ! stop, ok. -spec is_exported_type(mod_name(), atom(), arity(), pid()) -> boolean(). is_exported_type(Mod, Call, Arity, HelperPid) -> HelperPid ! {is_exported_type,self(),Mod,Call,Arity}, receive Answer -> Answer end. -spec helper_init(mod_name(), proper_typeserver:mod_exp_types(), proper_typeserver:mod_exp_funs()) -> 'ok'. helper_init(Mod, ModExpTypes, ModExpFuns) -> ExpDict = dict:from_list([{Mod,{data,ModExpTypes,ModExpFuns}}]), helper_loop(ExpDict). -spec helper_loop(exp_dict()) -> 'ok'. helper_loop(ExpDict) -> receive stop -> ok; {is_exported_type,From,Mod,Call,Arity} -> NewExpDict = add_module(Mod, ExpDict), Answer = case dict:fetch(Mod, NewExpDict) of {data,ModExpTypes,ModExpFuns} -> CallRef = {Call,Arity}, not sets:is_element(CallRef, ModExpFuns) andalso sets:is_element(CallRef, ModExpTypes); nodata -> false end, From ! Answer, helper_loop(NewExpDict) end. -spec add_module(mod_name(), exp_dict()) -> exp_dict(). add_module(Mod, ExpDict) -> case dict:is_key(Mod, ExpDict) of true -> ExpDict; false -> case proper_typeserver:get_exp_info(Mod) of {ok,ModExpTypes,ModExpFuns} -> dict:store(Mod, {data,ModExpTypes,ModExpFuns}, ExpDict); {error,_Reason} -> dict:store(Mod, nodata, ExpDict) end end. %%------------------------------------------------------------------------------ %% ?FORALL detection functions %%------------------------------------------------------------------------------ -spec rewrite_form(abs_form(), mod_info()) -> abs_form(). rewrite_form({attribute,Line,record,{RecName,FieldInits}}, ModInfo) -> NewFieldInits = [rewrite_field_init(F,ModInfo) || F <- FieldInits], {attribute,Line,record,{RecName,NewFieldInits}}; rewrite_form({function,Line,Name,Arity,Clauses}, ModInfo) -> NewClauses = [rewrite_clause(C,ModInfo) || C <- Clauses], {function,Line,Name,Arity,NewClauses}; rewrite_form(Form, _ModInfo) -> Form. -spec rewrite_field_init(abs_rec_field(), mod_info()) -> abs_rec_field(). rewrite_field_init({record_field,_Line,_FieldName} = FieldInit, _ModInfo) -> FieldInit; rewrite_field_init({record_field,Line,FieldName,InitExpr}, ModInfo) -> {record_field,Line,FieldName,rewrite_expr(InitExpr,ModInfo)}. -spec rewrite_clause(abs_clause(), mod_info()) -> abs_clause(). rewrite_clause({clause,Line,PatSeq,Guards,Body}, ModInfo) -> NewPatSeq = [rewrite_expr(P,ModInfo) || P <- PatSeq], NewBody = [rewrite_expr(E,ModInfo) || E <- Body], {clause,Line,NewPatSeq,Guards,NewBody}. %% This also covers some other constructs that don't clash with expressions: %% binary element specifications, list and binary comprehension generators and %% filters, remote function references. It also covers patterns. -spec rewrite_expr(abs_expr(), mod_info()) -> abs_expr(). rewrite_expr({match,Line,Pattern,Expr}, ModInfo) -> NewPattern = rewrite_expr(Pattern, ModInfo), NewExpr = rewrite_expr(Expr, ModInfo), {match,Line,NewPattern,NewExpr}; rewrite_expr({tuple,Line,FieldExprs}, ModInfo) -> NewFieldExprs = [rewrite_expr(F,ModInfo) || F <- FieldExprs], {tuple,Line,NewFieldExprs}; rewrite_expr({cons,Line,HeadExpr,TailExpr}, ModInfo) -> NewHeadExpr = rewrite_expr(HeadExpr, ModInfo), NewTailExpr = rewrite_expr(TailExpr, ModInfo), {cons,Line,NewHeadExpr,NewTailExpr}; rewrite_expr({bin,Line,BinElems}, ModInfo) -> NewBinElems = [rewrite_expr(B,ModInfo) || B <- BinElems], {bin,Line,NewBinElems}; rewrite_expr({bin_element,Line,ValueExpr,Size,TSL}, ModInfo) -> {bin_element,Line,rewrite_expr(ValueExpr,ModInfo),Size,TSL}; rewrite_expr({op,Line,Op,LeftExpr,RightExpr}, ModInfo) -> NewLeftExpr = rewrite_expr(LeftExpr, ModInfo), NewRightExpr = rewrite_expr(RightExpr, ModInfo), {op,Line,Op,NewLeftExpr,NewRightExpr}; rewrite_expr({op,Line,Op,Expr}, ModInfo) -> {op,Line,Op,rewrite_expr(Expr,ModInfo)}; rewrite_expr({record,Line,RecName,FieldInits}, ModInfo) -> NewFieldInits = [rewrite_field_init(F,ModInfo) || F <- FieldInits], {record,Line,RecName,NewFieldInits}; rewrite_expr({record,Line,RecExpr,RecName,FieldInits}, ModInfo) -> NewRecExpr = rewrite_expr(RecExpr, ModInfo), NewFieldInits = [rewrite_field_init(F,ModInfo) || F <- FieldInits], {record,Line,NewRecExpr,RecName,NewFieldInits}; rewrite_expr({record_field,Line,RecExpr,RecName,FieldName}, ModInfo) -> {record_field,Line,rewrite_expr(RecExpr,ModInfo),RecName,FieldName}; rewrite_expr({'catch',Line,Expr}, ModInfo) -> {'catch',Line,rewrite_expr(Expr,ModInfo)}; rewrite_expr({call,Line, {remote,_,{atom,_,proper},{atom,_,forall}} = FunRef, [RawType,Prop]}, ModInfo) -> NewRawType = rewrite_type(RawType, ModInfo), NewProp = rewrite_expr(Prop, ModInfo), {call,Line,FunRef,[NewRawType,NewProp]}; rewrite_expr({call,Line,FunRef,Args}, ModInfo) -> NewFunRef = rewrite_expr(FunRef, ModInfo), NewArgs = [rewrite_expr(A,ModInfo) || A <- Args], {call,Line,NewFunRef,NewArgs}; rewrite_expr({remote,Line,ModExpr,FunExpr}, ModInfo) -> NewModExpr = rewrite_expr(ModExpr, ModInfo), NewFunExpr = rewrite_expr(FunExpr, ModInfo), {remote,Line,NewModExpr,NewFunExpr}; rewrite_expr({lc,Line,Expr,GensAndFilters}, ModInfo) -> NewExpr = rewrite_expr(Expr, ModInfo), NewGensAndFilters = [rewrite_expr(W,ModInfo) || W <- GensAndFilters], {lc,Line,NewExpr,NewGensAndFilters}; rewrite_expr({bc,Line,Expr,GensAndFilters}, ModInfo) -> NewExpr = rewrite_expr(Expr, ModInfo), NewGensAndFilters = [rewrite_expr(W,ModInfo) || W <- GensAndFilters], {bc,Line,NewExpr,NewGensAndFilters}; rewrite_expr({generate,Line,Pattern,Expr}, ModInfo) -> NewPattern = rewrite_expr(Pattern, ModInfo), NewExpr = rewrite_expr(Expr, ModInfo), {generate,Line,NewPattern,NewExpr}; rewrite_expr({b_generate,Line,Pattern,Expr}, ModInfo) -> NewPattern = rewrite_expr(Pattern, ModInfo), NewExpr = rewrite_expr(Expr, ModInfo), {b_generate,Line,NewPattern,NewExpr}; rewrite_expr({block,Line,Body}, ModInfo) -> NewBody = [rewrite_expr(E,ModInfo) || E <- Body], {block,Line,NewBody}; rewrite_expr({'if',Line,Clauses}, ModInfo) -> NewClauses = [rewrite_clause(C,ModInfo) || C <- Clauses], {'if',Line,NewClauses}; rewrite_expr({'case',Line,Expr,Clauses}, ModInfo) -> NewExpr = rewrite_expr(Expr, ModInfo), NewClauses = [rewrite_clause(C,ModInfo) || C <- Clauses], {'case',Line,NewExpr,NewClauses}; rewrite_expr({'try',Line,Body1,Clauses1,Clauses2,Body2}, ModInfo) -> NewBody1 = [rewrite_expr(E,ModInfo) || E <- Body1], NewClauses1 = [rewrite_clause(C,ModInfo) || C <- Clauses1], NewClauses2 = [rewrite_clause(C,ModInfo) || C <- Clauses2], NewBody2 = [rewrite_expr(E,ModInfo) || E <- Body2], {'try',Line,NewBody1,NewClauses1,NewClauses2,NewBody2}; rewrite_expr({'receive',Line,Clauses}, ModInfo) -> NewClauses = [rewrite_clause(C,ModInfo) || C <- Clauses], {'receive',Line,NewClauses}; rewrite_expr({'receive',Line,Clauses,AfterExpr,AfterBody}, ModInfo) -> NewClauses = [rewrite_clause(C,ModInfo) || C <- Clauses], NewAfterExpr = rewrite_expr(AfterExpr, ModInfo), NewAfterBody = [rewrite_expr(E,ModInfo) || E <- AfterBody], {'receive',Line,NewClauses,NewAfterExpr,NewAfterBody}; rewrite_expr({'fun',Line,{clauses,Clauses}}, ModInfo) -> NewClauses = [rewrite_clause(C,ModInfo) || C <- Clauses], {'fun',Line,{clauses,NewClauses}}; rewrite_expr({'query',Line,ListCompr}, ModInfo) -> {'query',Line,rewrite_expr(ListCompr,ModInfo)}; rewrite_expr({record_field,Line,Expr,FieldName}, ModInfo) -> {record_field,Line,rewrite_expr(Expr,ModInfo),FieldName}; rewrite_expr(Expr, _ModInfo) -> Expr. %%------------------------------------------------------------------------------ %% Type rewriting functions %%------------------------------------------------------------------------------ -spec rewrite_type(abs_expr(), mod_info()) -> abs_expr(). rewrite_type({tuple,Line,FieldExprs}, ModInfo) -> NewFieldExprs = [rewrite_type(F,ModInfo) || F <- FieldExprs], {tuple,Line,NewFieldExprs}; rewrite_type({cons,Line,HeadExpr,TailExpr}, ModInfo) -> NewHeadExpr = rewrite_type(HeadExpr, ModInfo), NewTailExpr = rewrite_type(TailExpr, ModInfo), {cons,Line,NewHeadExpr,NewTailExpr}; rewrite_type({op,Line,'++',LeftExpr,RightExpr}, ModInfo) -> NewLeftExpr = rewrite_type(LeftExpr, ModInfo), NewRightExpr = rewrite_type(RightExpr, ModInfo), {op,Line,'++',NewLeftExpr,NewRightExpr}; rewrite_type({call,Line,{remote,_,{atom,_,Mod},{atom,_,Call}} = FunRef, Args} = Expr, #mod_info{name = ModName, helper_pid = HelperPid} = ModInfo) -> case is_exported_type(Mod, Call, length(Args), HelperPid) of true -> native_type_call(ModName, Expr); false -> NewArgs = [rewrite_type(A,ModInfo) || A <- Args], {call,Line,FunRef,NewArgs} end; rewrite_type({call,Line,{atom,_,Fun} = FunRef,Args} = Expr, #mod_info{name = ModName, funs = Funs, imports = Imports, no_autos = NoAutos} = ModInfo) -> Arity = length(Args), CallRef = {Fun,Arity}, case sets:is_element(CallRef,Funs) orelse sets:is_element(CallRef,Imports) orelse erl_internal:bif(Fun,Arity) andalso not sets:is_element(CallRef,NoAutos) of true -> NewArgs = [rewrite_type(A,ModInfo) || A <- Args], {call,Line,FunRef,NewArgs}; false -> native_type_call(ModName, Expr) end; rewrite_type(Expr, _ModInfo) -> Expr. -spec native_type_call(mod_name(), abs_expr()) -> abs_expr(). native_type_call(ModName, Expr) -> AbsModName = {atom,0,ModName}, AbsTypeStr = {string,0,lists:flatten(erl_pp:expr(Expr))}, FunRef = {remote,0,{atom,0,proper_types},{atom,0,native_type}}, {call,0,FunRef,[AbsModName,AbsTypeStr]}. erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_types.erl000066400000000000000000001423141255446327200233500ustar00rootroot00000000000000%%% Copyright 2010-2013 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc Type manipulation functions and predefined types. %%% %%% == Basic types == %%% This module defines all the basic types of the PropEr type system as %%% functions. See the function index for an overview. %%% %%% Types can be combined in tuples or lists to produce other types. Exact %%% values (such as exact numbers, atoms, binaries and strings) can be combined %%% with types inside such structures, like in this example of the type of a %%% tagged tuple: ``{'result', integer()}''. %%% %%% When including the PropEr header file, all %%% API functions of this module are automatically %%% imported, unless `PROPER_NO_IMPORTS' is defined. %%% %%% == Customized types == %%% The following operators can be applied to basic types in order to produce %%% new ones: %%% %%%
%%%
`?LET(, , )'
%%%
To produce an instance of this type, all appearances of the variables %%% in `' are replaced inside `' by their corresponding values in a %%% randomly generated instance of `'. It's OK for the `' part to %%% evaluate to a type - in that case, an instance of the inner type is %%% generated recursively.
%%%
`?SUCHTHAT(, , )'
%%%
This produces a specialization of `', which only includes those %%% members of `' that satisfy the constraint `' - that is, %%% those members for which the function `fun() -> end' returns %%% `true'. If the constraint is very strict - that is, only a small %%% percentage of instances of `' pass the test - it will take a lot of %%% tries for the instance generation subsystem to randomly produce a valid %%% instance. This will result in slower testing, and testing may even be %%% stopped short, in case the `constraint_tries' limit is reached (see the %%% "Options" section in the documentation of the {@link proper} module). If %%% this is the case, it would be more appropriate to generate valid instances %%% of the specialized type using the `?LET' macro. Also make sure that even %%% small instances can satisfy the constraint, since PropEr will only try %%% small instances at the start of testing. If this is not possible, you can %%% instruct PropEr to start at a larger size, by supplying a suitable value %%% for the `start_size' option (see the "Options" section in the %%% documentation of the {@link proper} module).
%%%
`?SUCHTHATMAYBE(, , )'
%%%
Equivalent to the `?SUCHTHAT' macro, but the constraint `' %%% is considered non-strict: if the `constraint_tries' limit is reached, the %%% generator will just return an instance of `' instead of failing, %%% even if that instance doesn't satisfy the constraint.
%%%
`?SHRINK(, )'
%%%
This creates a type whose instances are generated by evaluating the %%% statement block `' (this may evaluate to a type, which will %%% then be generated recursively). If an instance of such a type is to be %%% shrunk, the generators in `' are first run to produce %%% hopefully simpler instances of the type. Thus, the generators in the %%% second argument should be simpler than the default. The simplest ones %%% should be at the front of the list, since those are the generators %%% preferred by the shrinking subsystem. Like the main `', the %%% alternatives may also evaluate to a type, which is generated recursively. %%%
%%%
`?LETSHRINK(, , )'
%%%
This is created by combining a `?LET' and a `?SHRINK' macro. Instances %%% are generated by applying a randomly generated list of values inside %%% `' (just like a `?LET', with the added constraint that the %%% variables and types must be provided in a list - alternatively, %%% `' may be a list or vector type). When shrinking instances %%% of such a type, the sub-instances that were combined to produce it are %%% first tried in place of the failing instance.
%%%
`?LAZY()'
%%%
This construct returns a type whose only purpose is to delay the %%% evaluation of `' (`' can return a type, which will %%% be generated recursively). Using this, you can simulate the lazy %%% generation of instances: %%% ``` stream() -> ?LAZY(frequency([ {1,[]}, {3,[0|stream()]} ])). ''' %%% The above type produces lists of zeroes with an average length of 3. Note %%% that, had we not enclosed the generator with a `?LAZY' macro, the %%% evaluation would continue indefinitely, due to the eager evaluation of %%% the Erlang language.
%%%
`non_empty()'
%%%
See the documentation for {@link non_empty/1}.
%%%
`noshrink()'
%%%
See the documentation for {@link noshrink/1}.
%%%
`default(, )'
%%%
See the documentation for {@link default/2}.
%%%
`with_parameter(, , )'
%%%
See the documentation for {@link with_parameter/3}.
%%%
`with_parameters(, )'
%%%
See the documentation for {@link with_parameters/2}.
%%%
%%% %%% == Size manipulation == %%% The following operators are related to the `size' parameter, which controls %%% the maximum size of produced instances. The actual size of a produced %%% instance is chosen randomly, but can never exceed the value of the `size' %%% parameter at the moment of generation. A more accurate definition is the %%% following: the maximum instance of `size S' can never be smaller than the %%% maximum instance of `size S-1'. The actual size of an instance is measured %%% differently for each type: the actual size of a list is its length, while %%% the actual size of a tree may be the number of its internal nodes. Some %%% types, e.g. unions, have no notion of size, thus their generation is not %%% influenced by the value of `size'. The `size' parameter starts at 1 and %%% grows automatically during testing. %%% %%%
%%%
`?SIZED(, )'
%%%
Creates a new type, whose instances are produced by replacing all %%% appearances of the `' parameter inside the statement block %%% `' with the value of the `size' parameter. It's OK for the %%% `' to return a type - in that case, an instance of the inner %%% type is generated recursively.
%%%
`resize(, )'
%%%
See the documentation for {@link resize/2}.
%%%
-module(proper_types). -export([is_inst/2, is_inst/3]). -export([integer/2, float/2, atom/0, binary/0, binary/1, bitstring/0, bitstring/1, list/1, vector/2, union/1, weighted_union/1, tuple/1, loose_tuple/1, exactly/1, fixed_list/1, function/2, any/0, shrink_list/1, safe_union/1, safe_weighted_union/1]). -export([integer/0, non_neg_integer/0, pos_integer/0, neg_integer/0, range/2, float/0, non_neg_float/0, number/0, boolean/0, byte/0, char/0, list/0, tuple/0, string/0, wunion/1, term/0, timeout/0, arity/0]). -export([int/0, nat/0, largeint/0, real/0, bool/0, choose/2, elements/1, oneof/1, frequency/1, return/1, default/2, orderedlist/1, function0/1, function1/1, function2/1, function3/1, function4/1, weighted_default/2]). -export([resize/2, non_empty/1, noshrink/1]). -export([cook_outer/1, is_type/1, equal_types/2, is_raw_type/1, to_binary/1, from_binary/1, get_prop/2, find_prop/2, safe_is_instance/2, is_instance/2, unwrap/1, weakly/1, strongly/1, satisfies_all/2, new_type/2, subtype/2]). -export([lazy/1, sized/1, bind/3, shrinkwith/2, add_constraint/3, native_type/2, distlist/3, with_parameter/3, with_parameters/2, parameter/1, parameter/2]). -export([le/2]). -export_type([type/0, raw_type/0, extint/0, extnum/0]). -include("proper_internal.hrl"). %%------------------------------------------------------------------------------ %% Comparison with erl_types %%------------------------------------------------------------------------------ %% Missing types %% ------------------- %% will do: %% records, maybe_improper_list(T,S), nonempty_improper_list(T,S) %% maybe_improper_list(), maybe_improper_list(T), iolist, iodata %% don't need: %% nonempty_{list,string,maybe_improper_list} %% won't do: %% pid, port, ref, identifier, none, no_return, module, mfa, node %% array, dict, digraph, set, gb_tree, gb_set, queue, tid %% Missing type information %% ------------------------ %% bin types: %% other unit sizes? what about size info? %% functions: %% generally some fun, unspecified number of arguments but specified %% return type %% any: %% doesn't cover functions and improper lists %%------------------------------------------------------------------------------ %% Type declaration macros %%------------------------------------------------------------------------------ -define(BASIC(PropList), new_type(PropList,basic)). -define(WRAPPER(PropList), new_type(PropList,wrapper)). -define(CONSTRUCTED(PropList), new_type(PropList,constructed)). -define(CONTAINER(PropList), new_type(PropList,container)). -define(SUBTYPE(Type,PropList), subtype(PropList,Type)). %%------------------------------------------------------------------------------ %% Types %%------------------------------------------------------------------------------ -type type_kind() :: 'basic' | 'wrapper' | 'constructed' | 'container' | atom(). -type instance_test() :: fun((proper_gen:imm_instance()) -> boolean()) | {'typed', fun((proper_types:type(), proper_gen:imm_instance()) -> boolean())}. -type index() :: pos_integer(). %% @alias -type value() :: term(). %% @private_type %% @alias -type extint() :: integer() | 'inf'. %% @private_type %% @alias -type extnum() :: number() | 'inf'. -type constraint_fun() :: fun((proper_gen:instance()) -> boolean()). -opaque type() :: {'$type', [type_prop()]}. %% A type of the PropEr type system %% @type raw_type(). You can consider this as an equivalent of {@type type()}. -type raw_type() :: type() | [raw_type()] | loose_tuple(raw_type()) | term(). -type type_prop_name() :: 'kind' | 'generator' | 'reverse_gen' | 'parts_type' | 'combine' | 'alt_gens' | 'shrink_to_parts' | 'size_transform' | 'is_instance' | 'shrinkers' | 'noshrink' | 'internal_type' | 'internal_types' | 'get_length' | 'split' | 'join' | 'get_indices' | 'remove' | 'retrieve' | 'update' | 'constraints' | 'parameters' | 'env' | 'subenv'. -type type_prop_value() :: term(). -type type_prop() :: {'kind', type_kind()} | {'generator', proper_gen:generator()} | {'reverse_gen', proper_gen:reverse_gen()} | {'parts_type', type()} | {'combine', proper_gen:combine_fun()} | {'alt_gens', proper_gen:alt_gens()} | {'shrink_to_parts', boolean()} | {'size_transform', fun((size()) -> size())} | {'is_instance', instance_test()} | {'shrinkers', [proper_shrink:shrinker()]} | {'noshrink', boolean()} | {'internal_type', raw_type()} | {'internal_types', tuple() | maybe_improper_list(type(),type() | [])} %% The items returned by 'remove' must be of this type. | {'get_length', fun((proper_gen:imm_instance()) -> length())} %% If this is a container type, this should return the number of elements %% it contains. | {'split', fun((proper_gen:imm_instance()) -> [proper_gen:imm_instance()]) | fun((length(),proper_gen:imm_instance()) -> {proper_gen:imm_instance(),proper_gen:imm_instance()})} %% If present, the appropriate form depends on whether get_length is %% defined: if get_length is undefined, this must be in the one-argument %% form (e.g. a tree should be split into its subtrees), else it must be %% in the two-argument form (e.g. a list should be split in two at the %% index provided). | {'join', fun((proper_gen:imm_instance(),proper_gen:imm_instance()) -> proper_gen:imm_instance())} | {'get_indices', fun((proper_types:type(), proper_gen:imm_instance()) -> [index()])} %% If this is a container type, this should return a list of indices we %% can use to remove or insert elements from the given instance. | {'remove', fun((index(),proper_gen:imm_instance()) -> proper_gen:imm_instance())} | {'retrieve', fun((index(), proper_gen:imm_instance() | tuple() | maybe_improper_list(type(),type() | [])) -> value() | type())} | {'update', fun((index(),value(),proper_gen:imm_instance()) -> proper_gen:imm_instance())} | {'constraints', [{constraint_fun(), boolean()}]} %% A list of constraints on instances of this type: each constraint is a %% tuple of a fun that must return 'true' for each valid instance and a %% boolean field that specifies whether the condition is strict. | {'parameters', [{atom(),value()}]} | {'env', term()} | {'subenv', term()}. %%------------------------------------------------------------------------------ %% Type manipulation functions %%------------------------------------------------------------------------------ %% TODO: We shouldn't need the fully qualified type name in the range of these %% functions. %% @private %% TODO: just cook/1 ? -spec cook_outer(raw_type()) -> proper_types:type(). cook_outer(Type = {'$type',_Props}) -> Type; cook_outer(RawType) -> if is_tuple(RawType) -> tuple(tuple_to_list(RawType)); %% CAUTION: this must handle improper lists is_list(RawType) -> fixed_list(RawType); %% default case (covers integers, floats, atoms, binaries, ...): true -> exactly(RawType) end. %% @private -spec is_type(term()) -> boolean(). is_type({'$type',_Props}) -> true; is_type(_) -> false. %% @private -spec equal_types(proper_types:type(), proper_types:type()) -> boolean(). equal_types(SameType, SameType) -> true; equal_types(_, _) -> false. %% @private -spec is_raw_type(term()) -> boolean(). is_raw_type({'$type',_TypeProps}) -> true; is_raw_type(X) -> if is_tuple(X) -> is_raw_type_list(tuple_to_list(X)); is_list(X) -> is_raw_type_list(X); true -> false end. -spec is_raw_type_list(maybe_improper_list()) -> boolean(). %% CAUTION: this must handle improper lists is_raw_type_list(List) -> proper_arith:safe_any(fun is_raw_type/1, List). %% @private -spec to_binary(proper_types:type()) -> binary(). to_binary(Type) -> term_to_binary(Type). %% @private -ifdef(AT_LEAST_17). -spec from_binary(binary()) -> proper_types:type(). -endif. from_binary(Binary) -> binary_to_term(Binary). -spec type_from_list([type_prop()]) -> proper_types:type(). type_from_list(KeyValueList) -> {'$type',KeyValueList}. -spec add_prop(type_prop_name(), type_prop_value(), proper_types:type()) -> proper_types:type(). add_prop(PropName, Value, {'$type',Props}) -> {'$type',lists:keystore(PropName, 1, Props, {PropName, Value})}. -spec add_props([type_prop()], proper_types:type()) -> proper_types:type(). add_props(PropList, {'$type',OldProps}) -> {'$type', lists:foldl(fun({N,_}=NV,Acc) -> lists:keystore(N, 1, Acc, NV) end, OldProps, PropList)}. -spec append_to_prop(type_prop_name(), type_prop_value(), proper_types:type()) -> proper_types:type(). append_to_prop(PropName, Value, {'$type',Props}) -> Val = case lists:keyfind(PropName, 1, Props) of {PropName, V} -> V; _ -> [] end, {'$type', lists:keystore(PropName, 1, Props, {PropName, lists:reverse([Value|Val])})}. -spec append_list_to_prop(type_prop_name(), [type_prop_value()], proper_types:type()) -> proper_types:type(). append_list_to_prop(PropName, List, {'$type',Props}) -> {PropName, Val} = lists:keyfind(PropName, 1, Props), {'$type', lists:keystore(PropName, 1, Props, {PropName, Val++List})}. %% @private -spec get_prop(type_prop_name(), proper_types:type()) -> type_prop_value(). get_prop(PropName, {'$type',Props}) -> {_PropName, Val} = lists:keyfind(PropName, 1, Props), Val. %% @private -spec find_prop(type_prop_name(), proper_types:type()) -> {'ok',type_prop_value()} | 'error'. find_prop(PropName, {'$type',Props}) -> case lists:keyfind(PropName, 1, Props) of {PropName, Value} -> {ok, Value}; _ -> error end. %% @private -spec new_type([type_prop()], type_kind()) -> proper_types:type(). new_type(PropList, Kind) -> Type = type_from_list(PropList), add_prop(kind, Kind, Type). %% @private -spec subtype([type_prop()], proper_types:type()) -> proper_types:type(). %% TODO: should the 'is_instance' function etc. be reset for subtypes? subtype(PropList, Type) -> add_props(PropList, Type). %% @private -spec is_inst(proper_gen:instance(), raw_type()) -> boolean() | {'error',{'typeserver',term()}}. is_inst(Instance, RawType) -> is_inst(Instance, RawType, 10). %% @private -spec is_inst(proper_gen:instance(), raw_type(), size()) -> boolean() | {'error',{'typeserver',term()}}. is_inst(Instance, RawType, Size) -> proper:global_state_init_size(Size), Result = safe_is_instance(Instance, RawType), proper:global_state_erase(), Result. %% @private -spec safe_is_instance(proper_gen:imm_instance(), raw_type()) -> boolean() | {'error',{'typeserver',term()}}. safe_is_instance(ImmInstance, RawType) -> try is_instance(ImmInstance, RawType) catch throw:{'$typeserver',SubReason} -> {error, {typeserver,SubReason}} end. %% @private -spec is_instance(proper_gen:imm_instance(), raw_type()) -> boolean(). %% TODO: If the second argument is not a type, let it pass (don't even check for %% term equality?) - if it's a raw type, don't cook it, instead recurse %% into it. is_instance(ImmInstance, RawType) -> CleanInstance = proper_gen:clean_instance(ImmInstance), Type = cook_outer(RawType), (case get_prop(kind, Type) of wrapper -> wrapper_test(ImmInstance, Type); constructed -> constructed_test(ImmInstance, Type); _ -> false end orelse case find_prop(is_instance, Type) of {ok,{typed, IsInstance}} -> IsInstance(Type, ImmInstance); {ok,IsInstance} -> IsInstance(ImmInstance); error -> false end) andalso weakly(satisfies_all(CleanInstance, Type)). -spec wrapper_test(proper_gen:imm_instance(), proper_types:type()) -> boolean(). wrapper_test(ImmInstance, Type) -> %% TODO: check if it's actually a raw type that's returned? lists:any(fun(T) -> is_instance(ImmInstance, T) end, unwrap(Type)). %% @private -ifdef(AT_LEAST_17). -spec unwrap(proper_types:type()) -> [proper_types:type(),...]. -endif. %% TODO: check if it's actually a raw type that's returned? unwrap(Type) -> RawInnerTypes = proper_gen:alt_gens(Type) ++ [proper_gen:normal_gen(Type)], [cook_outer(T) || T <- RawInnerTypes]. -spec constructed_test(proper_gen:imm_instance(), proper_types:type()) -> boolean(). constructed_test({'$used',ImmParts,ImmInstance}, Type) -> PartsType = get_prop(parts_type, Type), Combine = get_prop(combine, Type), is_instance(ImmParts, PartsType) andalso begin %% TODO: check if it's actually a raw type that's returned? %% TODO: move construction code to proper_gen %% TODO: non-type => should we check for strict term equality? RawInnerType = Combine(proper_gen:clean_instance(ImmParts)), is_instance(ImmInstance, RawInnerType) end; constructed_test({'$to_part',ImmInstance}, Type) -> PartsType = get_prop(parts_type, Type), get_prop(shrink_to_parts, Type) =:= true andalso %% TODO: we reject non-container types get_prop(kind, PartsType) =:= container andalso case {find_prop(internal_type,PartsType), find_prop(internal_types,PartsType)} of {{ok,EachPartType},error} -> %% The parts are in a list or a vector. is_instance(ImmInstance, EachPartType); {error,{ok,PartTypesList}} -> %% The parts are in a fixed list. %% TODO: It should always be a proper list. lists:any(fun(T) -> is_instance(ImmInstance,T) end, PartTypesList) end; constructed_test(_CleanInstance, _Type) -> %% TODO: can we do anything better? false. %% @private -spec weakly({boolean(),boolean()}) -> boolean(). weakly({B1,_B2}) -> B1. %% @private -spec strongly({boolean(),boolean()}) -> boolean(). strongly({_B1,B2}) -> B2. -spec satisfies(proper_gen:instance(), {constraint_fun(),boolean()}) -> {boolean(),boolean()}. satisfies(Instance, {Test,false}) -> {true,Test(Instance)}; satisfies(Instance, {Test,true}) -> Result = Test(Instance), {Result,Result}. %% @private -spec satisfies_all(proper_gen:instance(), proper_types:type()) -> {boolean(),boolean()}. satisfies_all(Instance, Type) -> case find_prop(constraints, Type) of {ok, Constraints} -> L = [satisfies(Instance, C) || C <- Constraints], {L1,L2} = lists:unzip(L), {lists:all(fun(B) -> B end, L1), lists:all(fun(B) -> B end, L2)}; error -> {true,true} end. %%------------------------------------------------------------------------------ %% Type definition functions %%------------------------------------------------------------------------------ %% @private -spec lazy(proper_gen:nosize_generator()) -> proper_types:type(). lazy(Gen) -> ?WRAPPER([ {generator, Gen} ]). %% @private -spec sized(proper_gen:sized_generator()) -> proper_types:type(). sized(Gen) -> ?WRAPPER([ {generator, Gen} ]). %% @private -spec bind(raw_type(), proper_gen:combine_fun(), boolean()) -> proper_types:type(). bind(RawPartsType, Combine, ShrinkToParts) -> PartsType = cook_outer(RawPartsType), ?CONSTRUCTED([ {parts_type, PartsType}, {combine, Combine}, {shrink_to_parts, ShrinkToParts} ]). %% @private -spec shrinkwith(proper_gen:nosize_generator(), proper_gen:alt_gens()) -> proper_types:type(). shrinkwith(Gen, DelaydAltGens) -> ?WRAPPER([ {generator, Gen}, {alt_gens, DelaydAltGens} ]). %% @private -spec add_constraint(raw_type(), constraint_fun(), boolean()) -> proper_types:type(). add_constraint(RawType, Condition, IsStrict) -> Type = cook_outer(RawType), append_to_prop(constraints, {Condition,IsStrict}, Type). %% @private -spec native_type(mod_name(), string()) -> proper_types:type(). native_type(Mod, TypeStr) -> ?WRAPPER([ {generator, fun() -> proper_gen:native_type_gen(Mod,TypeStr) end} ]). %%------------------------------------------------------------------------------ %% Basic types %%------------------------------------------------------------------------------ %% @doc All integers between `Low' and `High', bounds included. %% `Low' and `High' must be Erlang expressions that evaluate to integers, with %% `Low =< High'. Additionally, `Low' and `High' may have the value `inf', in %% which case they represent minus infinity and plus infinity respectively. %% Instances shrink towards 0 if `Low =< 0 =< High', or towards the bound with %% the smallest absolute value otherwise. -spec integer(extint(), extint()) -> proper_types:type(). integer(Low, High) -> ?BASIC([ {env, {Low, High}}, {generator, {typed, fun integer_gen/2}}, {is_instance, {typed, fun integer_is_instance/2}}, {shrinkers, [fun number_shrinker/3]} ]). integer_gen(Type, Size) -> {Low, High} = get_prop(env, Type), proper_gen:integer_gen(Size, Low, High). integer_is_instance(Type, X) -> {Low, High} = get_prop(env, Type), is_integer(X) andalso le(Low, X) andalso le(X, High). number_shrinker(X, Type, S) -> {Low, High} = get_prop(env, Type), proper_shrink:number_shrinker(X, Low, High, S). %% @doc All floats between `Low' and `High', bounds included. %% `Low' and `High' must be Erlang expressions that evaluate to floats, with %% `Low =< High'. Additionally, `Low' and `High' may have the value `inf', in %% which case they represent minus infinity and plus infinity respectively. %% Instances shrink towards 0.0 if `Low =< 0.0 =< High', or towards the bound %% with the smallest absolute value otherwise. -spec float(extnum(), extnum()) -> proper_types:type(). float(Low, High) -> ?BASIC([ {env, {Low, High}}, {generator, {typed, fun float_gen/2}}, {is_instance, {typed, fun float_is_instance/2}}, {shrinkers, [fun number_shrinker/3]} ]). float_gen(Type, Size) -> {Low, High} = get_prop(env, Type), proper_gen:float_gen(Size, Low, High). float_is_instance(Type, X) -> {Low, High} = get_prop(env, Type), is_float(X) andalso le(Low, X) andalso le(X, High). %% @private -spec le(extnum(), extnum()) -> boolean(). le(inf, _B) -> true; le(_A, inf) -> true; le(A, B) -> A =< B. %% @doc All atoms. All atoms used internally by PropEr start with a '`$'', so %% such atoms will never be produced as instances of this type. You should also %% refrain from using such atoms in your code, to avoid a potential clash. %% Instances shrink towards the empty atom, ''. -spec atom() -> proper_types:type(). atom() -> ?WRAPPER([ {generator, fun proper_gen:atom_gen/1}, {reverse_gen, fun proper_gen:atom_rev/1}, {size_transform, fun(Size) -> erlang:min(Size,255) end}, {is_instance, fun atom_is_instance/1} ]). atom_is_instance(X) -> is_atom(X) %% We return false for atoms starting with '$', since these are %% atoms used internally and never produced by the atom generator. andalso (X =:= '' orelse hd(atom_to_list(X)) =/= $$). %% @doc All binaries. Instances shrink towards the empty binary, `<<>>'. -spec binary() -> proper_types:type(). binary() -> ?WRAPPER([ {generator, fun proper_gen:binary_gen/1}, {reverse_gen, fun proper_gen:binary_rev/1}, {is_instance, fun erlang:is_binary/1} ]). %% @doc All binaries with a byte size of `Len'. %% `Len' must be an Erlang expression that evaluates to a non-negative integer. %% Instances shrink towards binaries of zeroes. -spec binary(length()) -> proper_types:type(). binary(Len) -> ?WRAPPER([ {env, Len}, {generator, {typed, fun binary_len_gen/1}}, {reverse_gen, fun proper_gen:binary_rev/1}, {is_instance, {typed, fun binary_len_is_instance/2}} ]). binary_len_gen(Type) -> Len = get_prop(env, Type), proper_gen:binary_len_gen(Len). binary_len_is_instance(Type, X) -> Len = get_prop(env, Type), is_binary(X) andalso byte_size(X) =:= Len. %% @doc All bitstrings. Instances shrink towards the empty bitstring, `<<>>'. -spec bitstring() -> proper_types:type(). bitstring() -> ?WRAPPER([ {generator, fun proper_gen:bitstring_gen/1}, {reverse_gen, fun proper_gen:bitstring_rev/1}, {is_instance, fun erlang:is_bitstring/1} ]). %% @doc All bitstrings with a bit size of `Len'. %% `Len' must be an Erlang expression that evaluates to a non-negative integer. %% Instances shrink towards bitstrings of zeroes -spec bitstring(length()) -> proper_types:type(). bitstring(Len) -> ?WRAPPER([ {env, Len}, {generator, {typed, fun bitstring_len_gen/1}}, {reverse_gen, fun proper_gen:bitstring_rev/1}, {is_instance, {typed, fun bitstring_len_is_instance/2}} ]). bitstring_len_gen(Type) -> Len = get_prop(env, Type), proper_gen:bitstring_len_gen(Len). bitstring_len_is_instance(Type, X) -> Len = get_prop(env, Type), is_bitstring(X) andalso bit_size(X) =:= Len. %% @doc All lists containing elements of type `ElemType'. %% Instances shrink towards the empty list, `[]'. -spec list(ElemType::raw_type()) -> proper_types:type(). % TODO: subtyping would be useful here (list, vector, fixed_list) list(RawElemType) -> ElemType = cook_outer(RawElemType), ?CONTAINER([ {generator, {typed, fun list_gen/2}}, {is_instance, {typed, fun list_is_instance/2}}, {internal_type, ElemType}, {get_length, fun erlang:length/1}, {split, fun lists:split/2}, {join, fun lists:append/2}, {get_indices, fun list_get_indices/2}, {remove, fun proper_arith:list_remove/2}, {retrieve, fun lists:nth/2}, {update, fun proper_arith:list_update/3} ]). list_gen(Type, Size) -> ElemType = get_prop(internal_type, Type), proper_gen:list_gen(Size, ElemType). list_is_instance(Type, X) -> ElemType = get_prop(internal_type, Type), list_test(X, ElemType). %% @doc A type that generates exactly the list `List'. Instances shrink towards %% shorter sublists of the original list. -spec shrink_list([term()]) -> proper_types:type(). shrink_list(List) -> ?CONTAINER([ {env, List}, {generator, {typed, fun shrink_list_gen/1}}, {is_instance, {typed, fun shrink_list_is_instance/2}}, {get_length, fun erlang:length/1}, {split, fun lists:split/2}, {join, fun lists:append/2}, {get_indices, fun list_get_indices/2}, {remove, fun proper_arith:list_remove/2} ]). shrink_list_gen(Type) -> get_prop(env, Type). shrink_list_is_instance(Type, X) -> List = get_prop(env, Type), is_sublist(X, List). -spec is_sublist([term()], [term()]) -> boolean(). is_sublist([], _) -> true; is_sublist(_, []) -> false; is_sublist([H|T1], [H|T2]) -> is_sublist(T1, T2); is_sublist(Slice, [_|T2]) -> is_sublist(Slice, T2). -spec list_test(proper_gen:imm_instance(), proper_types:type()) -> boolean(). list_test(X, ElemType) -> is_list(X) andalso lists:all(fun(E) -> is_instance(E, ElemType) end, X). %% @private -spec list_get_indices(proper_gen:generator(), list()) -> [position()]. list_get_indices(_, List) -> lists:seq(1, length(List)). %% @private %% This assumes that: %% - instances of size S are always valid instances of size >S %% - any recursive calls inside Gen are lazy -spec distlist(size(), proper_gen:sized_generator(), boolean()) -> proper_types:type(). distlist(Size, Gen, NonEmpty) -> ParentType = case NonEmpty of true -> non_empty(list(Gen(Size))); false -> list(Gen(Size)) end, ?SUBTYPE(ParentType, [ {subenv, {Size, Gen, NonEmpty}}, {generator, {typed, fun distlist_gen/1}} ]). distlist_gen(Type) -> {Size, Gen, NonEmpty} = get_prop(subenv, Type), proper_gen:distlist_gen(Size, Gen, NonEmpty). %% @doc All lists of length `Len' containing elements of type `ElemType'. %% `Len' must be an Erlang expression that evaluates to a non-negative integer. -spec vector(length(), ElemType::raw_type()) -> proper_types:type(). vector(Len, RawElemType) -> ElemType = cook_outer(RawElemType), ?CONTAINER([ {env, Len}, {generator, {typed, fun vector_gen/1}}, {is_instance, {typed, fun vector_is_instance/2}}, {internal_type, ElemType}, {get_indices, fun vector_get_indices/2}, {retrieve, fun lists:nth/2}, {update, fun proper_arith:list_update/3} ]). vector_gen(Type) -> Len = get_prop(env, Type), ElemType = get_prop(internal_type, Type), proper_gen:vector_gen(Len, ElemType). vector_is_instance(Type, X) -> Len = get_prop(env, Type), ElemType = get_prop(internal_type, Type), is_list(X) andalso length(X) =:= Len andalso lists:all(fun(E) -> is_instance(E, ElemType) end, X). vector_get_indices(Type, _X) -> lists:seq(1, get_prop(env, Type)). %% @doc The union of all types in `ListOfTypes'. `ListOfTypes' can't be empty. %% The random instance generator is equally likely to choose any one of the %% types in `ListOfTypes'. The shrinking subsystem will always try to shrink an %% instance of a type union to an instance of the first type in `ListOfTypes', %% thus you should write the simplest case first. -spec union(ListOfTypes::[raw_type(),...]) -> proper_types:type(). union(RawChoices) -> Choices = [cook_outer(C) || C <- RawChoices], ?BASIC([ {env, Choices}, {generator, {typed, fun union_gen/1}}, {is_instance, {typed, fun union_is_instance/2}}, {shrinkers, [fun union_shrinker_1/3, fun union_shrinker_2/3]} ]). union_gen(Type) -> Choices = get_prop(env,Type), proper_gen:union_gen(Choices). union_is_instance(Type, X) -> Choices = get_prop(env, Type), lists:any(fun(C) -> is_instance(X, C) end, Choices). union_shrinker_1(X, Type, S) -> Choices = get_prop(env, Type), proper_shrink:union_first_choice_shrinker(X, Choices, S). union_shrinker_2(X, Type, S) -> Choices = get_prop(env, Type), proper_shrink:union_recursive_shrinker(X, Choices, S). %% @doc A specialization of {@link union/1}, where each type in `ListOfTypes' is %% assigned a frequency. Frequencies must be Erlang expressions that evaluate to %% positive integers. Types with larger frequencies are more likely to be chosen %% by the random instance generator. The shrinking subsystem will ignore the %% frequencies and try to shrink towards the first type in the list. -spec weighted_union(ListOfTypes::[{frequency(),raw_type()},...]) -> proper_types:type(). weighted_union(RawFreqChoices) -> CookFreqType = fun({Freq,RawType}) -> {Freq,cook_outer(RawType)} end, FreqChoices = lists:map(CookFreqType, RawFreqChoices), Choices = [T || {_F,T} <- FreqChoices], ?SUBTYPE(union(Choices), [ {subenv, FreqChoices}, {generator, {typed, fun weighted_union_gen/1}} ]). weighted_union_gen(Gen) -> FreqChoices = get_prop(subenv, Gen), proper_gen:weighted_union_gen(FreqChoices). %% @private -spec safe_union([raw_type(),...]) -> proper_types:type(). safe_union(RawChoices) -> Choices = [cook_outer(C) || C <- RawChoices], subtype( [{subenv, Choices}, {generator, {typed, fun safe_union_gen/1}}], union(Choices)). safe_union_gen(Type) -> Choices = get_prop(subenv, Type), proper_gen:safe_union_gen(Choices). %% @private -spec safe_weighted_union([{frequency(),raw_type()},...]) -> proper_types:type(). safe_weighted_union(RawFreqChoices) -> CookFreqType = fun({Freq,RawType}) -> {Freq,cook_outer(RawType)} end, FreqChoices = lists:map(CookFreqType, RawFreqChoices), Choices = [T || {_F,T} <- FreqChoices], subtype([{subenv, FreqChoices}, {generator, {typed, fun safe_weighted_union_gen/1}}], union(Choices)). safe_weighted_union_gen(Type) -> FreqChoices = get_prop(subenv, Type), proper_gen:safe_weighted_union_gen(FreqChoices). %% @doc All tuples whose i-th element is an instance of the type at index i of %% `ListOfTypes'. Also written simply as a tuple of types. -spec tuple(ListOfTypes::[raw_type()]) -> proper_types:type(). tuple(RawFields) -> Fields = [cook_outer(F) || F <- RawFields], ?CONTAINER([ {env, Fields}, {generator, {typed, fun tuple_gen/1}}, {is_instance, {typed, fun tuple_is_instance/2}}, {internal_types, list_to_tuple(Fields)}, {get_indices, fun tuple_get_indices/2}, {retrieve, fun erlang:element/2}, {update, fun tuple_update/3} ]). tuple_gen(Type) -> Fields = get_prop(env, Type), proper_gen:tuple_gen(Fields). tuple_is_instance(Type, X) -> Fields = get_prop(env, Type), is_tuple(X) andalso fixed_list_test(tuple_to_list(X), Fields). tuple_get_indices(Type, _X) -> lists:seq(1, length(get_prop(env, Type))). -spec tuple_update(index(), value(), tuple()) -> tuple(). tuple_update(Index, NewElem, Tuple) -> setelement(Index, Tuple, NewElem). %% @doc Tuples whose elements are all of type `ElemType'. %% Instances shrink towards the 0-size tuple, `{}'. -spec loose_tuple(ElemType::raw_type()) -> proper_types:type(). loose_tuple(RawElemType) -> ElemType = cook_outer(RawElemType), ?WRAPPER([ {env, ElemType}, {generator, {typed, fun loose_tuple_gen/2}}, {reverse_gen, {typed, fun loose_tuple_rev/2}}, {is_instance, {typed, fun loose_tuple_is_instance/2}} ]). loose_tuple_gen(Type, Size) -> ElemType = get_prop(env, Type), proper_gen:loose_tuple_gen(Size, ElemType). loose_tuple_rev(Type, X) -> ElemType = get_prop(env, Type), proper_gen:loose_tuple_rev(X, ElemType). loose_tuple_is_instance(Type, X) -> ElemType = get_prop(env, Type), is_tuple(X) andalso list_test(tuple_to_list(X), ElemType). %% @doc Singleton type consisting only of `E'. `E' must be an evaluated term. %% Also written simply as `E'. -spec exactly(term()) -> proper_types:type(). exactly(E) -> ?BASIC([ {env, E}, {generator, {typed, fun exactly_gen/1}}, {is_instance, {typed, fun exactly_is_instance/2}} ]). exactly_gen(Type) -> E = get_prop(env, Type), proper_gen:exactly_gen(E). exactly_is_instance(Type, X) -> E = get_prop(env, Type), X =:= E. %% @doc All lists whose i-th element is an instance of the type at index i of %% `ListOfTypes'. Also written simply as a list of types. -spec fixed_list(ListOfTypes::maybe_improper_list(raw_type(),raw_type()|[])) -> proper_types:type(). fixed_list(MaybeImproperRawFields) -> %% CAUTION: must handle improper lists {Fields, Internal, Len, Retrieve, Update} = case proper_arith:cut_improper_tail(MaybeImproperRawFields) of % TODO: have cut_improper_tail return the length and use it in test? {ProperRawHead, ImproperRawTail} -> HeadLen = length(ProperRawHead), CookedHead = [cook_outer(F) || F <- ProperRawHead], CookedTail = cook_outer(ImproperRawTail), {{CookedHead,CookedTail}, CookedHead ++ CookedTail, HeadLen + 1, fun(I,L) -> improper_list_retrieve(I, L, HeadLen) end, fun(I,V,L) -> improper_list_update(I, V, L, HeadLen) end}; ProperRawFields -> LocalFields = [cook_outer(F) || F <- ProperRawFields], {LocalFields, LocalFields, length(ProperRawFields), fun lists:nth/2, fun proper_arith:list_update/3} end, ?CONTAINER([ {env, {Fields, Len}}, {generator, {typed, fun fixed_list_gen/1}}, {is_instance, {typed, fun fixed_list_is_instance/2}}, {internal_types, Internal}, {get_indices, fun fixed_list_get_indices/2}, {retrieve, Retrieve}, {update, Update} ]). fixed_list_gen(Type) -> {Fields, _} = get_prop(env, Type), proper_gen:fixed_list_gen(Fields). fixed_list_is_instance(Type, X) -> {Fields, _} = get_prop(env, Type), fixed_list_test(X, Fields). fixed_list_get_indices(Type, _X) -> {_, Len} = get_prop(env, Type), lists:seq(1, Len). -spec fixed_list_test(proper_gen:imm_instance(), [proper_types:type()] | {[proper_types:type()], proper_types:type()}) -> boolean(). fixed_list_test(X, {ProperHead,ImproperTail}) -> is_list(X) andalso begin ProperHeadLen = length(ProperHead), proper_arith:head_length(X) >= ProperHeadLen andalso begin {XHead,XTail} = lists:split(ProperHeadLen, X), fixed_list_test(XHead, ProperHead) andalso is_instance(XTail, ImproperTail) end end; fixed_list_test(X, ProperFields) -> is_list(X) andalso length(X) =:= length(ProperFields) andalso lists:all(fun({E,T}) -> is_instance(E, T) end, lists:zip(X, ProperFields)). %% TODO: Move these 2 functions to proper_arith? -spec improper_list_retrieve(index(), nonempty_improper_list(value(),value()), pos_integer()) -> value(). improper_list_retrieve(Index, List, HeadLen) -> case Index =< HeadLen of true -> lists:nth(Index, List); false -> lists:nthtail(HeadLen, List) end. -spec improper_list_update(index(), value(), nonempty_improper_list(value(),value()), pos_integer()) -> nonempty_improper_list(value(),value()). improper_list_update(Index, Value, List, HeadLen) -> case Index =< HeadLen of %% TODO: This happens to work, but is not implied by list_update's spec. true -> proper_arith:list_update(Index, Value, List); false -> lists:sublist(List, HeadLen) ++ Value end. %% @doc All pure functions that map instances of `ArgTypes' to instances of %% `RetType'. The syntax `function(Arity, RetType)' is also acceptable. -spec function(ArgTypes::[raw_type()] | arity(), RetType::raw_type()) -> proper_types:type(). function(Arity, RawRetType) when is_integer(Arity), Arity >= 0, Arity =< 255 -> RetType = cook_outer(RawRetType), ?BASIC([ {env, {Arity, RetType}}, {generator, {typed, fun function_gen/1}}, {is_instance, {typed, fun function_is_instance/2}} ]); function(RawArgTypes, RawRetType) -> function(length(RawArgTypes), RawRetType). function_gen(Type) -> {Arity, RetType} = get_prop(env, Type), proper_gen:function_gen(Arity, RetType). function_is_instance(Type, X) -> {Arity, RetType} = get_prop(env, Type), is_function(X, Arity) %% TODO: what if it's not a function we produced? andalso equal_types(RetType, proper_gen:get_ret_type(X)). %% @doc All Erlang terms (that PropEr can produce). For reasons of efficiency, %% functions are never produced as instances of this type.
%% CAUTION: Instances of this type are expensive to produce, shrink and instance- %% check, both in terms of processing time and consumed memory. Only use this %% type if you are certain that you need it. -spec any() -> proper_types:type(). any() -> AllTypes = [integer(),float(),atom(),bitstring(),?LAZY(loose_tuple(any())), ?LAZY(list(any()))], ?SUBTYPE(union(AllTypes), [ {generator, fun proper_gen:any_gen/1} ]). %%------------------------------------------------------------------------------ %% Type aliases %%------------------------------------------------------------------------------ %% @equiv integer(inf, inf) -spec integer() -> proper_types:type(). integer() -> integer(inf, inf). %% @equiv integer(0, inf) -spec non_neg_integer() -> proper_types:type(). non_neg_integer() -> integer(0, inf). %% @equiv integer(1, inf) -spec pos_integer() -> proper_types:type(). pos_integer() -> integer(1, inf). %% @equiv integer(inf, -1) -spec neg_integer() -> proper_types:type(). neg_integer() -> integer(inf, -1). %% @equiv integer(Low, High) -spec range(extint(), extint()) -> proper_types:type(). range(Low, High) -> integer(Low, High). %% @equiv float(inf, inf) -spec float() -> proper_types:type(). float() -> float(inf, inf). %% @equiv float(0.0, inf) -spec non_neg_float() -> proper_types:type(). non_neg_float() -> float(0.0, inf). %% @equiv union([integer(), float()]) -spec number() -> proper_types:type(). number() -> union([integer(), float()]). %% @doc The atoms `true' and `false'. Instances shrink towards `false'. -spec boolean() -> proper_types:type(). boolean() -> union(['false', 'true']). %% @equiv integer(0, 255) -spec byte() -> proper_types:type(). byte() -> integer(0, 255). %% @equiv integer(0, 16#10ffff) -spec char() -> proper_types:type(). char() -> integer(0, 16#10ffff). %% @equiv list(any()) -spec list() -> proper_types:type(). list() -> list(any()). %% @equiv loose_tuple(any()) -spec tuple() -> proper_types:type(). tuple() -> loose_tuple(any()). %% @equiv list(char()) -spec string() -> proper_types:type(). string() -> list(char()). %% @equiv weighted_union(FreqChoices) -spec wunion([{frequency(),raw_type()},...]) -> proper_types:type(). wunion(FreqChoices) -> weighted_union(FreqChoices). %% @equiv any() -spec term() -> proper_types:type(). term() -> any(). %% @equiv union([non_neg_integer() | infinity]) -spec timeout() -> proper_types:type(). timeout() -> union([non_neg_integer(), 'infinity']). %% @equiv integer(0, 255) -spec arity() -> proper_types:type(). arity() -> integer(0, 255). %%------------------------------------------------------------------------------ %% QuickCheck compatibility types %%------------------------------------------------------------------------------ %% @doc Small integers (bound by the current value of the `size' parameter). %% Instances shrink towards `0'. -spec int() -> proper_types:type(). int() -> ?SIZED(Size, integer(-Size,Size)). %% @doc Small non-negative integers (bound by the current value of the `size' %% parameter). Instances shrink towards `0'. -spec nat() -> proper_types:type(). nat() -> ?SIZED(Size, integer(0,Size)). %% @equiv integer() -spec largeint() -> proper_types:type(). largeint() -> integer(). %% @equiv float() -spec real() -> proper_types:type(). real() -> float(). %% @equiv boolean() -spec bool() -> proper_types:type(). bool() -> boolean(). %% @equiv integer(Low, High) -spec choose(extint(), extint()) -> proper_types:type(). choose(Low, High) -> integer(Low, High). %% @equiv union(Choices) -spec elements([raw_type(),...]) -> proper_types:type(). elements(Choices) -> union(Choices). %% @equiv union(Choices) -spec oneof([raw_type(),...]) -> proper_types:type(). oneof(Choices) -> union(Choices). %% @equiv weighted_union(Choices) -spec frequency([{frequency(),raw_type()},...]) -> proper_types:type(). frequency(FreqChoices) -> weighted_union(FreqChoices). %% @equiv exactly(E) -spec return(term()) -> proper_types:type(). return(E) -> exactly(E). %% @doc Adds a default value, `Default', to `Type'. %% The default serves as a primary shrinking target for instances, while it %% is also chosen by the random instance generation subsystem half the time. -spec default(raw_type(), raw_type()) -> proper_types:type(). default(Default, Type) -> union([Default, Type]). %% @doc All sorted lists containing elements of type `ElemType'. %% Instances shrink towards the empty list, `[]'. -spec orderedlist(ElemType::raw_type()) -> proper_types:type(). orderedlist(RawElemType) -> ?LET(L, list(RawElemType), lists:sort(L)). %% @equiv function(0, RetType) -spec function0(raw_type()) -> proper_types:type(). function0(RetType) -> function(0, RetType). %% @equiv function(1, RetType) -spec function1(raw_type()) -> proper_types:type(). function1(RetType) -> function(1, RetType). %% @equiv function(2, RetType) -spec function2(raw_type()) -> proper_types:type(). function2(RetType) -> function(2, RetType). %% @equiv function(3, RetType) -spec function3(raw_type()) -> proper_types:type(). function3(RetType) -> function(3, RetType). %% @equiv function(4, RetType) -spec function4(raw_type()) -> proper_types:type(). function4(RetType) -> function(4, RetType). %% @doc A specialization of {@link default/2}, where `Default' and `Type' are %% assigned weights to be considered by the random instance generator. The %% shrinking subsystem will ignore the weights and try to shrink using the %% default value. -spec weighted_default({frequency(),raw_type()}, {frequency(),raw_type()}) -> proper_types:type(). weighted_default(Default, Type) -> weighted_union([Default, Type]). %%------------------------------------------------------------------------------ %% Additional type specification functions %%------------------------------------------------------------------------------ %% @doc Overrides the `size' parameter used when generating instances of %% `Type' with `NewSize'. Has no effect on size-less types, such as unions. %% Also, this will not affect the generation of any internal types contained in %% `Type', such as the elements of a list - those will still be generated %% using the test-wide value of `size'. One use of this function is to modify %% types to produce instances that grow faster or slower, like so: %% ```?SIZED(Size, resize(Size * 2, list(integer()))''' %% The above specifies a list type that grows twice as fast as normal lists. -spec resize(size(), Type::raw_type()) -> proper_types:type(). resize(NewSize, RawType) -> Type = cook_outer(RawType), case find_prop(size_transform, Type) of {ok,Transform} -> add_prop(size_transform, fun(_S) -> Transform(NewSize) end, Type); error -> add_prop(size_transform, fun(_S) -> NewSize end, Type) end. %% @doc This is a predefined constraint that can be applied to random-length %% list and binary types to ensure that the produced values are never empty. %% %% e.g. {@link list/0}, {@link string/0}, {@link binary/0}) -spec non_empty(ListType::raw_type()) -> proper_types:type(). non_empty(RawListType) -> ?SUCHTHAT(L, RawListType, L =/= [] andalso L =/= <<>>). %% @doc Creates a new type which is equivalent to `Type', but whose instances %% are never shrunk by the shrinking subsystem. -spec noshrink(Type::raw_type()) -> proper_types:type(). noshrink(RawType) -> add_prop(noshrink, true, cook_outer(RawType)). %% @doc Associates the atom key `Parameter' with the value `Value' while %% generating instances of `Type'. -spec with_parameter(atom(), value(), Type::raw_type()) -> proper_types:type(). with_parameter(Parameter, Value, RawType) -> with_parameters([{Parameter,Value}], RawType). %% @doc Similar to {@link with_parameter/3}, but accepts a list of %% `{Parameter, Value}' pairs. -spec with_parameters([{atom(),value()}], Type::raw_type()) -> proper_types:type(). with_parameters(PVlist, RawType) -> Type = cook_outer(RawType), case find_prop(parameters, Type) of {ok,Params} when is_list(Params) -> append_list_to_prop(parameters, PVlist, Type); error -> add_prop(parameters, PVlist, Type) end. %% @doc Returns the value associated with `Parameter', or `Default' in case %% `Parameter' is not associated with any value. -spec parameter(atom(), value()) -> value(). parameter(Parameter, Default) -> Parameters = case erlang:get('$parameters') of undefined -> []; List -> List end, proplists:get_value(Parameter, Parameters, Default). %% @equiv parameter(Parameter, undefined) -spec parameter(atom()) -> value(). parameter(Parameter) -> parameter(Parameter, undefined). erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_typeserver.erl000066400000000000000000002714461255446327200244250ustar00rootroot00000000000000%%% Copyright 2010-2015 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2015 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc Erlang type system - PropEr type system integration module. %%% %%% PropEr can parse types expressed in Erlang's type language and convert them %%% to its own type format. Such expressions can be used instead of regular type %%% constructors in the second argument of `?FORALL's. No extra notation is %%% required; PropEr will detect which calls correspond to native types by %%% applying a parse transform during compilation. This parse transform is %%% automatically applied to any module that includes the `proper.hrl' header %%% file. You can disable this feature by compiling your modules with %%% `-DPROPER_NO_TRANS'. Note that this will currently also disable the %%% automatic exporting of properties. %%% %%% The use of native types in properties is subject to the following usage %%% rules: %%%
    %%%
  • Native types cannot be used outside of `?FORALL's.
  • %%%
  • Inside `?FORALL's, native types can be combined with other native %%% types, and even with PropEr types, inside tuples and lists (the constructs %%% `[...]', `{...}' and `++' are all allowed).
  • %%%
  • All other constructs of Erlang's built-in type system (e.g. `|' for %%% union, `_' as an alias of `any()', `<<_:_>>' binary type syntax and %%% `fun((...) -> ...)' function type syntax) are not allowed in `?FORALL's, %%% because they are rejected by the Erlang parser.
  • %%%
  • Anything other than a tuple constructor, list constructor, `++' %%% application, local or remote call will automatically be considered a %%% PropEr type constructor and not be processed further by the parse %%% transform.
  • %%%
  • Parametric native types are fully supported; of course, they can only %%% appear instantiated in a `?FORALL'. The arguments of parametric native %%% types are always interpreted as native types.
  • %%%
  • Parametric PropEr types, on the other hand, can take any kind of %%% argument. You can even mix native and PropEr types in the arguments of a %%% PropEr type. For example, assuming that the following declarations are %%% present: %%% ``` my_proper_type() -> ?LET(...). %%% -type my_native_type() :: ... .''' %%% Then the following expressions are all legal: %%% ``` vector(2, my_native_type()) %%% function(0, my_native_type()) %%% union([my_proper_type(), my_native_type()])'''
  • %%%
  • Some type constructors can take native types as arguments (but only %%% inside `?FORALL's): %%%
      %%%
    • `?SUCHTHAT', `?SUCHTHATMAYBE', `non_empty', `noshrink': these work %%% with native types too
    • %%%
    • `?LAZY', `?SHRINK', `resize', `?SIZED': these don't work with native %%% types
    • %%%
    • `?LET', `?LETSHRINK': only the top-level base type can be a native %%% type
    • %%%
  • %%%
  • Native type declarations in the `?FORALL's of a module can reference any %%% custom type declared in a `-type' or `-opaque' attribute of the same %%% module, as long as no module identifier is used.
  • %%%
  • Typed records cannot be referenced inside `?FORALL's using the %%% `#rec_name{}' syntax. To use a typed record in a `?FORALL', enclose the %%% record in a custom type like so: %%% ``` -type rec_name() :: #rec_name{}. ''' %%% and use the custom type instead.
  • %%%
  • `?FORALL's may contain references to self-recursive or mutually %%% recursive native types, so long as each type in the hierarchy has a clear %%% base case. %%% Currently, PropEr requires that the toplevel of any recursive type %%% declaration is either a (maybe empty) list or a union containing at least %%% one choice that doesn't reference the type directly (it may, however, %%% reference any of the types that are mutually recursive with it). This %%% means, for example, that some valid recursive type declarations, such as %%% this one: %%% ``` ?FORALL(..., a(), ...) ''' %%% where: %%% ``` -type a() :: {'a','none' | a()}. ''' %%% are not accepted by PropEr. However, such types can be rewritten in a way %%% that allows PropEr to parse them: %%% ``` ?FORALL(..., a(), ...) ''' %%% where: %%% ``` -type a() :: {'a','none'} | {'a',a()}. ''' %%% This also means that recursive record declarations are not allowed: %%% ``` ?FORALL(..., rec(), ...) ''' %%% where: %%% ``` -type rec() :: #rec{}. %%% -record(rec, {a = 0 :: integer(), b = 'nil' :: 'nil' | #rec{}}). ''' %%% A little rewritting can usually remedy this problem as well: %%% ``` ?FORALL(..., rec(), ...) ''' %%% where: %%% ``` -type rec() :: #rec{b :: 'nil'} | #rec{b :: rec()}. %%% -record(rec, {a = 0 :: integer(), b = 'nil' :: 'nil' | #rec{}}). ''' %%%
  • %%%
  • Remote types may be referenced in a `?FORALL', so long as they are %%% exported from the remote module. Currently, PropEr requires that any %%% remote modules whose types are directly referenced from within properties %%% are present in the code path at compile time, either compiled with %%% `debug_info' enabled or in source form. If PropEr cannot find a remote %%% module at all, finds only a compiled object file with no debug %%% information or fails to compile the source file, all calls to that module %%% will automatically be considered calls to PropEr type constructors.
  • %%%
  • For native types to be translated correctly, both the module that %%% contains the `?FORALL' declaration as well as any module that contains %%% the declaration of a type referenced (directly or indirectly) from inside %%% a `?FORALL' must be present in the code path at runtime, either compiled %%% with `debug_info' enabled or in source form.
  • %%%
  • Local types with the same name as an auto-imported BIF are not accepted %%% by PropEr, unless the BIF in question has been declared in a %%% `no_auto_import' option.
  • %%%
  • When an expression can be interpreted both as a PropEr type and as a %%% native type, the former takes precedence. This means that a function %%% `foo()' will shadow a type `foo()' if they are both present in the module. %%% The same rule applies to remote functions and types as well.
  • %%%
  • The above may cause some confusion when list syntax is used: %%%
      %%%
    • The expression `[integer()]' can be interpreted both ways, so the %%% PropEr way applies. Therefore, instances of this type will always be %%% lists of length 1, not arbitrary integer lists, as would be expected %%% when interpreting the expression as a native type.
    • %%%
    • Assuming that a custom type foo/1 has been declared, the expression %%% `foo([integer()])' can only be interpreted as a native type declaration, %%% which means that the generic type of integer lists will be passed to %%% `foo/1'.
    • %%%
  • %%%
  • Currently, PropEr does not detect the following mistakes: %%%
      %%%
    • inline record-field specializations that reference non-existent %%% fields
    • %%%
    • type parameters that are not present in the RHS of a `-type' %%% declaration
    • %%%
    • using `_' as a type variable in the LHS of a `-type' declaration
    • %%%
    • using the same variable in more than one position in the LHS of a %%% `-type' declaration
    • %%%
    %%%
  • %%%
%%% %%% You can use these functions to try out the type %%% translation subsystem. %%% %%% CAUTION: These functions should never be used inside properties. They are %%% meant for demonstration purposes only. -module(proper_typeserver). -behaviour(gen_server). -export([demo_translate_type/2, demo_is_instance/3]). -export([start/0, restart/0, stop/0, create_spec_test/3, get_exp_specced/1, is_instance/3, translate_type/1]). -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). -export([get_exp_info/1, match/2]). -export_type([imm_type/0, mod_exp_types/0, mod_exp_funs/0]). -include("proper_internal.hrl"). %%------------------------------------------------------------------------------ %% Macros %%------------------------------------------------------------------------------ -define(SRC_FILE_EXT, ".erl"). %% CAUTION: all these must be sorted -define(STD_TYPES_0, [any,arity,atom,binary,bitstring,bool,boolean,byte,char,float,integer, list,neg_integer,non_neg_integer,number,pos_integer,string,term, timeout]). -define(HARD_ADTS, %% gb_trees:iterator and gb_sets:iterator are NOT hardcoded [{{array,0},array}, {{array,1},proper_array}, {{dict,0},dict}, {{dict,2},proper_dict}, {{gb_set,0},gb_sets}, {{gb_set,1},proper_gb_sets}, {{gb_tree,0},gb_trees}, {{gb_tree,2},proper_gb_trees}, {{orddict,2},proper_orddict}, {{ordset,1},proper_ordsets}, {{queue,0},queue}, {{queue,1},proper_queue}, {{set,0},sets}, {{set,1},proper_sets}]). -define(HARD_ADT_MODS, [{array, [{{array,0}, {{type,0,record,[{atom,0,array}]},[]}}]}, {dict, [{{dict,0}, {{type,0,record,[{atom,0,dict}]},[]}}]}, {gb_sets, [{{gb_set,0}, {{type,0,tuple,[{type,0,non_neg_integer,[]}, {type,0,gb_set_node,[]}]},[]}}]}, {gb_trees, [{{gb_tree,0}, {{type,0,tuple,[{type,0,non_neg_integer,[]}, {type,0,gb_tree_node,[]}]},[]}}]}, %% Our parametric ADTs are already declared as normal types, we just %% need to change them to opaques. {proper_array, [{{array,1},already_declared}]}, {proper_dict, [{{dict,2},already_declared}]}, {proper_gb_sets, [{{gb_set,1},already_declared}, {{iterator,1},already_declared}]}, {proper_gb_trees, [{{gb_tree,2},already_declared}, {{iterator,2},already_declared}]}, {proper_orddict, [{{orddict,2},already_declared}]}, {proper_ordsets, [{{ordset,1},already_declared}]}, {proper_queue, [{{queue,1},already_declared}]}, {proper_sets, [{{set,1},already_declared}]}, {queue, [{{queue,0}, {{type,0,tuple,[{type,0,list,[]},{type,0,list,[]}]},[]}}]}, {sets, [{{set,0}, {{type,0,record,[{atom,0,set}]},[]}}]}]). %%------------------------------------------------------------------------------ %% Types %%------------------------------------------------------------------------------ -type type_name() :: atom(). -type var_name() :: atom(). %% TODO: also integers? -type field_name() :: atom(). -type type_kind() :: 'type' | 'record'. -type type_ref() :: {type_kind(),type_name(),arity()}. -ifdef(NO_MODULES_IN_OPAQUES). -type substs_dict() :: dict(). %% dict(field_name(),ret_type()) -else. -type substs_dict() :: dict:dict(field_name(),ret_type()). -endif. -type full_type_ref() :: {mod_name(),type_kind(),type_name(), [ret_type()] | substs_dict()}. -type symb_info() :: 'not_symb' | {'orig_abs',abs_type()}. -type type_repr() :: {'abs_type',abs_type(),[var_name()],symb_info()} | {'cached',fin_type(),abs_type(),symb_info()} | {'abs_record',[{field_name(),abs_type()}]}. -type gen_fun() :: fun((size()) -> fin_type()). -type rec_fun() :: fun(([gen_fun()],size()) -> fin_type()). -type rec_arg() :: {boolean() | {'list',boolean(),rec_fun()},full_type_ref()}. -type rec_args() :: [rec_arg()]. -type ret_type() :: {'simple',fin_type()} | {'rec',rec_fun(),rec_args()}. -type rec_fun_info() :: {pos_integer(),pos_integer(),[arity(),...], [rec_fun(),...]}. -type imm_type_ref() :: {type_name(),arity()}. -type hard_adt_repr() :: {abs_type(),[var_name()]} | 'already_declared'. -type fun_ref() :: {fun_name(),arity()}. -type fun_repr() :: fun_clause_repr(). -type fun_clause_repr() :: {[abs_type()],abs_type()}. -type proc_fun_ref() :: {fun_name(),[abs_type()],abs_type()}. -type full_imm_type_ref() :: {mod_name(),type_name(),arity()}. -type imm_stack() :: [full_imm_type_ref()]. -type pat_field() :: 0 | 1 | atom(). -type pattern() :: loose_tuple(pat_field()). -type next_step() :: 'none' | 'take_head' | {'match_with',pattern()}. -ifdef(NO_MODULES_IN_OPAQUES). %% @private_type -type mod_exp_types() :: set(). %% set(imm_type_ref()) -type mod_types() :: dict(). %% dict(type_ref(),type_repr()) %% @private_type -type mod_exp_funs() :: set(). %% set(fun_ref()) -type mod_specs() :: dict(). %% dict(fun_ref(),fun_repr()) -else. %% @private_type -type mod_exp_types() :: sets:set(imm_type_ref()). -type mod_types() :: dict:dict(type_ref(),type_repr()). %% @private_type -type mod_exp_funs() :: sets:set(fun_ref()). -type mod_specs() :: dict:dict(fun_ref(),fun_repr()). -endif. -ifdef(NO_MODULES_IN_OPAQUES). -record(state, {cached = dict:new() :: dict(), %% dict(imm_type(),fin_type()) exp_types = dict:new() :: dict(), %% dict(mod_name(),mod_exp_types()) types = dict:new() :: dict(), %% dict(mod_name(),mod_types()) exp_specs = dict:new() :: dict()}). %% dict(mod_name(),mod_specs()) -else. -record(state, {cached = dict:new() :: dict:dict(imm_type(),fin_type()), exp_types = dict:new() :: dict:dict(mod_name(),mod_exp_types()), types = dict:new() :: dict:dict(mod_name(),mod_types()), exp_specs = dict:new() :: dict:dict(mod_name(),mod_specs())}). -endif. -type state() :: #state{}. -record(mod_info, {mod_exp_types = sets:new() :: mod_exp_types(), mod_types = dict:new() :: mod_types(), mod_opaques = sets:new() :: mod_exp_types(), mod_exp_funs = sets:new() :: mod_exp_funs(), mod_specs = dict:new() :: mod_specs()}). -type mod_info() :: #mod_info{}. -type stack() :: [full_type_ref() | 'tuple' | 'list' | 'union' | 'fun']. -ifdef(NO_MODULES_IN_OPAQUES). -type var_dict() :: dict(). %% dict(var_name(),ret_type()) -else. -type var_dict() :: dict:dict(var_name(),ret_type()). -endif. %% @private_type -type imm_type() :: {mod_name(),string()}. %% @alias -type fin_type() :: proper_types:type(). -type tagged_result(T) :: {'ok',T} | 'error'. -type tagged_result2(T,S) :: {'ok',T,S} | 'error'. %% @alias -type rich_result(T) :: {'ok',T} | {'error',term()}. -type rich_result2(T,S) :: {'ok',T,S} | {'error',term()}. -type false_positive_mfas() :: proper:false_positive_mfas(). -type server_call() :: {'create_spec_test',mfa(),timeout(),false_positive_mfas()} | {'get_exp_specced',mod_name()} | {'get_type_repr',mod_name(),type_ref(),boolean()} | {'translate_type',imm_type()}. -type server_response() :: rich_result(proper:test()) | rich_result([mfa()]) | rich_result(type_repr()) | rich_result(fin_type()). %%------------------------------------------------------------------------------ %% Server interface functions %%------------------------------------------------------------------------------ %% @private -spec start() -> 'ok'. start() -> {ok,TypeserverPid} = gen_server:start_link(?MODULE, dummy, []), put('$typeserver_pid', TypeserverPid), ok. %% @private -spec restart() -> 'ok'. restart() -> TypeserverPid = get('$typeserver_pid'), case (TypeserverPid =:= undefined orelse not is_process_alive(TypeserverPid)) of true -> start(); false -> ok end. %% @private -spec stop() -> 'ok'. stop() -> TypeserverPid = get('$typeserver_pid'), erase('$typeserver_pid'), gen_server:cast(TypeserverPid, stop). %% @private -spec create_spec_test(mfa(), timeout(), false_positive_mfas()) -> rich_result(proper:test()). create_spec_test(MFA, SpecTimeout, FalsePositiveMFAs) -> TypeserverPid = get('$typeserver_pid'), gen_server:call(TypeserverPid, {create_spec_test,MFA,SpecTimeout,FalsePositiveMFAs}). %% @private -spec get_exp_specced(mod_name()) -> rich_result([mfa()]). get_exp_specced(Mod) -> TypeserverPid = get('$typeserver_pid'), gen_server:call(TypeserverPid, {get_exp_specced,Mod}). -spec get_type_repr(mod_name(), type_ref(), boolean()) -> rich_result(type_repr()). get_type_repr(Mod, TypeRef, IsRemote) -> TypeserverPid = get('$typeserver_pid'), gen_server:call(TypeserverPid, {get_type_repr,Mod,TypeRef,IsRemote}). %% @private -spec translate_type(imm_type()) -> rich_result(fin_type()). translate_type(ImmType) -> TypeserverPid = get('$typeserver_pid'), gen_server:call(TypeserverPid, {translate_type,ImmType}). %% @doc Translates the native type expression `TypeExpr' (which should be %% provided inside a string) into a PropEr type, which can then be passed to any %% of the demo functions defined in the {@link proper_gen} module. PropEr acts %% as if it found this type expression inside the code of module `Mod'. -spec demo_translate_type(mod_name(), string()) -> rich_result(fin_type()). demo_translate_type(Mod, TypeExpr) -> start(), Result = translate_type({Mod,TypeExpr}), stop(), Result. %% @doc Checks if `Term' is a valid instance of native type `TypeExpr' (which %% should be provided inside a string). PropEr acts as if it found this type %% expression inside the code of module `Mod'. -spec demo_is_instance(term(), mod_name(), string()) -> boolean() | {'error',term()}. demo_is_instance(Term, Mod, TypeExpr) -> case parse_type(TypeExpr) of {ok,TypeForm} -> start(), Result = %% Force the typeserver to load the module. case translate_type({Mod,"integer()"}) of {ok,_FinType} -> try is_instance(Term, Mod, TypeForm) catch throw:{'$typeserver',Reason} -> {error, Reason} end; {error,_Reason} = Error -> Error end, stop(), Result; {error,_Reason} = Error -> Error end. %%------------------------------------------------------------------------------ %% Implementation of gen_server interface %%------------------------------------------------------------------------------ %% @private -spec init(_) -> {'ok',state()}. init(_) -> {ok, #state{}}. %% @private -spec handle_call(server_call(), _, state()) -> {'reply',server_response(),state()}. handle_call({create_spec_test,MFA,SpecTimeout,FalsePositiveMFAs}, _From, State) -> case create_spec_test(MFA, SpecTimeout, FalsePositiveMFAs, State) of {ok,Test,NewState} -> {reply, {ok,Test}, NewState}; {error,_Reason} = Error -> {reply, Error, State} end; handle_call({get_exp_specced,Mod}, _From, State) -> case get_exp_specced(Mod, State) of {ok,MFAs,NewState} -> {reply, {ok,MFAs}, NewState}; {error,_Reason} = Error -> {reply, Error, State} end; handle_call({get_type_repr,Mod,TypeRef,IsRemote}, _From, State) -> case get_type_repr(Mod, TypeRef, IsRemote, State) of {ok,TypeRepr,NewState} -> {reply, {ok,TypeRepr}, NewState}; {error,_Reason} = Error -> {reply, Error, State} end; handle_call({translate_type,ImmType}, _From, State) -> case translate_type(ImmType, State) of {ok,FinType,NewState} -> {reply, {ok,FinType}, NewState}; {error,_Reason} = Error -> {reply, Error, State} end. %% @private -spec handle_cast('stop', state()) -> {'stop','normal',state()}. handle_cast(stop, State) -> {stop, normal, State}. %% @private -spec handle_info(term(), state()) -> {'stop',{'received_info',term()},state()}. handle_info(Info, State) -> {stop, {received_info,Info}, State}. %% @private -spec terminate(term(), state()) -> 'ok'. terminate(_Reason, _State) -> ok. %% @private -spec code_change(term(), state(), _) -> {'ok',state()}. code_change(_OldVsn, State, _) -> {ok, State}. %%------------------------------------------------------------------------------ %% Top-level interface %%------------------------------------------------------------------------------ -spec create_spec_test(mfa(), timeout(), false_positive_mfas(), state()) -> rich_result2(proper:test(),state()). create_spec_test(MFA, SpecTimeout, FalsePositiveMFAs, State) -> case get_exp_spec(MFA, State) of {ok,FunRepr,NewState} -> make_spec_test(MFA, FunRepr, SpecTimeout, FalsePositiveMFAs, NewState); {error,_Reason} = Error -> Error end. -spec get_exp_spec(mfa(), state()) -> rich_result2(fun_repr(),state()). get_exp_spec({Mod,Fun,Arity} = MFA, State) -> case add_module(Mod, State) of {ok,#state{exp_specs = ExpSpecs} = NewState} -> ModExpSpecs = dict:fetch(Mod, ExpSpecs), case dict:find({Fun,Arity}, ModExpSpecs) of {ok,FunRepr} -> {ok, FunRepr, NewState}; error -> {error, {function_not_exported_or_specced,MFA}} end; {error,_Reason} = Error -> Error end. -spec make_spec_test(mfa(), fun_repr(), timeout(), false_positive_mfas(), state()) -> rich_result2(proper:test(),state()). make_spec_test({Mod,_Fun,_Arity}=MFA, {Domain,_Range}=FunRepr, SpecTimeout, FalsePositiveMFAs, State) -> case convert(Mod, {type,0,'$fixed_list',Domain}, State) of {ok,FinType,NewState} -> Test = ?FORALL(Args, FinType, apply_spec_test(MFA, FunRepr, SpecTimeout, FalsePositiveMFAs, Args)), {ok, Test, NewState}; {error,_Reason} = Error -> Error end. -spec apply_spec_test(mfa(), fun_repr(), timeout(), false_positive_mfas(), term()) -> proper:test(). apply_spec_test({Mod,Fun,_Arity}=MFA, {_Domain,Range}, SpecTimeout, FalsePositiveMFAs, Args) -> ?TIMEOUT(SpecTimeout, begin %% NOTE: only call apply/3 inside try/catch (do not trust ?MODULE:is_instance/3) Result = try apply(Mod,Fun,Args) of X -> {ok, X} catch X:Y -> {X, Y} end, case Result of {ok, Z} -> case ?MODULE:is_instance(Z,Mod,Range) of true -> true; false when is_function(FalsePositiveMFAs) -> FalsePositiveMFAs(MFA, Args, {fail, Z}); false -> false end; Exception when is_function(FalsePositiveMFAs) -> case FalsePositiveMFAs(MFA, Args, Exception) of true -> true; false -> error(Exception, erlang:get_stacktrace()) end; Exception -> error(Exception, erlang:get_stacktrace()) end end). -spec get_exp_specced(mod_name(), state()) -> rich_result2([mfa()],state()). get_exp_specced(Mod, State) -> case add_module(Mod, State) of {ok,#state{exp_specs = ExpSpecs} = NewState} -> ModExpSpecs = dict:fetch(Mod, ExpSpecs), ExpSpecced = [{Mod,F,A} || {F,A} <- dict:fetch_keys(ModExpSpecs)], {ok, ExpSpecced, NewState}; {error,_Reason} = Error -> Error end. -spec get_type_repr(mod_name(), type_ref(), boolean(), state()) -> rich_result2(type_repr(),state()). get_type_repr(Mod, {type,Name,Arity} = TypeRef, true, State) -> case prepare_for_remote(Mod, Name, Arity, State) of {ok,NewState} -> get_type_repr(Mod, TypeRef, false, NewState); {error,_Reason} = Error -> Error end; get_type_repr(Mod, TypeRef, false, #state{types = Types} = State) -> ModTypes = dict:fetch(Mod, Types), case dict:find(TypeRef, ModTypes) of {ok,TypeRepr} -> {ok, TypeRepr, State}; error -> {error, {missing_type,Mod,TypeRef}} end. -spec prepare_for_remote(mod_name(), type_name(), arity(), state()) -> rich_result(state()). prepare_for_remote(RemMod, Name, Arity, State) -> case add_module(RemMod, State) of {ok,#state{exp_types = ExpTypes} = NewState} -> RemModExpTypes = dict:fetch(RemMod, ExpTypes), case sets:is_element({Name,Arity}, RemModExpTypes) of true -> {ok, NewState}; false -> {error, {type_not_exported,{RemMod,Name,Arity}}} end; {error,_Reason} = Error -> Error end. -spec translate_type(imm_type(), state()) -> rich_result2(fin_type(),state()). translate_type({Mod,Str} = ImmType, #state{cached = Cached} = State) -> case dict:find(ImmType, Cached) of {ok,Type} -> {ok, Type, State}; error -> case parse_type(Str) of {ok,TypeForm} -> case add_module(Mod, State) of {ok,NewState} -> case convert(Mod, TypeForm, NewState) of {ok,FinType, #state{cached = Cached} = FinalState} -> NewCached = dict:store(ImmType, FinType, Cached), {ok, FinType, FinalState#state{cached = NewCached}}; {error,_Reason} = Error -> Error end; {error,_Reason} = Error -> Error end; {error,Reason} -> {error, {parse_error,Str,Reason}} end end. -spec parse_type(string()) -> rich_result(abs_type()). parse_type(Str) -> TypeStr = "-type mytype() :: " ++ Str ++ ".", case erl_scan:string(TypeStr) of {ok,Tokens,_EndLocation} -> case erl_parse:parse_form(Tokens) of {ok,{attribute,_Line,type,{mytype,TypeExpr,[]}}} -> {ok, TypeExpr}; {error,_ErrorInfo} = Error -> Error end; {error,ErrorInfo,_EndLocation} -> {error, ErrorInfo} end. -spec add_module(mod_name(), state()) -> rich_result(state()). add_module(Mod, #state{exp_types = ExpTypes} = State) -> case dict:is_key(Mod, ExpTypes) of true -> {ok, State}; false -> case get_code_and_exports(Mod) of {ok,AbsCode,ModExpFuns} -> RawModInfo = get_mod_info(Mod, AbsCode, ModExpFuns), ModInfo = process_adts(Mod, RawModInfo), {ok, store_mod_info(Mod,ModInfo,State)}; {error,Reason} -> {error, {cant_load_code,Mod,Reason}} end end. %% @private -spec get_exp_info(mod_name()) -> rich_result2(mod_exp_types(),mod_exp_funs()). get_exp_info(Mod) -> case get_code_and_exports(Mod) of {ok,AbsCode,ModExpFuns} -> RawModInfo = get_mod_info(Mod, AbsCode, ModExpFuns), {ok, RawModInfo#mod_info.mod_exp_types, ModExpFuns}; {error,_Reason} = Error -> Error end. -spec get_code_and_exports(mod_name()) -> rich_result2([abs_form()],mod_exp_funs()). get_code_and_exports(Mod) -> case code:get_object_code(Mod) of {Mod, ObjBin, _ObjFileName} -> case get_chunks(ObjBin) of {ok,_AbsCode,_ModExpFuns} = Result -> Result; {error,Reason} -> get_code_and_exports_from_source(Mod, Reason) end; error -> get_code_and_exports_from_source(Mod, cant_find_object_file) end. -spec get_code_and_exports_from_source(mod_name(), term()) -> rich_result2([abs_form()],mod_exp_funs()). get_code_and_exports_from_source(Mod, ObjError) -> SrcFileName = atom_to_list(Mod) ++ ?SRC_FILE_EXT, case code:where_is_file(SrcFileName) of FullSrcFileName when is_list(FullSrcFileName) -> Opts = [binary,debug_info,return_errors,{d,'PROPER_REMOVE_PROPS'}], case compile:file(FullSrcFileName, Opts) of {ok,Mod,Binary} -> get_chunks(Binary); {error,Errors,_Warnings} -> {error, {ObjError,{cant_compile_source_file,Errors}}} end; non_existing -> {error, {ObjError,cant_find_source_file}} end. -spec get_chunks(string() | binary()) -> rich_result2([abs_form()],mod_exp_funs()). get_chunks(ObjFile) -> case beam_lib:chunks(ObjFile, [abstract_code,exports]) of {ok,{_Mod,[{abstract_code,AbsCodeChunk},{exports,ExpFunsList}]}} -> case AbsCodeChunk of {raw_abstract_v1,AbsCode} -> %% HACK: Add a declaration for iolist() to every module {ok, add_iolist(AbsCode), sets:from_list(ExpFunsList)}; no_abstract_code -> {error, no_abstract_code}; _ -> {error, unsupported_abstract_code_format} end; {error,beam_lib,Reason} -> {error, Reason} end. -spec add_iolist([abs_form()]) -> [abs_form()]. add_iolist(Forms) -> IOListDef = {type,0,maybe_improper_list, [{type,0,union,[{type,0,byte,[]},{type,0,binary,[]}, {type,0,iolist,[]}]}, {type,0,binary,[]}]}, IOListDecl = {attribute,0,type,{iolist,IOListDef,[]}}, [IOListDecl | Forms]. -spec get_mod_info(mod_name(), [abs_form()], mod_exp_funs()) -> mod_info(). get_mod_info(Mod, AbsCode, ModExpFuns) -> StartModInfo = #mod_info{mod_exp_funs = ModExpFuns}, ImmModInfo = lists:foldl(fun add_mod_info/2, StartModInfo, AbsCode), #mod_info{mod_specs = AllModSpecs} = ImmModInfo, IsExported = fun(FunRef,_FunRepr) -> sets:is_element(FunRef,ModExpFuns) end, ModExpSpecs = dict:filter(IsExported, AllModSpecs), ModInfo = ImmModInfo#mod_info{mod_specs = ModExpSpecs}, case orddict:find(Mod, ?HARD_ADT_MODS) of {ok,ModADTs} -> #mod_info{mod_exp_types = ModExpTypes, mod_types = ModTypes, mod_opaques = ModOpaques} = ModInfo, ModADTsSet = sets:from_list([ImmTypeRef || {ImmTypeRef,_HardADTRepr} <- ModADTs]), NewModExpTypes = sets:union(ModExpTypes, ModADTsSet), NewModTypes = lists:foldl(fun store_hard_adt/2, ModTypes, ModADTs), NewModOpaques = sets:union(ModOpaques, ModADTsSet), ModInfo#mod_info{mod_exp_types = NewModExpTypes, mod_types = NewModTypes, mod_opaques = NewModOpaques}; error -> ModInfo end. -spec store_hard_adt({imm_type_ref(),hard_adt_repr()}, mod_types()) -> mod_types(). store_hard_adt({_ImmTypeRef,already_declared}, ModTypes) -> ModTypes; store_hard_adt({{Name,Arity},{TypeForm,VarNames}}, ModTypes) -> TypeRef = {type,Name,Arity}, TypeRepr = {abs_type,TypeForm,VarNames,not_symb}, dict:store(TypeRef, TypeRepr, ModTypes). -spec add_mod_info(abs_form(), mod_info()) -> mod_info(). add_mod_info({attribute,_Line,export_type,TypesList}, #mod_info{mod_exp_types = ModExpTypes} = ModInfo) -> NewModExpTypes = sets:union(sets:from_list(TypesList), ModExpTypes), ModInfo#mod_info{mod_exp_types = NewModExpTypes}; add_mod_info({attribute,_Line,type,{{record,RecName},Fields,[]}}, #mod_info{mod_types = ModTypes} = ModInfo) -> FieldInfo = [process_rec_field(F) || F <- Fields], NewModTypes = dict:store({record,RecName,0}, {abs_record,FieldInfo}, ModTypes), ModInfo#mod_info{mod_types = NewModTypes}; add_mod_info({attribute,_Line,record,{RecName,Fields}}, #mod_info{mod_types = ModTypes} = ModInfo) -> case dict:is_key(RecName, ModTypes) of true -> ModInfo; false -> TypedRecord = {attribute,0,type,{{record,RecName},Fields,[]}}, add_mod_info(TypedRecord, ModInfo) end; add_mod_info({attribute,_Line,Kind,{Name,TypeForm,VarForms}}, #mod_info{mod_types = ModTypes, mod_opaques = ModOpaques} = ModInfo) when Kind =:= type; Kind =:= opaque -> Arity = length(VarForms), VarNames = [V || {var,_,V} <- VarForms], %% TODO: No check whether variables are different, or non-'_'. NewModTypes = dict:store({type,Name,Arity}, {abs_type,TypeForm,VarNames,not_symb}, ModTypes), NewModOpaques = case Kind of type -> ModOpaques; opaque -> sets:add_element({Name,Arity}, ModOpaques) end, ModInfo#mod_info{mod_types = NewModTypes, mod_opaques = NewModOpaques}; add_mod_info({attribute,_Line,spec,{RawFunRef,[RawFirstClause | _Rest]}}, #mod_info{mod_specs = ModSpecs} = ModInfo) -> FunRef = case RawFunRef of {_Mod,Name,Arity} -> {Name,Arity}; {_Name,_Arity} = F -> F end, %% TODO: We just take the first function clause. FirstClause = process_fun_clause(RawFirstClause), NewModSpecs = dict:store(FunRef, FirstClause, ModSpecs), ModInfo#mod_info{mod_specs = NewModSpecs}; add_mod_info(_Form, ModInfo) -> ModInfo. -spec process_rec_field(abs_rec_field()) -> {field_name(),abs_type()}. process_rec_field({record_field,_,{atom,_,FieldName}}) -> {FieldName, {type,0,any,[]}}; process_rec_field({record_field,_,{atom,_,FieldName},_Initialization}) -> {FieldName, {type,0,any,[]}}; process_rec_field({typed_record_field,RecField,FieldType}) -> {FieldName,_} = process_rec_field(RecField), {FieldName, FieldType}. -spec process_fun_clause(abs_type()) -> fun_clause_repr(). process_fun_clause({type,_,'fun',[{type,_,product,Domain},Range]}) -> {Domain, Range}; process_fun_clause({type,_,bounded_fun,[MainClause,Constraints]}) -> {RawDomain,RawRange} = process_fun_clause(MainClause), VarSubsts = [{V,T} || {type,_,constraint, [{atom,_,is_subtype},[{var,_,V},T]]} <- Constraints, V =/= '_'], VarSubstsDict = dict:from_list(VarSubsts), Domain = [update_vars(A, VarSubstsDict, false) || A <- RawDomain], Range = update_vars(RawRange, VarSubstsDict, false), {Domain, Range}. -spec store_mod_info(mod_name(), mod_info(), state()) -> state(). store_mod_info(Mod, #mod_info{mod_exp_types = ModExpTypes, mod_types = ModTypes, mod_specs = ImmModExpSpecs}, #state{exp_types = ExpTypes, types = Types, exp_specs = ExpSpecs} = State) -> NewExpTypes = dict:store(Mod, ModExpTypes, ExpTypes), NewTypes = dict:store(Mod, ModTypes, Types), ModExpSpecs = dict:map(fun unbound_to_any/2, ImmModExpSpecs), NewExpSpecs = dict:store(Mod, ModExpSpecs, ExpSpecs), State#state{exp_types = NewExpTypes, types = NewTypes, exp_specs = NewExpSpecs}. -spec unbound_to_any(fun_ref(), fun_repr()) -> fun_repr(). unbound_to_any(_FunRef, {Domain,Range}) -> EmptySubstsDict = dict:new(), NewDomain = [update_vars(A,EmptySubstsDict,true) || A <- Domain], NewRange = update_vars(Range, EmptySubstsDict, true), {NewDomain, NewRange}. %%------------------------------------------------------------------------------ %% ADT translation functions %%------------------------------------------------------------------------------ -spec process_adts(mod_name(), mod_info()) -> mod_info(). process_adts(Mod, #mod_info{mod_exp_types = ModExpTypes, mod_opaques = ModOpaques, mod_specs = ModExpSpecs} = ModInfo) -> %% TODO: No warning on unexported opaques. case sets:to_list(sets:intersection(ModExpTypes,ModOpaques)) of [] -> ModInfo; ModADTs -> %% TODO: No warning on unexported API functions. ModExpSpecsList = [{Name,Domain,Range} || {{Name,_Arity},{Domain,Range}} <- dict:to_list(ModExpSpecs)], AddADT = fun(ADT,Acc) -> add_adt(Mod,ADT,Acc,ModExpSpecsList) end, lists:foldl(AddADT, ModInfo, ModADTs) end. -spec add_adt(mod_name(), imm_type_ref(), mod_info(), [proc_fun_ref()]) -> mod_info(). add_adt(Mod, {Name,Arity}, #mod_info{mod_types = ModTypes} = ModInfo, ModExpFunSpecs) -> ADTRef = {type,Name,Arity}, {abs_type,InternalRepr,VarNames,not_symb} = dict:fetch(ADTRef, ModTypes), FullADTRef = {Mod,Name,Arity}, %% TODO: No warning on unsuitable range. SymbCalls1 = [get_symb_call(FullADTRef,Spec) || Spec <- ModExpFunSpecs], %% TODO: No warning on bad use of variables. SymbCalls2 = [fix_vars(FullADTRef,Call,RangeVars,VarNames) || {ok,Call,RangeVars} <- SymbCalls1], case [Call || {ok,Call} <- SymbCalls2] of [] -> %% TODO: No warning on no acceptable spec. ModInfo; SymbCalls3 -> NewADTRepr = {abs_type,{type,0,union,SymbCalls3},VarNames, {orig_abs,InternalRepr}}, NewModTypes = dict:store(ADTRef, NewADTRepr, ModTypes), ModInfo#mod_info{mod_types = NewModTypes} end. -spec get_symb_call(full_imm_type_ref(), proc_fun_ref()) -> tagged_result2(abs_type(),[var_name()]). get_symb_call({Mod,_TypeName,_Arity} = FullADTRef, {FunName,Domain,Range}) -> BaseCall = {type,0,tuple,[{atom,0,'$call'},{atom,0,Mod},{atom,0,FunName}, {type,0,'$fixed_list',Domain}]}, unwrap_range(FullADTRef, BaseCall, Range, false). -spec unwrap_range(full_imm_type_ref(), abs_type() | next_step(), abs_type(), boolean()) -> tagged_result2(abs_type() | next_step(),[var_name()]). unwrap_range(FullADTRef, Call, {paren_type,_,[Type]}, TestRun) -> unwrap_range(FullADTRef, Call, Type, TestRun); unwrap_range(FullADTRef, Call, {ann_type,_,[_Var,Type]}, TestRun) -> unwrap_range(FullADTRef, Call, Type, TestRun); unwrap_range(FullADTRef, Call, {type,_,list,[ElemType]}, TestRun) -> unwrap_list(FullADTRef, Call, ElemType, TestRun); unwrap_range(FullADTRef, Call, {type,_,maybe_improper_list,[Cont,_Term]}, TestRun) -> unwrap_list(FullADTRef, Call, Cont, TestRun); unwrap_range(FullADTRef, Call, {type,_,nonempty_list,[ElemType]}, TestRun) -> unwrap_list(FullADTRef, Call, ElemType, TestRun); unwrap_range(FullADTRef, Call, {type,_,nonempty_improper_list,[Cont,_Term]}, TestRun) -> unwrap_list(FullADTRef, Call, Cont, TestRun); unwrap_range(FullADTRef, Call, {type,_,nonempty_maybe_improper_list,[Cont,_Term]}, TestRun) -> unwrap_list(FullADTRef, Call, Cont, TestRun); unwrap_range(_FullADTRef, _Call, {type,_,tuple,any}, _TestRun) -> error; unwrap_range(FullADTRef, Call, {type,_,tuple,FieldForms}, TestRun) -> Translates = fun(T) -> unwrap_range(FullADTRef,none,T,true) =/= error end, case proper_arith:find_first(Translates, FieldForms) of none -> error; {TargetPos,TargetElem} -> Pattern = get_pattern(TargetPos, FieldForms), case TestRun of true -> NewCall = case Call of none -> {match_with,Pattern}; _ -> Call end, {ok, NewCall, []}; false -> AbsPattern = term_to_singleton_type(Pattern), NewCall = {type,0,tuple, [{atom,0,'$call'},{atom,0,?MODULE},{atom,0,match}, {type,0,'$fixed_list',[AbsPattern,Call]}]}, unwrap_range(FullADTRef, NewCall, TargetElem, TestRun) end end; unwrap_range(FullADTRef, Call, {type,_,union,Choices}, TestRun) -> TestedChoices = [unwrap_range(FullADTRef,none,C,true) || C <- Choices], NotError = fun(error) -> false; (_) -> true end, case proper_arith:find_first(NotError, TestedChoices) of none -> error; {_ChoicePos,{ok,none,_RangeVars}} -> error; {ChoicePos,{ok,NextStep,_RangeVars}} -> {A, [ChoiceElem|B]} = lists:split(ChoicePos-1, Choices), OtherChoices = A ++ B, DistinctChoice = case NextStep of take_head -> fun cant_have_head/1; {match_with,Pattern} -> fun(C) -> cant_match(Pattern, C) end end, case {lists:all(DistinctChoice,OtherChoices), TestRun} of {true,true} -> {ok, NextStep, []}; {true,false} -> unwrap_range(FullADTRef, Call, ChoiceElem, TestRun); {false,_} -> error end end; unwrap_range({_Mod,SameName,Arity}, Call, {type,_,SameName,ArgForms}, _TestRun) -> RangeVars = [V || {var,_,V} <- ArgForms, V =/= '_'], case length(ArgForms) =:= Arity andalso length(RangeVars) =:= Arity of true -> {ok, Call, RangeVars}; false -> error end; unwrap_range({SameMod,SameName,_Arity} = FullADTRef, Call, {remote_type,_,[{atom,_,SameMod},{atom,_,SameName},ArgForms]}, TestRun) -> unwrap_range(FullADTRef, Call, {type,0,SameName,ArgForms}, TestRun); unwrap_range(_FullADTRef, _Call, _Range, _TestRun) -> error. -spec unwrap_list(full_imm_type_ref(), abs_type() | next_step(), abs_type(), boolean()) -> tagged_result2(abs_type() | next_step(),[var_name()]). unwrap_list(FullADTRef, Call, HeadType, TestRun) -> NewCall = case TestRun of true -> case Call of none -> take_head; _ -> Call end; false -> {type,0,tuple,[{atom,0,'$call'},{atom,0,erlang},{atom,0,hd}, {type,0,'$fixed_list',[Call]}]} end, unwrap_range(FullADTRef, NewCall, HeadType, TestRun). -spec fix_vars(full_imm_type_ref(), abs_type(), [var_name()], [var_name()]) -> tagged_result(abs_type()). fix_vars(FullADTRef, Call, RangeVars, VarNames) -> NotAnyVar = fun(V) -> V =/= '_' end, case no_duplicates(VarNames) andalso lists:all(NotAnyVar,VarNames) of true -> RawUsedVars = collect_vars(FullADTRef, Call, [[V] || V <- RangeVars]), UsedVars = [lists:usort(L) || L <- RawUsedVars], case correct_var_use(UsedVars) of true -> PairAll = fun(L,Y) -> [{X,{var,0,Y}} || X <- L] end, VarSubsts = lists:flatten(lists:zipwith(PairAll,UsedVars,VarNames)), VarSubstsDict = dict:from_list(VarSubsts), {ok, update_vars(Call,VarSubstsDict,true)}; false -> error end; false -> error end. -spec no_duplicates(list()) -> boolean(). no_duplicates(L) -> length(lists:usort(L)) =:= length(L). -spec correct_var_use([[var_name() | 0]]) -> boolean(). correct_var_use(UsedVars) -> NoNonVarArgs = fun([0|_]) -> false; (_) -> true end, lists:all(NoNonVarArgs, UsedVars) andalso no_duplicates(lists:flatten(UsedVars)). -spec collect_vars(full_imm_type_ref(), abs_type(), [[var_name() | 0]]) -> [[var_name() | 0]]. collect_vars(FullADTRef, {paren_type,_,[Type]}, UsedVars) -> collect_vars(FullADTRef, Type, UsedVars); collect_vars(FullADTRef, {ann_type,_,[_Var,Type]}, UsedVars) -> collect_vars(FullADTRef, Type, UsedVars); collect_vars(_FullADTRef, {type,_,tuple,any}, UsedVars) -> UsedVars; collect_vars({_Mod,SameName,Arity} = FullADTRef, {type,_,SameName,ArgForms}, UsedVars) -> case length(ArgForms) =:= Arity of true -> VarArgs = [V || {var,_,V} <- ArgForms, V =/= '_'], case length(VarArgs) =:= Arity of true -> AddToList = fun(X,L) -> [X | L] end, lists:zipwith(AddToList, VarArgs, UsedVars); false -> [[0|L] || L <- UsedVars] end; false -> multi_collect_vars(FullADTRef, ArgForms, UsedVars) end; collect_vars(FullADTRef, {type,_,_Name,ArgForms}, UsedVars) -> multi_collect_vars(FullADTRef, ArgForms, UsedVars); collect_vars({SameMod,SameName,_Arity} = FullADTRef, {remote_type,_,[{atom,_,SameMod},{atom,_,SameName},ArgForms]}, UsedVars) -> collect_vars(FullADTRef, {type,0,SameName,ArgForms}, UsedVars); collect_vars(FullADTRef, {remote_type,_,[_RemModForm,_NameForm,ArgForms]}, UsedVars) -> multi_collect_vars(FullADTRef, ArgForms, UsedVars); collect_vars(_FullADTRef, _Call, UsedVars) -> UsedVars. -spec multi_collect_vars(full_imm_type_ref(), [abs_type()], [[var_name() | 0]]) -> [[var_name() | 0]]. multi_collect_vars({_Mod,_Name,Arity} = FullADTRef, Forms, UsedVars) -> NoUsedVars = lists:duplicate(Arity, []), MoreUsedVars = [collect_vars(FullADTRef,T,NoUsedVars) || T <- Forms], CombineVars = fun(L1,L2) -> lists:zipwith(fun erlang:'++'/2, L1, L2) end, lists:foldl(CombineVars, UsedVars, MoreUsedVars). -ifdef(NO_MODULES_IN_OPAQUES). -type var_substs_dict() :: dict(). -else. -type var_substs_dict() :: dict:dict(var_name(),abs_type()). -endif. -spec update_vars(abs_type(), var_substs_dict(), boolean()) -> abs_type(). update_vars({paren_type,Line,[Type]}, VarSubstsDict, UnboundToAny) -> {paren_type, Line, [update_vars(Type,VarSubstsDict,UnboundToAny)]}; update_vars({ann_type,Line,[Var,Type]}, VarSubstsDict, UnboundToAny) -> {ann_type, Line, [Var,update_vars(Type,VarSubstsDict,UnboundToAny)]}; update_vars({var,Line,VarName} = Call, VarSubstsDict, UnboundToAny) -> case dict:find(VarName, VarSubstsDict) of {ok,SubstType} -> SubstType; error when UnboundToAny =:= false -> Call; error when UnboundToAny =:= true -> {type,Line,any,[]} end; update_vars({remote_type,Line,[RemModForm,NameForm,ArgForms]}, VarSubstsDict, UnboundToAny) -> NewArgForms = [update_vars(A,VarSubstsDict,UnboundToAny) || A <- ArgForms], {remote_type, Line, [RemModForm,NameForm,NewArgForms]}; update_vars({type,_,tuple,any} = Call, _VarSubstsDict, _UnboundToAny) -> Call; update_vars({type,Line,Name,ArgForms}, VarSubstsDict, UnboundToAny) -> {type, Line, Name, [update_vars(A,VarSubstsDict,UnboundToAny) || A <- ArgForms]}; update_vars(Call, _VarSubstsDict, _UnboundToAny) -> Call. %%------------------------------------------------------------------------------ %% Match-related functions %%------------------------------------------------------------------------------ -spec get_pattern(position(), [abs_type()]) -> pattern(). get_pattern(TargetPos, FieldForms) -> {0,RevPattern} = lists:foldl(fun add_field/2, {TargetPos,[]}, FieldForms), list_to_tuple(lists:reverse(RevPattern)). -spec add_field(abs_type(), {non_neg_integer(),[pat_field()]}) -> {non_neg_integer(),[pat_field(),...]}. add_field(_Type, {1,Acc}) -> {0, [1|Acc]}; add_field({atom,_,Tag}, {Left,Acc}) -> {erlang:max(0,Left-1), [Tag|Acc]}; add_field(_Type, {Left,Acc}) -> {erlang:max(0,Left-1), [0|Acc]}. %% @private -spec match(pattern(), tuple()) -> term(). match(Pattern, Term) when tuple_size(Pattern) =:= tuple_size(Term) -> match(tuple_to_list(Pattern), tuple_to_list(Term), none, false); match(_Pattern, _Term) -> throw(no_match). -spec match([pat_field()], [term()], 'none' | {'ok',T}, boolean()) -> T. match([], [], {ok,Target}, _TypeMode) -> Target; match([0|PatRest], [_|ToMatchRest], Acc, TypeMode) -> match(PatRest, ToMatchRest, Acc, TypeMode); match([1|PatRest], [Target|ToMatchRest], none, TypeMode) -> match(PatRest, ToMatchRest, {ok,Target}, TypeMode); match([Tag|PatRest], [X|ToMatchRest], Acc, TypeMode) when is_atom(Tag) -> MatchesTag = case TypeMode of true -> can_be_tag(Tag, X); false -> Tag =:= X end, case MatchesTag of true -> match(PatRest, ToMatchRest, Acc, TypeMode); false -> throw(no_match) end. %% CAUTION: these must be sorted -define(NON_ATOM_TYPES, [arity,binary,bitstring,byte,char,float,'fun',function,integer,iodata, iolist,list,maybe_improper_list,mfa,neg_integer,nil,no_return, non_neg_integer,none,nonempty_improper_list,nonempty_list, nonempty_maybe_improper_list,nonempty_string,number,pid,port, pos_integer,range,record,reference,string,tuple]). -define(NON_TUPLE_TYPES, [arity,atom,binary,bitstring,bool,boolean,byte,char,float,'fun', function,identifier,integer,iodata,iolist,list,maybe_improper_list, neg_integer,nil,no_return,node,non_neg_integer,none, nonempty_improper_list,nonempty_list,nonempty_maybe_improper_list, nonempty_string,number,pid,port,pos_integer,range,reference,string, timeout]). -define(NO_HEAD_TYPES, [arity,atom,binary,bitstring,bool,boolean,byte,char,float,'fun', function,identifier,integer,mfa,module,neg_integer,nil,no_return,node, non_neg_integer,none,number,pid,port,pos_integer,range,record, reference,timeout,tuple]). -spec can_be_tag(atom(), abs_type()) -> boolean(). can_be_tag(Tag, {ann_type,_,[_Var,Type]}) -> can_be_tag(Tag, Type); can_be_tag(Tag, {paren_type,_,[Type]}) -> can_be_tag(Tag, Type); can_be_tag(Tag, {atom,_,Atom}) -> Tag =:= Atom; can_be_tag(_Tag, {integer,_,_Int}) -> false; can_be_tag(_Tag, {op,_,_Op,_Arg}) -> false; can_be_tag(_Tag, {op,_,_Op,_Arg1,_Arg2}) -> false; can_be_tag(Tag, {type,_,BName,[]}) when BName =:= bool; BName =:= boolean -> is_boolean(Tag); can_be_tag(Tag, {type,_,timeout,[]}) -> Tag =:= infinity; can_be_tag(Tag, {type,_,union,Choices}) -> lists:any(fun(C) -> can_be_tag(Tag,C) end, Choices); can_be_tag(_Tag, {type,_,Name,_Args}) -> not ordsets:is_element(Name, ?NON_ATOM_TYPES); can_be_tag(_Tag, _Type) -> true. -spec cant_match(pattern(), abs_type()) -> boolean(). cant_match(Pattern, {ann_type,_,[_Var,Type]}) -> cant_match(Pattern, Type); cant_match(Pattern, {paren_type,_,[Type]}) -> cant_match(Pattern, Type); cant_match(_Pattern, {atom,_,_Atom}) -> true; cant_match(_Pattern, {integer,_,_Int}) -> true; cant_match(_Pattern, {op,_,_Op,_Arg}) -> true; cant_match(_Pattern, {op,_,_Op,_Arg1,_Arg2}) -> true; cant_match(Pattern, {type,_,mfa,[]}) -> cant_match(Pattern, {type,0,tuple,[{type,0,atom,[]},{type,0,atom,[]}, {type,0,arity,[]}]}); cant_match(Pattern, {type,_,union,Choices}) -> lists:all(fun(C) -> cant_match(Pattern,C) end, Choices); cant_match(_Pattern, {type,_,tuple,any}) -> false; cant_match(Pattern, {type,_,tuple,Fields}) -> tuple_size(Pattern) =/= length(Fields) orelse try match(tuple_to_list(Pattern), Fields, none, true) of _ -> false catch throw:no_match -> true end; cant_match(_Pattern, {type,_,Name,_Args}) -> ordsets:is_element(Name, ?NON_TUPLE_TYPES); cant_match(_Pattern, _Type) -> false. -spec cant_have_head(abs_type()) -> boolean(). cant_have_head({ann_type,_,[_Var,Type]}) -> cant_have_head(Type); cant_have_head({paren_type,_,[Type]}) -> cant_have_head(Type); cant_have_head({atom,_,_Atom}) -> true; cant_have_head({integer,_,_Int}) -> true; cant_have_head({op,_,_Op,_Arg}) -> true; cant_have_head({op,_,_Op,_Arg1,_Arg2}) -> true; cant_have_head({type,_,union,Choices}) -> lists:all(fun cant_have_head/1, Choices); cant_have_head({type,_,Name,_Args}) -> ordsets:is_element(Name, ?NO_HEAD_TYPES); cant_have_head(_Type) -> false. %% Only covers atoms, integers and tuples, i.e. those that can be specified %% through singleton types. -spec term_to_singleton_type(atom() | integer() | loose_tuple(atom() | integer())) -> abs_type(). term_to_singleton_type(Atom) when is_atom(Atom) -> {atom,0,Atom}; term_to_singleton_type(Int) when is_integer(Int), Int >= 0 -> {integer,0,Int}; term_to_singleton_type(Int) when is_integer(Int), Int < 0 -> {op,0,'-',{integer,0,-Int}}; term_to_singleton_type(Tuple) when is_tuple(Tuple) -> Fields = tuple_to_list(Tuple), {type,0,tuple,[term_to_singleton_type(F) || F <- Fields]}. %%------------------------------------------------------------------------------ %% Instance testing functions %%------------------------------------------------------------------------------ %% CAUTION: this must be sorted -define(EQUIV_TYPES, [{arity, {type,0,range,[{integer,0,0},{integer,0,255}]}}, {bool, {type,0,boolean,[]}}, {byte, {type,0,range,[{integer,0,0},{integer,0,255}]}}, {char, {type,0,range,[{integer,0,0},{integer,0,16#10ffff}]}}, {function, {type,0,'fun',[]}}, {identifier, {type,0,union,[{type,0,pid,[]},{type,0,port,[]}, {type,0,reference,[]}]}}, {iodata, {type,0,union,[{type,0,binary,[]},{type,0,iolist,[]}]}}, {iolist, {type,0,maybe_improper_list, [{type,0,union,[{type,0,byte,[]},{type,0,binary,[]}, {type,0,iolist,[]}]}, {type,0,binary,[]}]}}, {list, {type,0,list,[{type,0,any,[]}]}}, {maybe_improper_list, {type,0,maybe_improper_list,[{type,0,any,[]}, {type,0,any,[]}]}}, {mfa, {type,0,tuple,[{type,0,atom,[]},{type,0,atom,[]}, {type,0,arity,[]}]}}, {node, {type,0,atom,[]}}, {nonempty_list, {type,0,nonempty_list,[{type,0,any,[]}]}}, {nonempty_maybe_improper_list, {type,0,nonempty_maybe_improper_list, [{type,0,any,[]},{type,0,any,[]}]}}, {nonempty_string, {type,0,nonempty_list,[{type,0,char,[]}]}}, {string, {type,0,list,[{type,0,char,[]}]}}, {term, {type,0,any,[]}}, {timeout, {type,0,union,[{atom,0,infinity}, {type,0,non_neg_integer,[]}]}}]). %% @private %% TODO: Most of these functions accept an extended form of abs_type(), namely %% the addition of a custom wrapper: {'from_mod',mod_name(),...} -spec is_instance(term(), mod_name(), abs_type()) -> boolean(). is_instance(X, Mod, TypeForm) -> is_instance(X, Mod, TypeForm, []). -spec is_instance(term(), mod_name(), abs_type(), imm_stack()) -> boolean(). is_instance(X, _Mod, {from_mod,OrigMod,Type}, Stack) -> is_instance(X, OrigMod, Type, Stack); is_instance(_X, _Mod, {var,_,'_'}, _Stack) -> true; is_instance(_X, _Mod, {var,_,Name}, _Stack) -> %% All unconstrained spec vars have been replaced by 'any()' and we always %% replace the variables on the RHS of types before recursing into them. %% Provided that '-type' declarations contain no unbound variables, we %% don't expect to find any non-'_' variables while recursing. throw({'$typeserver',{unbound_var_in_type_declaration,Name}}); is_instance(X, Mod, {ann_type,_,[_Var,Type]}, Stack) -> is_instance(X, Mod, Type, Stack); is_instance(X, Mod, {paren_type,_,[Type]}, Stack) -> is_instance(X, Mod, Type, Stack); is_instance(X, Mod, {remote_type,_,[{atom,_,RemMod},{atom,_,Name},ArgForms]}, Stack) -> is_custom_instance(X, Mod, RemMod, Name, ArgForms, true, Stack); is_instance(SameAtom, _Mod, {atom,_,SameAtom}, _Stack) -> true; is_instance(SameInt, _Mod, {integer,_,SameInt}, _Stack) -> true; is_instance(X, _Mod, {op,_,_Op,_Arg} = Expr, _Stack) -> is_int_const(X, Expr); is_instance(X, _Mod, {op,_,_Op,_Arg1,_Arg2} = Expr, _Stack) -> is_int_const(X, Expr); is_instance(_X, _Mod, {type,_,any,[]}, _Stack) -> true; is_instance(X, _Mod, {type,_,atom,[]}, _Stack) -> is_atom(X); is_instance(X, _Mod, {type,_,binary,[]}, _Stack) -> is_binary(X); is_instance(X, _Mod, {type,_,binary,[BaseExpr,UnitExpr]}, _Stack) -> %% <<_:X,_:_*Y>> means "bitstrings of X + k*Y bits, k >= 0" case eval_int(BaseExpr) of {ok,Base} when Base >= 0 -> case eval_int(UnitExpr) of {ok,Unit} when Unit >= 0 -> case is_bitstring(X) of true -> BitSizeX = bit_size(X), case Unit =:= 0 of true -> BitSizeX =:= Base; false -> BitSizeX >= Base andalso (BitSizeX - Base) rem Unit =:= 0 end; false -> false end; _ -> abs_expr_error(invalid_unit, UnitExpr) end; _ -> abs_expr_error(invalid_base, BaseExpr) end; is_instance(X, _Mod, {type,_,bitstring,[]}, _Stack) -> is_bitstring(X); is_instance(X, _Mod, {type,_,boolean,[]}, _Stack) -> is_boolean(X); is_instance(X, _Mod, {type,_,float,[]}, _Stack) -> is_float(X); is_instance(X, _Mod, {type,_,'fun',[]}, _Stack) -> is_function(X); %% TODO: how to check range type? random inputs? special case for 0-arity? is_instance(X, _Mod, {type,_,'fun',[{type,_,any,[]},_Range]}, _Stack) -> is_function(X); is_instance(X, _Mod, {type,_,'fun',[{type,_,product,Domain},_Range]}, _Stack) -> is_function(X, length(Domain)); is_instance(X, _Mod, {type,_,integer,[]}, _Stack) -> is_integer(X); is_instance(X, Mod, {type,_,list,[Type]}, _Stack) -> list_test(X, Mod, Type, dummy, true, true, false); is_instance(X, Mod, {type,_,maybe_improper_list,[Cont,Term]}, _Stack) -> list_test(X, Mod, Cont, Term, true, true, true); is_instance(X, _Mod, {type,_,module,[]}, _Stack) -> is_atom(X) orelse is_tuple(X) andalso X =/= {} andalso is_atom(element(1,X)); is_instance([], _Mod, {type,_,nil,[]}, _Stack) -> true; is_instance(X, _Mod, {type,_,neg_integer,[]}, _Stack) -> is_integer(X) andalso X < 0; is_instance(X, _Mod, {type,_,non_neg_integer,[]}, _Stack) -> is_integer(X) andalso X >= 0; is_instance(X, Mod, {type,_,nonempty_list,[Type]}, _Stack) -> list_test(X, Mod, Type, dummy, false, true, false); is_instance(X, Mod, {type,_,nonempty_improper_list,[Cont,Term]}, _Stack) -> list_test(X, Mod, Cont, Term, false, false, true); is_instance(X, Mod, {type,_,nonempty_maybe_improper_list,[Cont,Term]}, _Stack) -> list_test(X, Mod, Cont, Term, false, true, true); is_instance(X, _Mod, {type,_,number,[]}, _Stack) -> is_number(X); is_instance(X, _Mod, {type,_,pid,[]}, _Stack) -> is_pid(X); is_instance(X, _Mod, {type,_,port,[]}, _Stack) -> is_port(X); is_instance(X, _Mod, {type,_,pos_integer,[]}, _Stack) -> is_integer(X) andalso X > 0; is_instance(_X, _Mod, {type,_,product,_Elements}, _Stack) -> throw({'$typeserver',{internal,product_in_is_instance}}); is_instance(X, _Mod, {type,_,range,[LowExpr,HighExpr]}, _Stack) -> case {eval_int(LowExpr),eval_int(HighExpr)} of {{ok,Low},{ok,High}} when Low =< High -> X >= Low andalso X =< High; _ -> abs_expr_error(invalid_range, LowExpr, HighExpr) end; is_instance(X, Mod, {type,_,record,[{atom,_,Name} = NameForm | RawSubsts]}, Stack) -> Substs = [{N,T} || {type,_,field_type,[{atom,_,N},T]} <- RawSubsts], SubstsDict = dict:from_list(Substs), case get_type_repr(Mod, {record,Name,0}, false) of {ok,{abs_record,OrigFields}} -> Fields = [case dict:find(FieldName, SubstsDict) of {ok,NewFieldType} -> NewFieldType; error -> OrigFieldType end || {FieldName,OrigFieldType} <- OrigFields], is_instance(X, Mod, {type,0,tuple,[NameForm|Fields]}, Stack); {error,Reason} -> throw({'$typeserver',Reason}) end; is_instance(X, _Mod, {type,_,reference,[]}, _Stack) -> is_reference(X); is_instance(X, _Mod, {type,_,tuple,any}, _Stack) -> is_tuple(X); is_instance(X, Mod, {type,_,tuple,Fields}, _Stack) -> is_tuple(X) andalso tuple_test(tuple_to_list(X), Mod, Fields); is_instance(X, Mod, {type,_,union,Choices}, Stack) -> IsInstance = fun(Choice) -> is_instance(X,Mod,Choice,Stack) end, lists:any(IsInstance, Choices); is_instance(X, Mod, {type,_,Name,[]}, Stack) -> case orddict:find(Name, ?EQUIV_TYPES) of {ok,EquivType} -> is_instance(X, Mod, EquivType, Stack); error -> is_maybe_hard_adt(X, Mod, Name, [], Stack) end; is_instance(X, Mod, {type,_,Name,ArgForms}, Stack) -> is_maybe_hard_adt(X, Mod, Name, ArgForms, Stack); is_instance(_X, _Mod, _Type, _Stack) -> false. -spec is_int_const(term(), abs_expr()) -> boolean(). is_int_const(X, Expr) -> case eval_int(Expr) of {ok,Int} -> X =:= Int; error -> abs_expr_error(invalid_int_const, Expr) end. %% TODO: We implicitly add the '| []' at the termination of maybe_improper_list. %% TODO: We ignore a '[]' termination in improper_list. -spec list_test(term(), mod_name(), abs_type(), 'dummy' | abs_type(), boolean(), boolean(), boolean()) -> boolean(). list_test(X, Mod, Content, Termination, CanEmpty, CanProper, CanImproper) -> is_list(X) andalso list_rec(X, Mod, Content, Termination, CanEmpty, CanProper, CanImproper). -spec list_rec(term(), mod_name(), abs_type(), 'dummy' | abs_type(), boolean(), boolean(), boolean()) -> boolean(). list_rec([], _Mod, _Content, _Termination, CanEmpty, CanProper, _CanImproper) -> CanEmpty andalso CanProper; list_rec([X | Rest], Mod, Content, Termination, _CanEmpty, CanProper, CanImproper) -> is_instance(X, Mod, Content, []) andalso list_rec(Rest, Mod, Content, Termination, true, CanProper, CanImproper); list_rec(X, Mod, _Content, Termination, _CanEmpty, _CanProper, CanImproper) -> CanImproper andalso is_instance(X, Mod, Termination, []). -spec tuple_test([term()], mod_name(), [abs_type()]) -> boolean(). tuple_test([], _Mod, []) -> true; tuple_test([X | XTail], Mod, [T | TTail]) -> is_instance(X, Mod, T, []) andalso tuple_test(XTail, Mod, TTail); tuple_test(_, _Mod, _) -> false. -spec is_maybe_hard_adt(term(), mod_name(), type_name(), [abs_type()], imm_stack()) -> boolean(). is_maybe_hard_adt(X, Mod, Name, ArgForms, Stack) -> case orddict:find({Name,length(ArgForms)}, ?HARD_ADTS) of {ok,ADTMod} -> is_custom_instance(X, Mod, ADTMod, Name, ArgForms, true, Stack); error -> is_custom_instance(X, Mod, Mod, Name, ArgForms, false, Stack) end. -spec is_custom_instance(term(), mod_name(), mod_name(), type_name(), [abs_type()], boolean(), imm_stack()) -> boolean(). is_custom_instance(X, Mod, RemMod, Name, RawArgForms, IsRemote, Stack) -> ArgForms = case Mod =/= RemMod of true -> [{from_mod,Mod,A} || A <- RawArgForms]; false -> RawArgForms end, Arity = length(ArgForms), FullTypeRef = {RemMod,Name,Arity}, case lists:member(FullTypeRef, Stack) of true -> throw({'$typeserver',{self_reference,FullTypeRef}}); false -> TypeRef = {type,Name,Arity}, AbsType = get_abs_type(RemMod, TypeRef, ArgForms, IsRemote), is_instance(X, RemMod, AbsType, [FullTypeRef|Stack]) end. -spec get_abs_type(mod_name(), type_ref(), [abs_type()], boolean()) -> abs_type(). get_abs_type(RemMod, TypeRef, ArgForms, IsRemote) -> case get_type_repr(RemMod, TypeRef, IsRemote) of {ok,TypeRepr} -> {FinalAbsType,SymbInfo,VarNames} = case TypeRepr of {cached,_FinType,FAT,SI} -> {FAT,SI,[]}; {abs_type,FAT,VN,SI} -> {FAT,SI,VN} end, AbsType = case SymbInfo of not_symb -> FinalAbsType; {orig_abs,OrigAbsType} -> OrigAbsType end, VarSubstsDict = dict:from_list(lists:zip(VarNames,ArgForms)), update_vars(AbsType, VarSubstsDict, false); {error,Reason} -> throw({'$typeserver',Reason}) end. -spec abs_expr_error(atom(), abs_expr()) -> no_return(). abs_expr_error(ImmReason, Expr) -> {error,Reason} = expr_error(ImmReason, Expr), throw({'$typeserver',Reason}). -spec abs_expr_error(atom(), abs_expr(), abs_expr()) -> no_return(). abs_expr_error(ImmReason, Expr1, Expr2) -> {error,Reason} = expr_error(ImmReason, Expr1, Expr2), throw({'$typeserver',Reason}). %%------------------------------------------------------------------------------ %% Type translation functions %%------------------------------------------------------------------------------ -spec convert(mod_name(), abs_type(), state()) -> rich_result2(fin_type(),state()). convert(Mod, TypeForm, State) -> case convert(Mod, TypeForm, State, [], dict:new()) of {ok,{simple,Type},NewState} -> {ok, Type, NewState}; {ok,{rec,_RecFun,_RecArgs},_NewState} -> {error, {internal,rec_returned_to_toplevel}}; {error,_Reason} = Error -> Error end. -spec convert(mod_name(), abs_type(), state(), stack(), var_dict()) -> rich_result2(ret_type(),state()). convert(Mod, {paren_type,_,[Type]}, State, Stack, VarDict) -> convert(Mod, Type, State, Stack, VarDict); convert(Mod, {ann_type,_,[_Var,Type]}, State, Stack, VarDict) -> convert(Mod, Type, State, Stack, VarDict); convert(_Mod, {var,_,'_'}, State, _Stack, _VarDict) -> {ok, {simple,proper_types:any()}, State}; convert(_Mod, {var,_,VarName}, State, _Stack, VarDict) -> case dict:find(VarName, VarDict) of %% TODO: do we need to check if we are at toplevel of a recursive? {ok,RetType} -> {ok, RetType, State}; error -> {error, {unbound_var,VarName}} end; convert(Mod, {remote_type,_,[{atom,_,RemMod},{atom,_,Name},ArgForms]}, State, Stack, VarDict) -> case prepare_for_remote(RemMod, Name, length(ArgForms), State) of {ok,NewState} -> convert_custom(Mod,RemMod,Name,ArgForms,NewState,Stack,VarDict); {error,_Reason} = Error -> Error end; convert(_Mod, {atom,_,Atom}, State, _Stack, _VarDict) -> {ok, {simple,proper_types:exactly(Atom)}, State}; convert(_Mod, {integer,_,_Int} = IntExpr, State, _Stack, _VarDict) -> convert_integer(IntExpr, State); convert(_Mod, {op,_,_Op,_Arg} = OpExpr, State, _Stack, _VarDict) -> convert_integer(OpExpr, State); convert(_Mod, {op,_,_Op,_Arg1,_Arg2} = OpExpr, State, _Stack, _VarDict) -> convert_integer(OpExpr, State); convert(_Mod, {type,_,binary,[BaseExpr,UnitExpr]}, State, _Stack, _VarDict) -> %% <<_:X,_:_*Y>> means "bitstrings of X + k*Y bits, k >= 0" case eval_int(BaseExpr) of {ok,0} -> case eval_int(UnitExpr) of {ok,0} -> {ok, {simple,proper_types:exactly(<<>>)}, State}; {ok,1} -> {ok, {simple,proper_types:bitstring()}, State}; {ok,8} -> {ok, {simple,proper_types:binary()}, State}; {ok,N} when N > 0 -> Gen = ?LET(L, proper_types:list(proper_types:bitstring(N)), concat_bitstrings(L)), {ok, {simple,Gen}, State}; _ -> expr_error(invalid_unit, UnitExpr) end; {ok,Base} when Base > 0 -> Head = proper_types:bitstring(Base), case eval_int(UnitExpr) of {ok,0} -> {ok, {simple,Head}, State}; {ok,1} -> Tail = proper_types:bitstring(), {ok, {simple,concat_binary_gens(Head, Tail)}, State}; {ok,8} -> Tail = proper_types:binary(), {ok, {simple,concat_binary_gens(Head, Tail)}, State}; {ok,N} when N > 0 -> Tail = ?LET(L, proper_types:list(proper_types:bitstring(N)), concat_bitstrings(L)), {ok, {simple,concat_binary_gens(Head, Tail)}, State}; _ -> expr_error(invalid_unit, UnitExpr) end; _ -> expr_error(invalid_base, BaseExpr) end; convert(_Mod, {type,_,range,[LowExpr,HighExpr]}, State, _Stack, _VarDict) -> case {eval_int(LowExpr),eval_int(HighExpr)} of {{ok,Low},{ok,High}} when Low =< High -> {ok, {simple,proper_types:integer(Low,High)}, State}; _ -> expr_error(invalid_range, LowExpr, HighExpr) end; convert(_Mod, {type,_,nil,[]}, State, _Stack, _VarDict) -> {ok, {simple,proper_types:exactly([])}, State}; convert(Mod, {type,_,list,[ElemForm]}, State, Stack, VarDict) -> convert_list(Mod, false, ElemForm, State, Stack, VarDict); convert(Mod, {type,_,nonempty_list,[ElemForm]}, State, Stack, VarDict) -> convert_list(Mod, true, ElemForm, State, Stack, VarDict); convert(_Mod, {type,_,nonempty_list,[]}, State, _Stack, _VarDict) -> {ok, {simple,proper_types:non_empty(proper_types:list())}, State}; convert(_Mod, {type,_,nonempty_string,[]}, State, _Stack, _VarDict) -> {ok, {simple,proper_types:non_empty(proper_types:string())}, State}; convert(_Mod, {type,_,tuple,any}, State, _Stack, _VarDict) -> {ok, {simple,proper_types:tuple()}, State}; convert(Mod, {type,_,tuple,ElemForms}, State, Stack, VarDict) -> convert_tuple(Mod, ElemForms, false, State, Stack, VarDict); convert(Mod, {type,_,'$fixed_list',ElemForms}, State, Stack, VarDict) -> convert_tuple(Mod, ElemForms, true, State, Stack, VarDict); convert(Mod, {type,_,record,[{atom,_,Name}|FieldForms]}, State, Stack, VarDict) -> convert_record(Mod, Name, FieldForms, State, Stack, VarDict); convert(Mod, {type,_,union,ChoiceForms}, State, Stack, VarDict) -> convert_union(Mod, ChoiceForms, State, Stack, VarDict); convert(Mod, {type,_,'fun',[{type,_,product,Domain},Range]}, State, Stack, VarDict) -> convert_fun(Mod, length(Domain), Range, State, Stack, VarDict); %% TODO: These types should be replaced with accurate types. %% TODO: Add support for nonempty_improper_list/2. convert(Mod, {type,_,maybe_improper_list,[]}, State, Stack, VarDict) -> convert(Mod, {type,0,list,[]}, State, Stack, VarDict); convert(Mod, {type,_,maybe_improper_list,[Cont,_Ter]}, State, Stack, VarDict) -> convert(Mod, {type,0,list,[Cont]}, State, Stack, VarDict); convert(Mod, {type,_,nonempty_maybe_improper_list,[]}, State, Stack, VarDict) -> convert(Mod, {type,0,nonempty_list,[]}, State, Stack, VarDict); convert(Mod, {type,_,nonempty_maybe_improper_list,[Cont,_Term]}, State, Stack, VarDict) -> convert(Mod, {type,0,nonempty_list,[Cont]}, State, Stack, VarDict); convert(Mod, {type,_,iodata,[]}, State, Stack, VarDict) -> RealType = {type,0,union,[{type,0,binary,[]},{type,0,iolist,[]}]}, convert(Mod, RealType, State, Stack, VarDict); convert(Mod, {type,_,Name,[]}, State, Stack, VarDict) -> case ordsets:is_element(Name, ?STD_TYPES_0) of true -> {ok, {simple,proper_types:Name()}, State}; false -> convert_maybe_hard_adt(Mod, Name, [], State, Stack, VarDict) end; convert(Mod, {type,_,Name,ArgForms}, State, Stack, VarDict) -> convert_maybe_hard_adt(Mod, Name, ArgForms, State, Stack, VarDict); convert(_Mod, TypeForm, _State, _Stack, _VarDict) -> {error, {unsupported_type,TypeForm}}. -spec concat_bitstrings([bitstring()]) -> bitstring(). concat_bitstrings(BitStrings) -> concat_bitstrings_tr(BitStrings, <<>>). -spec concat_bitstrings_tr([bitstring()], bitstring()) -> bitstring(). concat_bitstrings_tr([], Acc) -> Acc; concat_bitstrings_tr([BitString | Rest], Acc) -> concat_bitstrings_tr(Rest, <>). -spec concat_binary_gens(fin_type(), fin_type()) -> fin_type(). concat_binary_gens(HeadType, TailType) -> ?LET({H,T}, {HeadType,TailType}, <>). -spec convert_fun(mod_name(), arity(), abs_type(), state(), stack(), var_dict()) -> rich_result2(ret_type(),state()). convert_fun(Mod, Arity, Range, State, Stack, VarDict) -> case convert(Mod, Range, State, ['fun' | Stack], VarDict) of {ok,{simple,RangeType},NewState} -> {ok, {simple,proper_types:function(Arity,RangeType)}, NewState}; {ok,{rec,RecFun,RecArgs},NewState} -> case at_toplevel(RecArgs, Stack) of true -> base_case_error(Stack); false -> convert_rec_fun(Arity, RecFun, RecArgs, NewState) end; {error,_Reason} = Error -> Error end. -spec convert_rec_fun(arity(), rec_fun(), rec_args(), state()) -> {'ok',ret_type(),state()}. convert_rec_fun(Arity, RecFun, RecArgs, State) -> %% We bind the generated value by size. NewRecFun = fun(GenFuns,Size) -> proper_types:function(Arity, RecFun(GenFuns,Size)) end, NewRecArgs = clean_rec_args(RecArgs), {ok, {rec,NewRecFun,NewRecArgs}, State}. -spec convert_list(mod_name(), boolean(), abs_type(), state(), stack(), var_dict()) -> rich_result2(ret_type(),state()). convert_list(Mod, NonEmpty, ElemForm, State, Stack, VarDict) -> case convert(Mod, ElemForm, State, [list | Stack], VarDict) of {ok,{simple,ElemType},NewState} -> InnerType = proper_types:list(ElemType), FinType = case NonEmpty of true -> proper_types:non_empty(InnerType); false -> InnerType end, {ok, {simple,FinType}, NewState}; {ok,{rec,RecFun,RecArgs},NewState} -> case {at_toplevel(RecArgs,Stack), NonEmpty} of {true,true} -> base_case_error(Stack); {true,false} -> NewRecFun = fun(GenFuns,Size) -> ElemGen = fun(S) -> ?LAZY(RecFun(GenFuns,S)) end, proper_types:distlist(Size, ElemGen, false) end, NewRecArgs = clean_rec_args(RecArgs), {ok, {rec,NewRecFun,NewRecArgs}, NewState}; {false,_} -> {NewRecFun,NewRecArgs} = convert_rec_list(RecFun, RecArgs, NonEmpty), {ok, {rec,NewRecFun,NewRecArgs}, NewState} end; {error,_Reason} = Error -> Error end. -spec convert_rec_list(rec_fun(), rec_args(), boolean()) -> {rec_fun(),rec_args()}. convert_rec_list(RecFun, [{true,FullTypeRef}] = RecArgs, NonEmpty) -> {NewRecFun,_NormalRecArgs} = convert_normal_rec_list(RecFun, RecArgs, NonEmpty), AltRecFun = fun([InstListGen],Size) -> InstTypesList = proper_types:get_prop(internal_types, InstListGen(Size)), proper_types:fixed_list([RecFun([fun(_Size) -> I end],0) || I <- InstTypesList]) end, NewRecArgs = [{{list,NonEmpty,AltRecFun},FullTypeRef}], {NewRecFun, NewRecArgs}; convert_rec_list(RecFun, RecArgs, NonEmpty) -> convert_normal_rec_list(RecFun, RecArgs, NonEmpty). -spec convert_normal_rec_list(rec_fun(), rec_args(), boolean()) -> {rec_fun(),rec_args()}. convert_normal_rec_list(RecFun, RecArgs, NonEmpty) -> NewRecFun = fun(GenFuns,Size) -> ElemGen = fun(S) -> RecFun(GenFuns, S) end, proper_types:distlist(Size, ElemGen, NonEmpty) end, NewRecArgs = clean_rec_args(RecArgs), {NewRecFun, NewRecArgs}. -spec convert_tuple(mod_name(), [abs_type()], boolean(), state(), stack(), var_dict()) -> rich_result2(ret_type(),state()). convert_tuple(Mod, ElemForms, ToList, State, Stack, VarDict) -> case process_list(Mod, ElemForms, State, [tuple | Stack], VarDict) of {ok,RetTypes,NewState} -> case combine_ret_types(RetTypes, {tuple,ToList}) of {simple,_FinType} = RetType -> {ok, RetType, NewState}; {rec,_RecFun,RecArgs} = RetType -> case at_toplevel(RecArgs, Stack) of true -> base_case_error(Stack); false -> {ok, RetType, NewState} end end; {error,_Reason} = Error -> Error end. -spec convert_union(mod_name(), [abs_type()], state(), stack(), var_dict()) -> rich_result2(ret_type(),state()). convert_union(Mod, ChoiceForms, State, Stack, VarDict) -> case process_list(Mod, ChoiceForms, State, [union | Stack], VarDict) of {ok,RawChoices,NewState} -> ProcessChoice = fun(T,A) -> process_choice(T,A,Stack) end, {RevSelfRecs,RevNonSelfRecs,RevNonRecs} = lists:foldl(ProcessChoice, {[],[],[]}, RawChoices), case {lists:reverse(RevSelfRecs),lists:reverse(RevNonSelfRecs), lists:reverse(RevNonRecs)} of {_SelfRecs,[],[]} -> base_case_error(Stack); {[],NonSelfRecs,NonRecs} -> {ok, combine_ret_types(NonRecs ++ NonSelfRecs, union), NewState}; {SelfRecs,NonSelfRecs,NonRecs} -> {BCaseRecFun,BCaseRecArgs} = case combine_ret_types(NonRecs ++ NonSelfRecs, union) of {simple,BCaseType} -> {fun([],_Size) -> BCaseType end,[]}; {rec,BCRecFun,BCRecArgs} -> {BCRecFun,BCRecArgs} end, NumBCaseGens = length(BCaseRecArgs), [ParentRef | _Upper] = Stack, FallbackRecFun = fun([SelfGen],_Size) -> SelfGen(0) end, FallbackRecArgs = [{false,ParentRef}], FallbackRetType = {rec,FallbackRecFun,FallbackRecArgs}, {rec,RCaseRecFun,RCaseRecArgs} = combine_ret_types([FallbackRetType] ++ SelfRecs ++ NonSelfRecs, wunion), NewRecFun = fun(AllGens,Size) -> {BCaseGens,RCaseGens} = lists:split(NumBCaseGens, AllGens), case Size of 0 -> BCaseRecFun(BCaseGens,0); _ -> RCaseRecFun(RCaseGens,Size) end end, NewRecArgs = BCaseRecArgs ++ RCaseRecArgs, {ok, {rec,NewRecFun,NewRecArgs}, NewState} end; {error,_Reason} = Error -> Error end. -spec process_choice(ret_type(), {[ret_type()],[ret_type()],[ret_type()]}, stack()) -> {[ret_type()],[ret_type()],[ret_type()]}. process_choice({simple,_} = RetType, {SelfRecs,NonSelfRecs,NonRecs}, _Stack) -> {SelfRecs, NonSelfRecs, [RetType | NonRecs]}; process_choice({rec,RecFun,RecArgs}, {SelfRecs,NonSelfRecs,NonRecs}, Stack) -> case at_toplevel(RecArgs, Stack) of true -> case partition_by_toplevel(RecArgs, Stack, true) of {[],[],_,_} -> NewRecArgs = clean_rec_args(RecArgs), {[{rec,RecFun,NewRecArgs} | SelfRecs], NonSelfRecs, NonRecs}; {SelfRecArgs,SelfPos,OtherRecArgs,_OtherPos} -> NumInstances = length(SelfRecArgs), IsListInst = fun({true,_FTRef}) -> false ; ({{list,_NE,_AltRecFun},_FTRef}) -> true end, NewRecFun = case proper_arith:filter(IsListInst,SelfRecArgs) of {[],[]} -> no_list_inst_rec_fun(RecFun,NumInstances, SelfPos); {[{{list,NonEmpty,AltRecFun},_}],[ListInstPos]} -> list_inst_rec_fun(AltRecFun,NumInstances, SelfPos,NonEmpty,ListInstPos) end, [{_B,SelfRef} | _] = SelfRecArgs, NewRecArgs = [{false,SelfRef} | clean_rec_args(OtherRecArgs)], {[{rec,NewRecFun,NewRecArgs} | SelfRecs], NonSelfRecs, NonRecs} end; false -> NewRecArgs = clean_rec_args(RecArgs), {SelfRecs, [{rec,RecFun,NewRecArgs} | NonSelfRecs], NonRecs} end. -spec no_list_inst_rec_fun(rec_fun(), pos_integer(), [position()]) -> rec_fun(). no_list_inst_rec_fun(RecFun, NumInstances, SelfPos) -> fun([SelfGen|OtherGens], Size) -> ?LETSHRINK( Instances, %% Size distribution will be a little off if both normal and %% instance-accepting generators are present. lists:duplicate(NumInstances, SelfGen(Size div NumInstances)), begin InstGens = [fun(_Size) -> proper_types:exactly(I) end || I <- Instances], AllGens = proper_arith:insert(InstGens, SelfPos, OtherGens), RecFun(AllGens, Size) end) end. -spec list_inst_rec_fun(rec_fun(), pos_integer(), [position()], boolean(), position()) -> rec_fun(). list_inst_rec_fun(AltRecFun, NumInstances, SelfPos, NonEmpty, ListInstPos) -> fun([SelfGen|OtherGens], Size) -> ?LETSHRINK( AllInsts, lists:duplicate(NumInstances - 1, SelfGen(Size div NumInstances)) ++ proper_types:distlist(Size div NumInstances, SelfGen, NonEmpty), begin {Instances,InstList} = lists:split(NumInstances - 1, AllInsts), InstGens = [fun(_Size) -> proper_types:exactly(I) end || I <- Instances], InstTypesList = [proper_types:exactly(I) || I <- InstList], InstListGen = fun(_Size) -> proper_types:fixed_list(InstTypesList) end, AllInstGens = proper_arith:list_insert(ListInstPos, InstListGen, InstGens), AllGens = proper_arith:insert(AllInstGens, SelfPos, OtherGens), AltRecFun(AllGens, Size) end) end. -spec convert_maybe_hard_adt(mod_name(), type_name(), [abs_type()], state(), stack(), var_dict()) -> rich_result2(ret_type(),state()). convert_maybe_hard_adt(Mod, Name, ArgForms, State, Stack, VarDict) -> Arity = length(ArgForms), case orddict:find({Name,Arity}, ?HARD_ADTS) of {ok,Mod} -> convert_custom(Mod, Mod, Name, ArgForms, State, Stack, VarDict); {ok,ADTMod} -> ADT = {remote_type,0,[{atom,0,ADTMod},{atom,0,Name},ArgForms]}, convert(Mod, ADT, State, Stack, VarDict); error -> convert_custom(Mod, Mod, Name, ArgForms, State, Stack, VarDict) end. -spec convert_custom(mod_name(), mod_name(), type_name(), [abs_type()], state(), stack(), var_dict()) -> rich_result2(ret_type(),state()). convert_custom(Mod, RemMod, Name, ArgForms, State, Stack, VarDict) -> case process_list(Mod, ArgForms, State, Stack, VarDict) of {ok,Args,NewState} -> Arity = length(Args), TypeRef = {type,Name,Arity}, FullTypeRef = {RemMod,type,Name,Args}, convert_type(TypeRef, FullTypeRef, NewState, Stack); {error,_Reason} = Error -> Error end. -spec convert_record(mod_name(), type_name(), [abs_type()], state(), stack(), var_dict()) -> rich_result2(ret_type(),state()). convert_record(Mod, Name, RawSubsts, State, Stack, VarDict) -> Substs = [{N,T} || {type,_,field_type,[{atom,_,N},T]} <- RawSubsts], {SubstFields,SubstTypeForms} = lists:unzip(Substs), case process_list(Mod, SubstTypeForms, State, Stack, VarDict) of {ok,SubstTypes,NewState} -> SubstsDict = dict:from_list(lists:zip(SubstFields, SubstTypes)), TypeRef = {record,Name,0}, FullTypeRef = {Mod,record,Name,SubstsDict}, convert_type(TypeRef, FullTypeRef, NewState, Stack); {error,_Reason} = Error -> Error end. -spec convert_type(type_ref(), full_type_ref(), state(), stack()) -> rich_result2(ret_type(),state()). convert_type(TypeRef, {Mod,_Kind,_Name,_Spec} = FullTypeRef, State, Stack) -> case stack_position(FullTypeRef, Stack) of none -> case get_type_repr(Mod, TypeRef, false, State) of {ok,TypeRepr,NewState} -> convert_new_type(TypeRef, FullTypeRef, TypeRepr, NewState, Stack); {error,_Reason} = Error -> Error end; 1 -> base_case_error(Stack); _Pos -> {ok, {rec,fun([Gen],Size) -> Gen(Size) end,[{true,FullTypeRef}]}, State} end. -spec convert_new_type(type_ref(), full_type_ref(), type_repr(), state(), stack()) -> rich_result2(ret_type(),state()). convert_new_type(_TypeRef, {_Mod,type,_Name,[]}, {cached,FinType,_TypeForm,_SymbInfo}, State, _Stack) -> {ok, {simple,FinType}, State}; convert_new_type(TypeRef, {Mod,type,_Name,Args} = FullTypeRef, {abs_type,TypeForm,Vars,SymbInfo}, State, Stack) -> VarDict = dict:from_list(lists:zip(Vars, Args)), case convert(Mod, TypeForm, State, [FullTypeRef | Stack], VarDict) of {ok, {simple,ImmFinType}, NewState} -> FinType = case SymbInfo of not_symb -> ImmFinType; {orig_abs,_OrigAbsType} -> proper_symb:internal_well_defined(ImmFinType) end, FinalState = case Vars of [] -> cache_type(Mod, TypeRef, FinType, TypeForm, SymbInfo, NewState); _ -> NewState end, {ok, {simple,FinType}, FinalState}; {ok, {rec,RecFun,RecArgs}, NewState} -> convert_maybe_rec(FullTypeRef, SymbInfo, RecFun, RecArgs, NewState, Stack); {error,_Reason} = Error -> Error end; convert_new_type(_TypeRef, {Mod,record,Name,SubstsDict} = FullTypeRef, {abs_record,OrigFields}, State, Stack) -> Fields = [case dict:find(FieldName, SubstsDict) of {ok,NewFieldType} -> NewFieldType; error -> OrigFieldType end || {FieldName,OrigFieldType} <- OrigFields], case convert_tuple(Mod, [{atom,0,Name} | Fields], false, State, [FullTypeRef | Stack], dict:new()) of {ok, {simple,_FinType}, _NewState} = Result -> Result; {ok, {rec,RecFun,RecArgs}, NewState} -> convert_maybe_rec(FullTypeRef, not_symb, RecFun, RecArgs, NewState, Stack); {error,_Reason} = Error -> Error end. -spec cache_type(mod_name(), type_ref(), fin_type(), abs_type(), symb_info(), state()) -> state(). cache_type(Mod, TypeRef, FinType, TypeForm, SymbInfo, #state{types = Types} = State) -> TypeRepr = {cached,FinType,TypeForm,SymbInfo}, ModTypes = dict:fetch(Mod, Types), NewModTypes = dict:store(TypeRef, TypeRepr, ModTypes), NewTypes = dict:store(Mod, NewModTypes, Types), State#state{types = NewTypes}. -spec convert_maybe_rec(full_type_ref(), symb_info(), rec_fun(), rec_args(), state(), stack()) -> rich_result2(ret_type(),state()). convert_maybe_rec(FullTypeRef, SymbInfo, RecFun, RecArgs, State, Stack) -> case at_toplevel(RecArgs, Stack) of true -> base_case_error(Stack); false -> safe_convert_maybe_rec(FullTypeRef, SymbInfo, RecFun, RecArgs, State) end. -spec safe_convert_maybe_rec(full_type_ref(),symb_info(),rec_fun(),rec_args(), state()) -> rich_result2(ret_type(),state()). safe_convert_maybe_rec(FullTypeRef, SymbInfo, RecFun, RecArgs, State) -> case partition_rec_args(FullTypeRef, RecArgs, false) of {[],[],_,_} -> {ok, {rec,RecFun,RecArgs}, State}; {MyRecArgs,MyPos,OtherRecArgs,_OtherPos} -> case lists:all(fun({B,_T}) -> B =:= false end, MyRecArgs) of true -> convert_rec_type(SymbInfo, RecFun, MyPos, OtherRecArgs, State); false -> {error, {internal,true_rec_arg_reached_type}} end end. -spec convert_rec_type(symb_info(), rec_fun(), [position()], rec_args(), state()) -> {ok, ret_type(), state()}. convert_rec_type(SymbInfo, RecFun, MyPos, [], State) -> NumRecArgs = length(MyPos), M = fun(GenFun) -> fun(Size) -> GenFuns = lists:duplicate(NumRecArgs, GenFun), RecFun(GenFuns, erlang:max(0,Size - 1)) end end, SizedGen = y(M), ImmFinType = ?SIZED(Size,SizedGen(Size + 1)), FinType = case SymbInfo of not_symb -> ImmFinType; {orig_abs,_OrigAbsType} -> proper_symb:internal_well_defined(ImmFinType) end, {ok, {simple,FinType}, State}; convert_rec_type(_SymbInfo, RecFun, MyPos, OtherRecArgs, State) -> NumRecArgs = length(MyPos), NewRecFun = fun(OtherGens,TopSize) -> M = fun(GenFun) -> fun(Size) -> GenFuns = lists:duplicate(NumRecArgs, GenFun), AllGens = proper_arith:insert(GenFuns, MyPos, OtherGens), RecFun(AllGens, erlang:max(0,Size - 1)) end end, (y(M))(TopSize) end, NewRecArgs = clean_rec_args(OtherRecArgs), {ok, {rec,NewRecFun,NewRecArgs}, State}. %% Y Combinator: Read more at http://bc.tech.coop/blog/070611.html. -spec y(fun((fun((T) -> S)) -> fun((T) -> S))) -> fun((T) -> S). y(M) -> G = fun(F) -> M(fun(A) -> (F(F))(A) end) end, G(G). -spec process_list(mod_name(), [abs_type() | ret_type()], state(), stack(), var_dict()) -> rich_result2([ret_type()],state()). process_list(Mod, RawTypes, State, Stack, VarDict) -> Process = fun({simple,_FinType} = Type, {ok,Types,State1}) -> {ok, [Type|Types], State1}; ({rec,_RecFun,_RecArgs} = Type, {ok,Types,State1}) -> {ok, [Type|Types], State1}; (TypeForm, {ok,Types,State1}) -> case convert(Mod, TypeForm, State1, Stack, VarDict) of {ok,Type,State2} -> {ok,[Type|Types],State2}; {error,_} = Err -> Err end; (_RawType, {error,_} = Err) -> Err end, case lists:foldl(Process, {ok,[],State}, RawTypes) of {ok,RevTypes,NewState} -> {ok, lists:reverse(RevTypes), NewState}; {error,_Reason} = Error -> Error end. -spec convert_integer(abs_expr(), state()) -> rich_result2(ret_type(),state()). convert_integer(Expr, State) -> case eval_int(Expr) of {ok,Int} -> {ok, {simple,proper_types:exactly(Int)}, State}; error -> expr_error(invalid_int_const, Expr) end. -spec eval_int(abs_expr()) -> tagged_result(integer()). eval_int(Expr) -> NoBindings = erl_eval:new_bindings(), try erl_eval:expr(Expr, NoBindings) of {value,Value,_NewBindings} when is_integer(Value) -> {ok, Value}; _ -> error catch error:_ -> error end. -spec expr_error(atom(), abs_expr()) -> {'error',term()}. expr_error(Reason, Expr) -> {error, {Reason,lists:flatten(erl_pp:expr(Expr))}}. -spec expr_error(atom(), abs_expr(), abs_expr()) -> {'error',term()}. expr_error(Reason, Expr1, Expr2) -> Str1 = lists:flatten(erl_pp:expr(Expr1)), Str2 = lists:flatten(erl_pp:expr(Expr2)), {error, {Reason,Str1,Str2}}. -spec base_case_error(stack()) -> {'error',term()}. %% TODO: This might confuse, since it doesn't record the arguments to parametric %% types or the type subsitutions of a record. base_case_error([{Mod,type,Name,Args} | _Upper]) -> Arity = length(Args), {error, {no_base_case,{Mod,type,Name,Arity}}}; base_case_error([{Mod,record,Name,_SubstsDict} | _Upper]) -> {error, {no_base_case,{Mod,record,Name}}}. %%------------------------------------------------------------------------------ %% Helper datatypes handling functions %%------------------------------------------------------------------------------ -spec stack_position(full_type_ref(), stack()) -> 'none' | pos_integer(). stack_position(FullTypeRef, Stack) -> SameType = fun(A) -> same_full_type_ref(A,FullTypeRef) end, case proper_arith:find_first(SameType, Stack) of {Pos,_} -> Pos; none -> none end. -spec partition_by_toplevel(rec_args(), stack(), boolean()) -> {rec_args(),[position()],rec_args(),[position()]}. partition_by_toplevel(RecArgs, [], _OnlyInstanceAccepting) -> {[],[],RecArgs,lists:seq(1,length(RecArgs))}; partition_by_toplevel(RecArgs, [_Parent | _Upper], _OnlyInstanceAccepting) when is_atom(_Parent) -> {[],[],RecArgs,lists:seq(1,length(RecArgs))}; partition_by_toplevel(RecArgs, [Parent | _Upper], OnlyInstanceAccepting) -> partition_rec_args(Parent, RecArgs, OnlyInstanceAccepting). -spec at_toplevel(rec_args(), stack()) -> boolean(). at_toplevel(RecArgs, Stack) -> case partition_by_toplevel(RecArgs, Stack, false) of {[],[],_,_} -> false; _ -> true end. -spec partition_rec_args(full_type_ref(), rec_args(), boolean()) -> {rec_args(),[position()],rec_args(),[position()]}. partition_rec_args(FullTypeRef, RecArgs, OnlyInstanceAccepting) -> SameType = case OnlyInstanceAccepting of true -> fun({false,_T}) -> false ; ({_B,T}) -> same_full_type_ref(T,FullTypeRef) end; false -> fun({_B,T}) -> same_full_type_ref(T,FullTypeRef) end end, proper_arith:partition(SameType, RecArgs). %% Tuples can be of 0 arity, unions of 1 and wunions at least of 2. -spec combine_ret_types([ret_type()], {'tuple',boolean()} | 'union' | 'wunion') -> ret_type(). combine_ret_types(RetTypes, EnclosingType) -> case lists:all(fun is_simple_ret_type/1, RetTypes) of true -> %% This should never happen for wunion. Combine = case EnclosingType of {tuple,false} -> fun proper_types:tuple/1; {tuple,true} -> fun proper_types:fixed_list/1; union -> fun proper_types:union/1 end, FinTypes = [T || {simple,T} <- RetTypes], {simple, Combine(FinTypes)}; false -> NumTypes = length(RetTypes), {RevRecFuns,RevRecArgsList,NumRecs} = lists:foldl(fun add_ret_type/2, {[],[],0}, RetTypes), RecFuns = lists:reverse(RevRecFuns), RecArgsList = lists:reverse(RevRecArgsList), RecArgLens = [length(RecArgs) || RecArgs <- RecArgsList], RecFunInfo = {NumTypes,NumRecs,RecArgLens,RecFuns}, FlatRecArgs = lists:flatten(RecArgsList), {NewRecFun,NewRecArgs} = case EnclosingType of {tuple,ToList} -> {tuple_rec_fun(RecFunInfo,ToList), soft_clean_rec_args(FlatRecArgs,RecFunInfo,ToList)}; union -> {union_rec_fun(RecFunInfo),clean_rec_args(FlatRecArgs)}; wunion -> {wunion_rec_fun(RecFunInfo), clean_rec_args(FlatRecArgs)} end, {rec, NewRecFun, NewRecArgs} end. -spec tuple_rec_fun(rec_fun_info(), boolean()) -> rec_fun(). tuple_rec_fun({_NumTypes,NumRecs,RecArgLens,RecFuns}, ToList) -> Combine = case ToList of true -> fun proper_types:fixed_list/1; false -> fun proper_types:tuple/1 end, fun(AllGFs,TopSize) -> Size = TopSize div NumRecs, GFsList = proper_arith:unflatten(AllGFs, RecArgLens), ArgsList = [[GenFuns,Size] || GenFuns <- GFsList], ZipFun = fun erlang:apply/2, Combine(lists:zipwith(ZipFun, RecFuns, ArgsList)) end. -spec union_rec_fun(rec_fun_info()) -> rec_fun(). union_rec_fun({_NumTypes,_NumRecs,RecArgLens,RecFuns}) -> fun(AllGFs,Size) -> GFsList = proper_arith:unflatten(AllGFs, RecArgLens), ArgsList = [[GenFuns,Size] || GenFuns <- GFsList], ZipFun = fun(F,A) -> ?LAZY(apply(F,A)) end, proper_types:union(lists:zipwith(ZipFun, RecFuns, ArgsList)) end. -spec wunion_rec_fun(rec_fun_info()) -> rec_fun(). wunion_rec_fun({NumTypes,_NumRecs,RecArgLens,RecFuns}) -> fun(AllGFs,Size) -> GFsList = proper_arith:unflatten(AllGFs, RecArgLens), ArgsList = [[GenFuns,Size] || GenFuns <- GFsList], ZipFun = fun(W,F,A) -> {W,?LAZY(apply(F,A))} end, RecWeight = erlang:max(1, Size div (NumTypes - 1)), Weights = [1 | lists:duplicate(NumTypes - 1, RecWeight)], WeightedChoices = lists:zipwith3(ZipFun, Weights, RecFuns, ArgsList), proper_types:wunion(WeightedChoices) end. -spec add_ret_type(ret_type(), {[rec_fun()],[rec_args()],non_neg_integer()}) -> {[rec_fun()],[rec_args()],non_neg_integer()}. add_ret_type({simple,FinType}, {RecFuns,RecArgsList,NumRecs}) -> {[fun([],_) -> FinType end | RecFuns], [[] | RecArgsList], NumRecs}; add_ret_type({rec,RecFun,RecArgs}, {RecFuns,RecArgsList,NumRecs}) -> {[RecFun | RecFuns], [RecArgs | RecArgsList], NumRecs + 1}. -spec is_simple_ret_type(ret_type()) -> boolean(). is_simple_ret_type({simple,_FinType}) -> true; is_simple_ret_type({rec,_RecFun,_RecArgs}) -> false. -spec clean_rec_args(rec_args()) -> rec_args(). clean_rec_args(RecArgs) -> [{false,F} || {_B,F} <- RecArgs]. -spec soft_clean_rec_args(rec_args(), rec_fun_info(), boolean()) -> rec_args(). soft_clean_rec_args(RecArgs, RecFunInfo, ToList) -> soft_clean_rec_args_tr(RecArgs, [], RecFunInfo, ToList, false, 1). -spec soft_clean_rec_args_tr(rec_args(), rec_args(), rec_fun_info(), boolean(), boolean(), position()) -> rec_args(). soft_clean_rec_args_tr([], Acc, _RecFunInfo, _ToList, _FoundListInst, _Pos) -> lists:reverse(Acc); soft_clean_rec_args_tr([{{list,_NonEmpty,_AltRecFun},FTRef} | Rest], Acc, RecFunInfo, ToList, true, Pos) -> NewArg = {false,FTRef}, soft_clean_rec_args_tr(Rest, [NewArg|Acc], RecFunInfo, ToList, true, Pos+1); soft_clean_rec_args_tr([{{list,NonEmpty,AltRecFun},FTRef} | Rest], Acc, RecFunInfo, ToList, false, Pos) -> {NumTypes,NumRecs,RecArgLens,RecFuns} = RecFunInfo, AltRecFunPos = get_group(Pos, RecArgLens), AltRecFuns = proper_arith:list_update(AltRecFunPos, AltRecFun, RecFuns), AltRecFunInfo = {NumTypes,NumRecs,RecArgLens,AltRecFuns}, NewArg = {{list,NonEmpty,tuple_rec_fun(AltRecFunInfo,ToList)},FTRef}, soft_clean_rec_args_tr(Rest, [NewArg|Acc], RecFunInfo, ToList, true, Pos+1); soft_clean_rec_args_tr([Arg | Rest], Acc, RecFunInfo, ToList, FoundListInst, Pos) -> soft_clean_rec_args_tr(Rest, [Arg | Acc], RecFunInfo, ToList, FoundListInst, Pos+1). -spec get_group(pos_integer(), [non_neg_integer()]) -> pos_integer(). get_group(Pos, AllMembers) -> get_group_tr(Pos, AllMembers, 1). -spec get_group_tr(pos_integer(), [non_neg_integer()], pos_integer()) -> pos_integer(). get_group_tr(Pos, [Members | Rest], GroupNum) -> case Pos =< Members of true -> GroupNum; false -> get_group_tr(Pos - Members, Rest, GroupNum + 1) end. -spec same_full_type_ref(full_type_ref(), term()) -> boolean(). same_full_type_ref({SameMod,type,SameName,Args1}, {SameMod,type,SameName,Args2}) -> length(Args1) =:= length(Args2) andalso lists:all(fun({A,B}) -> same_ret_type(A,B) end, lists:zip(Args1, Args2)); same_full_type_ref({SameMod,record,SameName,SubstsDict1}, {SameMod,record,SameName,SubstsDict2}) -> same_substs_dict(SubstsDict1, SubstsDict2); same_full_type_ref(_, _) -> false. -spec same_ret_type(ret_type(), ret_type()) -> boolean(). same_ret_type({simple,FinType1}, {simple,FinType2}) -> same_fin_type(FinType1, FinType2); same_ret_type({rec,RecFun1,RecArgs1}, {rec,RecFun2,RecArgs2}) -> NumRecArgs = length(RecArgs1), length(RecArgs2) =:= NumRecArgs andalso lists:all(fun({A1,A2}) -> same_rec_arg(A1,A2,NumRecArgs) end, lists:zip(RecArgs1,RecArgs2)) andalso same_rec_fun(RecFun1, RecFun2, NumRecArgs); same_ret_type(_, _) -> false. %% TODO: Is this too strict? -spec same_rec_arg(rec_arg(), rec_arg(), arity()) -> boolean(). same_rec_arg({{list,SameBool,AltRecFun1},FTRef1}, {{list,SameBool,AltRecFun2},FTRef2}, NumRecArgs) -> same_rec_fun(AltRecFun1, AltRecFun2, NumRecArgs) andalso same_full_type_ref(FTRef1, FTRef2); same_rec_arg({true,FTRef1}, {true,FTRef2}, _NumRecArgs) -> same_full_type_ref(FTRef1, FTRef2); same_rec_arg({false,FTRef1}, {false,FTRef2}, _NumRecArgs) -> same_full_type_ref(FTRef1, FTRef2); same_rec_arg(_, _, _NumRecArgs) -> false. -spec same_substs_dict(substs_dict(), substs_dict()) -> boolean(). same_substs_dict(SubstsDict1, SubstsDict2) -> SameKVPair = fun({{_K,V1},{_K,V2}}) -> same_ret_type(V1,V2); (_) -> false end, SubstsKVList1 = lists:sort(dict:to_list(SubstsDict1)), SubstsKVList2 = lists:sort(dict:to_list(SubstsDict2)), length(SubstsKVList1) =:= length(SubstsKVList2) andalso lists:all(SameKVPair, lists:zip(SubstsKVList1,SubstsKVList2)). -spec same_fin_type(fin_type(), fin_type()) -> boolean(). same_fin_type(Type1, Type2) -> proper_types:equal_types(Type1, Type2). -spec same_rec_fun(rec_fun(), rec_fun(), arity()) -> boolean(). same_rec_fun(RecFun1, RecFun2, NumRecArgs) -> %% It's ok that we return a type, even if there's a 'true' for use of %% an instance. GenFun = fun(_Size) -> proper_types:exactly('$dummy') end, GenFuns = lists:duplicate(NumRecArgs,GenFun), same_fin_type(RecFun1(GenFuns,0), RecFun2(GenFuns,0)). erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_unicode.erl000066400000000000000000000064721255446327200236360ustar00rootroot00000000000000%%% Copyright 2014 Motiejus Jakstys %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2014 Motiejus Jakstys %%% @version {@version} %%% @author Motiejus Jakstys %%% @doc Unicode generators for PropEr %%% %%% This module exposes utf8 binary generator. %%% %%% Makes it easy to create custom-encoded unicode binaries. For example, %%% utf16 binary generator: %%% %%% ``` %%% utf16() -> %%% ?LET(S, utf8(), unicode:characters_to_binary(S, utf8, utf16)). %%% ''' %%% %%% Verify it has at least twice as many bytes as codepoints: %%% %%% ``` %%% ?FORALL(S, utf16(), %%% size(S) >= 2*length(unicode:characters_to_list(S, utf16))). %%% ''' %%% Only utf8 generation is supported: {@link utf8/0}, {@link utf8/1}, {@link %%% utf8/2}. Unicode codepoints and other encodings are trivial to get with %%% utf8 generators and {@link unicode} module in OTP. -module(proper_unicode). -include("proper_common.hrl"). %% @private_type %% @alias -type nonnegextint() :: non_neg_integer() | 'inf'. -import(proper_types, [integer/2, union/1, vector/2]). -export([utf8/0, utf8/1, utf8/2]). %% @doc Codepoint which is no more than N bytes in utf8 -spec unicode_codepoint(1..4) -> proper_types:type(). unicode_codepoint(1) -> integer(0, 16#7F); unicode_codepoint(2) -> integer(16#80, 16#7FF); unicode_codepoint(3) -> union([integer(16#800, 16#D7FF), integer(16#E000, 16#FFFD)]); unicode_codepoint(4) -> integer(16#10000, 16#10FFFF). %% @doc codepoint up to N bytes in utf8 -spec unicode_codepoint_upto(1..4) -> proper_types:type(). unicode_codepoint_upto(N) -> union([unicode_codepoint(X) || X <- lists:seq(1, N)]). %% @doc utf8-encoded unbounded size binary. -spec utf8() -> proper_types:type(). utf8() -> utf8(inf, 4). %% @doc utf8-encoded bounded upper size binary. -spec utf8(nonnegextint()) -> proper_types:type(). utf8(N) -> utf8(N, 4). %% @doc Bounded upper size utf8 binary, `codepoint length =< MaxCodePointSize'. %% %% Limiting codepoint size can be useful when applications do not accept full %% unicode range. For example, MySQL in utf8 encoding accepts only 3-byte %% unicode codepoints in VARCHAR fields. %% %% If unbounded length is needed, use `inf' as first argument. -spec utf8(nonnegextint(), 1..4) -> proper_types:type(). utf8(N, MaxCodePointSize) -> ?LET(Str, vector_upto(N, unicode_codepoint_upto(MaxCodePointSize)), unicode:characters_to_binary(Str) ). %% ============================================================================= %% Helpers %% ============================================================================= %% @doc List of no more than N elements vector_upto(N, What) -> ?LET(X, integer(0, N), vector(X, What)). erlang-proper-1.1+gitfa58f82bdc+dfsg/src/proper_unused_imports_remover.erl000066400000000000000000000113341255446327200270200ustar00rootroot00000000000000%%% Copyright 2015-2015 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2015-2015 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Zaiming Shi (modifications and update by Kostis Sagonas) -module(proper_unused_imports_remover). -export([parse_transform/2]). -include("proper_internal.hrl"). -ifdef(USE_ERL_SCAN_LINE). -define(LINE_MOD, erl_scan). -else. -define(LINE_MOD, erl_anno). -endif. -type key() :: {fun_name(), arity()}. -type val() :: {?LINE_MOD:line(), mod_name(), boolean()}. -ifdef(NO_MODULES_IN_OPAQUES). -type imp_dict() :: dict(). -else. -type imp_dict() :: dict:dict(key(), val()). -endif. -define(IMP_MODULES, [proper, proper_statem, proper_symb, proper_types, proper_unicode]). -spec parse_transform([abs_form()], [compile:option()]) -> [abs_form()]. parse_transform(Forms, Options) -> case lists:member(warn_unused_import, Options) of true -> parse(Forms, [], []); false -> Forms end. -spec parse([abs_form()], [abs_form()], [abs_form()]) -> [abs_form()]. parse([{attribute, _L, import, {?MODULE, []}} | Rest], Imports, Acc) -> lists:reverse(Acc) ++ use_new_imports(to_dict(Imports), Rest); parse([{attribute, _L, import, {Mod, _Funs}} = A | Rest], Imports, Acc) -> case lists:member(Mod, ?IMP_MODULES) of true -> parse(Rest, [A | Imports], Acc); false -> parse(Rest, Imports, [A | Acc]) end; parse([Form | Rest], Imports, Acc) -> parse(Rest, Imports, [Form | Acc]). -spec use_new_imports(imp_dict(), [abs_form()]) -> [abs_form()]. use_new_imports(Dict0, Forms) -> Dict = mark_used_imports(Dict0, Forms), new_import_attributes(Dict) ++ Forms. -spec mark_used_imports(imp_dict(), [abs_form()]) -> imp_dict(). mark_used_imports(Dict, Forms) -> lists:foldl(fun scan_forms/2, Dict, Forms). -spec scan_forms(abs_form(), imp_dict()) -> imp_dict(). scan_forms({function, _L, _F, _A, Clauses}, Dict) -> lists:foldl(fun brutal_scan/2, Dict, Clauses); scan_forms(_, Dict) -> Dict. -spec brutal_scan(abs_form(), imp_dict()) -> imp_dict(). brutal_scan({'fun', _L, {function, Name, Arity}}, Dict) -> maybe_update_dict({Name, Arity}, Dict); brutal_scan({call, _L1, Call, Args}, Dict0) -> case Call of {atom, _L2, Name} -> Dict = maybe_update_dict({Name, length(Args)}, Dict0), brutal_scan(Args, Dict); _ -> brutal_scan([Call | Args], Dict0) end; brutal_scan(Other, Dict) when is_list(Other) -> lists:foldl(fun brutal_scan/2, Dict, Other); brutal_scan(Other, Dict) when is_tuple(Other) -> brutal_scan(tuple_to_list(Other), Dict); brutal_scan(_Other, Dict) -> Dict. -spec maybe_update_dict(key(), imp_dict()) -> imp_dict(). maybe_update_dict(Key, Dict) -> case dict:find(Key, Dict) of {ok, {Line, Mod, false}} -> dict:store(Key, {Line, Mod, true}, Dict); _Other -> Dict end. -spec to_dict([abs_form()]) -> imp_dict(). to_dict(Imports) -> to_dict(Imports, dict:new()). -spec to_dict([abs_form()], imp_dict()) -> imp_dict(). to_dict([], Dict) -> Dict; to_dict([{attribute, Line, import, {Mod, FunL}} | Rest], Dict0) -> to_dict(Rest, lists:foldl(fun(Fun, Dict) -> dict:store(Fun, {Line, Mod, false}, Dict) end, Dict0, FunL)). -spec new_import_attributes(imp_dict()) -> [abs_form()]. new_import_attributes(Dict) -> LMFs = [{Line, Mod, Fun} || {Fun, {Line, Mod, true}} <- dict:to_list(Dict)], Imports = lists:keysort(1, LMFs), lists:reverse(lists:foldl(fun add_new_attribute/2, [], Imports)). -type lmf() :: {?LINE_MOD:line(), mod_name(), fun_name()}. -spec add_new_attribute(lmf(), [abs_form()]) -> [abs_form()]. add_new_attribute({Line, Mod, Fun}, [{_, Line, _, {Mod, FunL}} | Attributes]) -> [{attribute, Line, import, {Mod, [Fun | FunL]}} | Attributes]; add_new_attribute({Line, Mod, Fun}, Attributes) -> [{attribute, Line, import, {Mod, [Fun]}} | Attributes]. erlang-proper-1.1+gitfa58f82bdc+dfsg/src/strip_types.erl000066400000000000000000000045571255446327200232100ustar00rootroot00000000000000%%% Copyright 2010-2013 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc A parse transform that removes all type-related annotations from a %%% module. Its intended use within PropEr is to allow the main application %%% modules, which make heavy use of recursive types, to compile on versions of %%% the Erlang/OTP distribution older than R13B04. To enable this %%% transformation, add ``{d,'NO_TYPES'}'' to the option `erl_opts' inside %%% `rebar.config'. -module(strip_types). -export([parse_transform/2]). %% We need to strip the following: %% -export_type declarations: %% {attribute,LINE,export_type,_} %% -type attributes: %% {attribute,LINE,type,_} %% -opaque attributes: %% {attribute,LINE,opaque,_} %% record field types: %% stored separately from the record declaration, in a -type attribute %% -spec attributes: %% {attribute,LINE,spec,_} %% -callback attributes: %% {attribute,LINE,callback,_} -define(ATTRS_TO_STRIP, [export_type,type,opaque,spec,callback]). %% @private -spec parse_transform([erl_parse:abstract_form()], [compile:option()]) -> [erl_parse:abstract_form()]. parse_transform(Forms, _Options) -> strip_types(Forms, []). strip_types([], Acc) -> lists:reverse(Acc); strip_types([{attribute,_,Kind,_} = Attr | Rest], Acc) -> case lists:member(Kind, ?ATTRS_TO_STRIP) of true -> strip_types(Rest, Acc); false -> strip_types(Rest, [Attr | Acc]) end; strip_types([Form | Rest], Acc) -> strip_types(Rest, [Form | Acc]). erlang-proper-1.1+gitfa58f82bdc+dfsg/src/vararg.erl000066400000000000000000000101071255446327200220710ustar00rootroot00000000000000%%% Copyright 2010-2015 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2015 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc This module contains a helper parse transform that allows the creation %%% of functions of arbitrary arity. %%% @private -module(vararg). -export([parse_transform/2]). -include("proper_internal.hrl"). %% 'MAKE_FUN'(Arity,Handler,Err) will be replaced with this case clause: %% case Arity of %% 0 -> fun() -> Handler([]) end; %% 1 -> fun(X1) -> Handler([X1]) end; %% 2 -> fun(X2,X1) -> Handler([X2,X1]) end; %% 3 -> fun(X3,X2,X1) -> Handler([X3,X2,X1]) end; %% ... %% k -> fun(Xk,...,X1) -> Handler([Xk,...,X1]) end; %% _ -> Err() %% end %% where k = ?MAX_ARITY %% CAUTION: This conversion works on a syntactic level: %% 'Arity' will usually be a variable or a function call (it certainly doesn't %% make sense for it to be a simple numeric value). %% 'Handler' gets copied many times, therefore it should not be a complex %% expression. It will usually be a variable, an external fun declaration, or %% even simply the name of a local function. %% 'Err' can be anything that evaluates to a 0-arity fun value. %%------------------------------------------------------------------------------ %% Top-level functions %%------------------------------------------------------------------------------ -spec parse_transform([abs_form()], [compile:option()]) -> [abs_form()]. parse_transform(Forms, _Options) -> process(Forms). -spec process(term()) -> term(). process({call,_,{atom,_,'MAKE_FUN'},[Arity,Handler,Err]}) -> add_vararg_wrapper(Arity, Handler, Err); process(List) when is_list(List) -> [process(X) || X <- List]; process(Tuple) when is_tuple(Tuple) -> list_to_tuple(process(tuple_to_list(Tuple))); process(Other) -> Other. -spec add_vararg_wrapper(abs_expr(), abs_expr(), abs_expr()) -> abs_expr(). add_vararg_wrapper(Arity, Handler, Err) -> RevClauses = wrapper_clauses(?MAX_ARITY, Handler), CatchAll = {clause,0,[{var,0,'_'}],[],[{call,0,Err,[]}]}, Clauses = lists:reverse([CatchAll | RevClauses]), {'case',0,Arity,Clauses}. -spec wrapper_clauses(arity(), abs_expr()) -> [abs_clause(),...]. wrapper_clauses(MaxArity, Handler) -> wrapper_clauses(0, MaxArity, Handler, [], [], {nil,0}). -spec wrapper_clauses(arity(), arity(), abs_expr(), [abs_clause()], [abs_expr()], abs_expr()) -> [abs_clause(),...]. wrapper_clauses(MaxArity, MaxArity, Handler, Clauses, Args, ArgsList) -> FinalClause = wrapper_clause(MaxArity, Handler, Args, ArgsList), [FinalClause | Clauses]; wrapper_clauses(N, MaxArity, Handler, Clauses, Args, ArgsList) -> NewClause = wrapper_clause(N, Handler, Args, ArgsList), NewClauses = [NewClause | Clauses], NewArg = {var,0,list_to_atom("X" ++ integer_to_list(N+1))}, NewArgs = [NewArg | Args], NewArgsList = {cons,0,NewArg,ArgsList}, wrapper_clauses(N+1, MaxArity, Handler, NewClauses, NewArgs, NewArgsList). -spec wrapper_clause(arity(), abs_expr(), [abs_expr()], abs_expr()) -> abs_clause(). wrapper_clause(N, Handler, Args, ArgsList) -> Body = [{call,0,Handler,[ArgsList]}], Fun = {'fun',0,{clauses,[{clause,0,Args,[],Body}]}}, {clause,0,[{integer,0,N}],[],[Fun]}. erlang-proper-1.1+gitfa58f82bdc+dfsg/test/000077500000000000000000000000001255446327200202745ustar00rootroot00000000000000erlang-proper-1.1+gitfa58f82bdc+dfsg/test/auto_export_test1.erl000066400000000000000000000023101255446327200244650ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc This module tests whether properties are auto-exported when including %%% proper.hrl -module(auto_export_test1). -export([]). -include_lib("proper/include/proper.hrl"). prop_1() -> ?FORALL(_, integer(), true). erlang-proper-1.1+gitfa58f82bdc+dfsg/test/auto_export_test2.erl000066400000000000000000000023551255446327200244770ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc This module tests whether auto-exporting is disabled when compiling %%% with PROPER_NO_TRANS enabled. -module(auto_export_test2). -define(PROPER_NO_TRANS, true). -include_lib("proper/include/proper.hrl"). prop_1() -> ?FORALL(_, integer(), true). erlang-proper-1.1+gitfa58f82bdc+dfsg/test/command_props.erl000066400000000000000000000065021255446327200236440ustar00rootroot00000000000000%%% Copyright 2010-2014 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2014 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Eirini Arvaniti -module(command_props). -include_lib("proper/include/proper.hrl"). -define(MOD, ets_counter). -define(MOD1, pdict_statem). ne_nd_list(ElemType) -> ?LET(L, non_empty(list(ElemType)), lists:usort(L)). short_ne_nd_list(ElemType) -> ?LET(L, resize(8, non_empty(list(ElemType))), lists:usort(L)). no_duplicates(L) -> length(L) =:= length(lists:usort(L)). prop_index() -> ?FORALL(List, ne_nd_list(integer()), ?FORALL(X, union(List), lists:nth(proper_statem:index(X, List), List) =:= X)). prop_all_insertions() -> ?FORALL(List, list(integer()), begin Len = length(List), ?FORALL(Limit, range(1,Len+1), ?FORALL(X, integer(), begin AllIns = proper_statem:all_insertions(X, Limit, List), length(AllIns) =:= Limit end)) end). prop_insert_all() -> ?FORALL(List, short_ne_nd_list(integer()), begin Len = length(List), {L1, L2} = lists:split(Len div 2, List), AllIns = proper_statem:insert_all(L1, L2), ?WHENFAIL(io:format("~nList: ~w, L1: ~w, L2: ~w~nAllIns: ~w~n", [List,L1,L2,AllIns]), lists:all(fun(L) -> length(L) =:= Len andalso no_duplicates(L) andalso lists:subtract(L,L2) =:= L1 end, AllIns)) end). prop_zip() -> ?FORALL({X, Y}, {list(), list()}, begin LenX = length(X), LenY = length(Y), Res = if LenX < LenY -> lists:zip(X, lists:sublist(Y, LenX)); LenX =:= LenY -> lists:zip(X, Y); LenX > LenY -> lists:zip(lists:sublist(X, LenY), Y) end, equals(zip(X, Y), Res) end). prop_state_after() -> ?FORALL(Cmds, proper_statem:commands(?MOD1), begin SymbState = proper_statem:state_after(?MOD1, Cmds), {_, S, ok} = proper_statem:run_commands(?MOD1, Cmds), ?MOD1:clean_up(), equals(proper_symb:eval(SymbState), S) end). prop_parallel_ets_counter() -> ?FORALL({_Seq, [P1, P2]}, proper_statem:parallel_commands(?MOD), begin Len1 = length(P1), Len2 = length(P2), Len1 =:= Len2 orelse (Len1 + 1) =:= Len2 end). prop_check_true() -> ?FORALL({Seq, Par}, proper_statem:parallel_commands(?MOD), begin ?MOD:clean_up(), ?MOD:set_up(), {{_, State, ok}, Env} = proper_statem:run(?MOD, Seq, []), Res = [proper_statem:execute(C, Env, ?MOD, []) || C <- Par], V = proper_statem:check(?MOD, State, Env, false, [], Res), equals(V, true) end). erlang-proper-1.1+gitfa58f82bdc+dfsg/test/error_statem.erl000066400000000000000000000031061255446327200235060ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Eirini Arvaniti -module(error_statem). -compile(export_all). -include_lib("proper/include/proper.hrl"). -record(state, {step = 0}). initial_state() -> #state{}. command(_S) -> oneof([{call,?MODULE,foo,[integer()]}, {call,?MODULE,bar,[]}]). precondition(_, _) -> true. next_state(#state{step=Step}, _, _) -> #state{step=Step+1}. postcondition(_, _, _) -> true. foo(I) -> case I > 10 of false -> ok; true -> throw(badarg) end. bar() -> 42. prop_simple() -> ?FORALL(Cmds, commands(?MODULE), begin {_H,_S,Res} = run_commands(?MODULE, Cmds), equals(Res, ok) end). erlang-proper-1.1+gitfa58f82bdc+dfsg/test/ets_counter.erl000066400000000000000000000047621255446327200233430ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Eirini Arvaniti -module(ets_counter). %% -export([ets_inc/2]). %% -export([command/1, precondition/2, postcondition/3, %% initial_state/0, next_state/3]). -compile(export_all). -include_lib("proper/include/proper.hrl"). -define(KEYS, lists:seq(1, 10)). ets_inc(Key, Inc) -> case ets:lookup(counter, Key) of [] -> erlang:yield(), ets:insert(counter, {Key,Inc}), Inc; [{Key,OldValue}] -> NewValue = OldValue + Inc, ets:insert(counter, {Key, NewValue}), NewValue end. prop_ets_counter() -> ?FORALL(Commands, parallel_commands(?MODULE), begin set_up(), {Seq,P,Result} = run_parallel_commands(?MODULE, Commands), clean_up(), ?WHENFAIL(io:format("Seq: ~w\nPar: ~w\nRes: ~w\n", [Seq, P, Result]), Result =:= ok) end). set_up() -> counter = ets:new(counter, [public, named_table]), ok. clean_up() -> catch ets:delete(counter). key() -> elements(?KEYS). initial_state() -> []. precondition(_S, _C) -> true. command(_S) -> {call,?MODULE,ets_inc,[key(),non_neg_integer()]}. postcondition(S, {call,_,ets_inc,[Key, Inc]}, Res) -> case proplists:is_defined(Key, S) of true -> OldValue = proplists:get_value(Key, S), Res =:= OldValue + Inc; false -> Res =:= Inc end. next_state(S, _Res, {call,_,ets_inc,[Key, Inc]}) -> case proplists:is_defined(Key, S) of true -> OldValue = proplists:get_value(Key, S), NewValue = OldValue + Inc, [{Key,NewValue}|proplists:delete(Key, S)]; false -> [{Key,Inc}|S] end. erlang-proper-1.1+gitfa58f82bdc+dfsg/test/ets_statem.erl000066400000000000000000000200331255446327200231460ustar00rootroot00000000000000%%% Copyright 2010-2014 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2014 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Eirini Arvaniti %%% @doc Simple statem test for ets tables -module(ets_statem). -export([initial_state/1, command/1, precondition/2, postcondition/3, next_state/3]). -export([set_up/0, clean_up/0]). -include_lib("proper/include/proper.hrl"). -type object() :: tuple(). -type table_type() :: 'set' | 'ordered_set' | 'bag' | 'duplicate_bag'. -record(state, {stored = [] :: [object()], %% list of objects %% stored in ets table type = set :: table_type()}). %% type of ets table -define(TAB, table). -define(INT_KEYS, lists:seq(0,10)). -define(FLOAT_KEYS, [float(Key) || Key <- ?INT_KEYS]). %%% Generators key() -> frequency([{5, integer_key()}, {1, float_key()}]). integer_key() -> elements(?INT_KEYS). float_key() -> elements(?FLOAT_KEYS). int_or_bin() -> frequency([{5, integer()}, {1, binary()}]). object() -> oneof([{key(), int_or_bin()}, {key(), int_or_bin(), binary()}, {key(), int_or_bin(), binary(), binary()}]). object(S) -> elements(S#state.stored). key(S) -> ?LET(Object, object(S), element(1, Object)). small_int() -> resize(10, integer()). %%% Abstract state machine for ets table initial_state(Type) -> #state{type = Type}. command(S) -> oneof([{call,ets,delete_object,[?TAB, object(S)]} || S#state.stored =/= []] ++ [{call,ets,delete,[?TAB, key(S)]} || S#state.stored =/= []] ++ [{call,ets,insert,[?TAB, object()]}, {call,ets,insert_new,[?TAB, object()]}, {call,ets,lookup,[?TAB,key()]}] ++ [{call,ets,update_counter,[?TAB,key(S),small_int()]} || S#state.stored =/= [], S#state.type =:= set orelse S#state.type =:= ordered_set]). precondition(S, {call,_,update_counter,[?TAB,Key,_Incr]}) -> Object = case S#state.type of set -> proplists:lookup(Key, S#state.stored); ordered_set -> lists:keyfind(Key, 1, S#state.stored) end, is_tuple(Object) andalso is_integer(element(2, Object)); precondition(_S, {call,_,_,_}) -> true. next_state(S, _V, {call,_,update_counter,[?TAB,Key,Incr]}) -> case S#state.type of set -> Object = proplists:lookup(Key, S#state.stored), Value = element(2, Object), NewObj = setelement(2, Object, Value + Incr), S#state{stored = keyreplace(Key, 1, S#state.stored, NewObj)}; ordered_set -> Object = lists:keyfind(Key, 1, S#state.stored), Value = element(2, Object), NewObj = setelement(2, Object, Value + Incr), S#state{stored = lists:keyreplace(Key, 1, S#state.stored, NewObj)} end; next_state(S, _V, {call,_,insert,[?TAB,Object]}) -> case S#state.type of set -> Key = element(1, Object), case proplists:is_defined(Key, S#state.stored) of false -> S#state{stored = [Object|S#state.stored]}; true -> S#state{stored = keyreplace(Key, 1, S#state.stored, Object)} end; ordered_set -> Key = element(1, Object), case lists:keymember(Key, 1, S#state.stored) of false -> S#state{stored = [Object|S#state.stored]}; true -> S#state{stored = lists:keyreplace(Key, 1, S#state.stored, Object)} end; bag -> case lists:member(Object, S#state.stored) of false -> S#state{stored = [Object|S#state.stored]}; true -> S end; duplicate_bag -> S#state{stored = [Object|S#state.stored]} end; next_state(S, _V, {call,_,insert_new,[?TAB,Object]}) -> Key = element(1, Object), case S#state.type of ordered_set -> case lists:keymember(Key, 1, S#state.stored) of false -> S#state{stored = [Object|S#state.stored]}; true -> S end; _ -> case proplists:is_defined(Key, S#state.stored) of false -> S#state{stored = [Object|S#state.stored]}; true -> S end end; next_state(S, _V, {call,_,delete_object,[?TAB,Object]}) -> case S#state.type of duplicate_bag -> S#state{stored = delete_all(Object, S#state.stored)}; _ -> S#state{stored = lists:delete(Object, S#state.stored)} end; next_state(S, _V, {call,_,delete,[?TAB,Key]}) -> case S#state.type of ordered_set -> S#state{stored = lists:keydelete(Key, 1, S#state.stored)}; _ -> S#state{stored = proplists:delete(Key, S#state.stored)} end; next_state(S, _V, {call,_,_,_}) -> S. postcondition(S, {call,_,update_counter,[?TAB,Key,Incr]}, Res) -> Object = case S#state.type of set -> proplists:lookup(Key, S#state.stored); ordered_set -> lists:keyfind(Key, 1, S#state.stored) end, Value = element(2, Object), Res =:= Value + Incr; postcondition(_S, {call,_,delete_object,[?TAB,_Object]}, Res) -> Res =:= true; postcondition(_S, {call,_,delete,[?TAB,_Key]}, Res) -> Res =:= true; postcondition(_S, {call,_,insert,[?TAB,_Object]}, Res) -> Res =:= true; postcondition(S, {call,_,insert_new,[?TAB,Object]}, Res) -> Key = element(1, Object), case S#state.type of ordered_set -> Res =:= not lists:keymember(Key, 1, S#state.stored); _ -> Res =:= not proplists:is_defined(Key, S#state.stored) end; postcondition(S, {call,_,lookup,[?TAB,Key]}, []) -> case S#state.type of ordered_set -> not lists:keymember(Key, 1, S#state.stored); _ -> not proplists:is_defined(Key, S#state.stored) end; postcondition(S, {call,_,lookup,[?TAB,Key]}, Res) -> case S#state.type of set -> Res =:= proplists:lookup_all(Key, S#state.stored); ordered_set -> Res =:= [lists:keyfind(Key, 1, S#state.stored)]; _ -> Res =:= lists:reverse(proplists:lookup_all(Key, S#state.stored)) end. %%% Sample properties prop_ets() -> ?FORALL(Type, noshrink(table_type()), ?FORALL(Cmds, commands(?MODULE, initial_state(Type)), begin catch ets:delete(?TAB), ?TAB = ets:new(?TAB, [Type, public, named_table]), {H,S,Res} = run_commands(?MODULE, Cmds), clean_up(), ?WHENFAIL( io:format("History: ~p\nState: ~p\nRes: ~p\n", [H,S,Res]), collect(Type, Res =:= ok)) end)). prop_parallel_ets() -> ?FORALL(Type, noshrink(table_type()), ?FORALL(Cmds, parallel_commands(?MODULE, initial_state(Type)), begin catch ets:delete(?TAB), ?TAB = ets:new(?TAB, [Type, public, named_table]), {Seq,P,Res} = run_parallel_commands(?MODULE, Cmds), ?WHENFAIL( io:format("Sequential: ~p\nParallel: ~p\nRes: ~p\n", [Seq,P,Res]), collect(Type, Res =:= ok)) end)). %%% Utility Functions set_up() -> catch ets:delete(?TAB), Type = lists:nth(proper_arith:rand_int(1, 4), [set, ordered_set, bag, duplicate_bag]), ?TAB = ets:new(?TAB, [Type, public, named_table]). clean_up() -> ok. keyreplace(Key, Pos, List, NewTuple) -> keyreplace(Key, Pos, List, NewTuple, []). keyreplace(_Key, _Pos, [], _NewTuple, Acc) -> lists:reverse(Acc); keyreplace(Key, Pos, [Tuple|Rest], NewTuple, Acc) -> case element(Pos, Tuple) =:= Key of true -> lists:reverse(Acc) ++ [NewTuple|Rest]; false -> keyreplace(Key, Pos, Rest, NewTuple, [Tuple|Acc]) end. delete_all(X, List) -> delete_all(X, List, []). delete_all(_X, [], Acc) -> lists:reverse(Acc); delete_all(X, [H|T], Acc) -> case X =:= H of true -> delete_all(X, T, Acc); false -> delete_all(X, T, [H|Acc]) end. erlang-proper-1.1+gitfa58f82bdc+dfsg/test/no_native_parse_test.erl000066400000000000000000000024271255446327200252200ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc This module tests whether parsing of native types is disabled when %%% compiling with PROPER_NO_TRANS enabled. -module(no_native_parse_test). -export([prop_1/0]). -define(PROPER_NO_TRANS, true). -include_lib("proper/include/proper.hrl"). prop_1() -> ?FORALL(_, types_test1:exp1(), true). erlang-proper-1.1+gitfa58f82bdc+dfsg/test/no_out_of_forall_test.erl000066400000000000000000000023501255446327200253650ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc This module tests whether native types are parsed outside of ?FORALLs. -module(no_out_of_forall_test). -export([]). -include_lib("proper/include/proper.hrl"). foo() -> ?LET(X, types_test1:exp1(), {42,X}). prop_1() -> ?FORALL(_, foo(), true). erlang-proper-1.1+gitfa58f82bdc+dfsg/test/nogen_statem.erl000066400000000000000000000027721255446327200234730ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Eirini Arvaniti -module(nogen_statem). -compile(export_all). -include_lib("proper/include/proper.hrl"). initial_state() -> []. command(_S) -> oneof([{call,?MODULE,foo,[impossible_arg()]}, {call,?MODULE,bar,[]}]). impossible_arg() -> ?SUCHTHAT(X, non_neg_integer(), X < 0). precondition(_, _) -> true. next_state(S, _, _) -> S. postcondition(_, _, _) -> true. foo(_) -> ok. bar() -> 42. prop_simple() -> ?FORALL(Cmds, commands(?MODULE), begin {_H,_S,Res} = run_commands(?MODULE, Cmds), equals(Res, ok) end). erlang-proper-1.1+gitfa58f82bdc+dfsg/test/numbers_fsm.erl000066400000000000000000000111761255446327200233260ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Eirini Arvaniti %%% @doc Tests for fsm transition targets -module(numbers_fsm). -compile(export_all). -include_lib("proper/include/proper.hrl"). -define(STATES, [zero, one, two, three, four]). -define(KEYS, [a,b,c,d,e,f]). -define(LOOKUP, [{zero,0}, {one,1}, {two,2}, {three,3}, {four,4}]). %%% Fsm callbacks zero(S) -> idle_transition() ++ [{four, {call,?MODULE,dec,[]}}, {one, {call,?MODULE,inc,[]}}, {history, {call,?MODULE,insert,[key()]}}, {history, {call,?MODULE,delete,[key(S)]}}]. one(S) -> idle_transition() ++ [{zero, {call,?MODULE,dec,[]}}, {two, {call,?MODULE,inc,[]}}, {history, {call,?MODULE,insert,[key()]}}, {history, {call,?MODULE,delete,[key(S)]}}]. two(S) -> idle_transition() ++ [{one, {call,?MODULE,dec,[]}}, {three, {call,?MODULE,inc,[]}}, {history, {call,?MODULE,insert,[key()]}}, {history, {call,?MODULE,delete,[key(S)]}}]. three(S) -> idle_transition() ++ [{two, {call,?MODULE,dec,[]}}, {four, {call,?MODULE,inc,[]}}, {history, {call,?MODULE,insert,[key()]}}, {history, {call,?MODULE,delete,[key(S)]}}]. four(S) -> idle_transition() ++ [{three, {call,?MODULE,dec,[]}}, {zero, {call,?MODULE,inc,[]}}, {history, {call,?MODULE,insert,[key()]}}, {history, {call,?MODULE,delete,[key(S)]}}]. num(N, _, _, _S) -> idle_transition() ++ [{{num,N+1,dummy,dummy}, {call,?MODULE,inc,[]}} || N < 4] ++ [{{num,N-1,dummy,dummy}, {call,?MODULE,dec,[]}} || N > 0] ++ [{{num,0,dummy,dummy}, {call,?MODULE,inc,[]}} || N =:= 4] ++ [{{num,4,dummy,dummy}, {call,?MODULE,dec,[]}} || N =:= 0]. idle_transition() -> [{history, {call,?MODULE,idle,[]}}]. initial_state() -> zero. initial_state_data() -> []. precondition(_, _, S, {call,_,delete,[Key]}) -> lists:member(Key, S); precondition(zero, _To , _S, _Call) -> true; precondition(_From, _To, S, {call,_,dec,_}) -> S =/= []; precondition(_From, _To, S, {call,_,inc,_}) -> S =/= []; precondition(_, _, _, _) -> true. next_state_data(_, _, S, _, {call,_,insert,[Key]}) -> [Key|S]; next_state_data(_, _, S, _, {call,_,delete,[Key]}) -> lists:delete(Key, S); next_state_data(_, _, S, _, _) -> S. postcondition(_, _, _, _, _) -> true. weight(_, _, {call,_,insert,_}) -> 2; weight(_, _, _) -> 1. %%% Generators key() -> elements(?KEYS). key(S) -> elements(S). action() -> oneof([idle, inc, dec, foo]). call() -> {call,?MODULE,action(),[]}. mod(X, Y) when X > 0 -> X rem Y; mod(X, Y) when X < 0 -> Y + X rem Y; mod(0, _Y) -> 0. mod_add(X, Y) -> mod(X+Y, 5). mod_sub(X, Y) -> mod(X-Y, 5). inc() -> ok. idle() -> ok. dec() -> ok. insert(_) -> ok. delete(_) -> ok. %%% Properties prop_target_states_atom() -> ?FORALL([From,Call], [elements(?STATES),call()], begin Res = proper_fsm:target_states(?MODULE, From, [], Call), {call,_,Action,[]} = Call, Target = case Action of idle -> [history]; inc -> Sum = mod_add(proplists:get_value(From, ?LOOKUP), 1), [element(1, lists:keyfind(Sum, 2, ?LOOKUP))]; dec -> Diff = mod_sub(proplists:get_value(From, ?LOOKUP), 1), [element(1, lists:keyfind(Diff, 2, ?LOOKUP))]; foo -> [] end, collect({From,Action}, Target =:= Res) end). prop_target_states_tuple() -> ?FORALL([From,Call], [{num,range(0,4),dummy,dummy},call()], begin {num,N,_,_} = From, Res = proper_fsm:target_states(?MODULE, From, dummy, Call), {call,_,Action,[]} = Call, Target = case Action of idle -> [history]; inc -> Sum = mod_add(N, 1), [{num,Sum,dummy,dummy}]; dec -> Diff = mod_sub(N, 1), [{num,Diff,dummy,dummy}]; foo -> [] end, collect({From,Action}, Target =:= Res) end). erlang-proper-1.1+gitfa58f82bdc+dfsg/test/pdict_fsm.erl000066400000000000000000000075221255446327200227560ustar00rootroot00000000000000%%% Copyright 2010-2014 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2014 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Eirini Arvaniti %%% @doc Simple fsm test for the process dictionary -module(pdict_fsm). -export([test/0, test/1, sample_commands/0]). -export([initial_state/0, initial_state_data/0, precondition/4, weight/3, postcondition/5, next_state_data/5, empty_pdict/1, non_empty_pdict/1]). -export([set_up/0, clean_up/0]). -include_lib("proper/include/proper.hrl"). -define(KEYS, [a,b,c,d]). %% A simple fsm test for the process dictionary; tests the %% operations erlang:put/2, erlang:get/1, erlang:erase/1 test() -> test(100). test(N) -> proper:quickcheck(?MODULE:prop_pdict(), N). prop_pdict() -> ?FORALL(Cmds, proper_fsm:commands(?MODULE), begin set_up(), {H,S,Res} = proper_fsm:run_commands(?MODULE, Cmds), clean_up(), ?WHENFAIL( io:format("History: ~w\nState: ~w\nRes: ~w\n", [H, S, Res]), aggregate(zip(proper_fsm:state_names(H), command_names(Cmds)), Res == ok)) end). set_up() -> ok. clean_up() -> lists:foreach(fun(Key) -> erlang:erase(Key) end, ?KEYS). key() -> elements(?KEYS). key(List) -> elements(proplists:get_keys(List)). initial_state() -> empty_pdict. initial_state_data() -> []. empty_pdict(_S) -> [{non_empty_pdict, {call,erlang,put,[key(),integer()]}}]. non_empty_pdict(S) -> [{history, {call,erlang,put,[key(),integer()]}}, {history, {call,erlang,get,[key(S)]}}, {history, {call,erlang,erase,[key(S)]}}, {empty_pdict, {call,erlang,erase,[key(S)]}}]. precondition(non_empty_pdict, non_empty_pdict, S, {call,erlang,erase,[Key]}) -> proplists:is_defined(Key, S) andalso proplists:delete(Key, S) =/= []; precondition(non_empty_pdict, empty_pdict, S, {call,erlang,erase,[Key]}) -> proplists:is_defined(Key, S) andalso proplists:delete(Key, S) =:= []; precondition(_, _, S, {call,erlang,get,[Key]}) -> proplists:is_defined(Key, S); precondition(_, _, _, {call,erlang,put,[_Key,_Val]}) -> true. postcondition(_, _, Props, {call,erlang,put,[Key,_]}, undefined) -> not proplists:is_defined(Key, Props); postcondition(_, _, Props, {call,erlang,put,[Key,_]}, Old) -> [{Key,Old}] =:= proplists:lookup_all(Key, Props); postcondition(_, _, Props, {call,erlang,get,[Key]}, Val) -> [{Key,Val}] =:= proplists:lookup_all(Key, Props); postcondition(_, _, Props, {call,erlang,erase,[Key]}, Val) -> [{Key,Val}] =:= proplists:lookup_all(Key, Props). next_state_data(_, _, Props, _Var, {call,erlang,put,[Key,Value]}) -> %% correct model [{Key,Value}|proplists:delete(Key, Props)]; %% wrong model %% Props ++ [{Key,Value}]; next_state_data(_, _, Props, _Var, {call,erlang,erase,[Key]}) -> proplists:delete(Key, Props); next_state_data(_, _, Props, _Var, {call,erlang,get,[_]}) -> Props. weight(_, _, {call,erlang,get,_}) -> 5; weight(_, _, {call,erlang,erase,_}) -> 2; weight(_, _, {call,erlang,put,_}) -> 5. sample_commands() -> proper_gen:sample(proper_fsm:commands(?MODULE)). erlang-proper-1.1+gitfa58f82bdc+dfsg/test/pdict_statem.erl000066400000000000000000000062761255446327200234730ustar00rootroot00000000000000%%% Copyright 2010-2014 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2014 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Kresten Krab Thorup, edited by Eirini Arvaniti %%% @doc Simple statem test for the process dictionary -module(pdict_statem). -export([test/0, test/1]). -export([initial_state/0, command/1, precondition/2, postcondition/3, next_state/3]). -export([set_up/0, clean_up/0]). -include_lib("proper/include/proper.hrl"). -define(KEYS, [a,b,c,d]). %% A simple statem test for the process dictionary; tests the %% operations erlang:put/2, erlang:get/1, erlang:erase/1. test() -> test(100). test(N) -> proper:quickcheck(?MODULE:prop_pdict(), N). prop_pdict() -> ?FORALL(Cmds, commands(?MODULE), begin set_up(), {H,S,Res} = run_commands(?MODULE, Cmds), clean_up(), ?WHENFAIL( io:format("History: ~w\nState: ~w\nRes: ~w\n", [H, S, Res]), aggregate(command_names(Cmds), Res =:= ok)) end). set_up() -> ok. clean_up() -> lists:foreach(fun(Key) -> erlang:erase(Key) end, ?KEYS). key() -> elements(?KEYS). initial_state() -> [KV || {Key, _} = KV <- erlang:get(), lists:member(Key, ?KEYS)]. command([]) -> {call,erlang,put,[key(),integer()]}; command(Props) -> ?LET({Key, Value}, weighted_union([{2, elements(Props)}, {1, {key(), integer()}}]), oneof([{call,erlang,put,[Key,Value]}, {call,erlang,get,[Key]}, {call,erlang,erase,[Key]}])). precondition(_, {call,erlang,put,[_,_]}) -> true; precondition(Props, {call,erlang,get,[Key]}) -> proplists:is_defined(Key, Props); precondition(Props, {call,erlang,erase,[Key]}) -> proplists:is_defined(Key, Props). postcondition(Props, {call,erlang,put,[Key,_]}, undefined) -> not proplists:is_defined(Key, Props); postcondition(Props, {call,erlang,put,[Key,_]}, Old) -> {Key,Old} =:= proplists:lookup(Key, Props); postcondition(Props, {call,erlang,get,[Key]}, Val) -> {Key,Val} =:= proplists:lookup(Key, Props); postcondition(Props, {call,erlang,erase,[Key]}, Val) -> {Key,Val} =:= proplists:lookup(Key, Props). next_state(Props, _Var, {call,erlang,put,[Key,Value]}) -> %% correct model [{Key,Value}|proplists:delete(Key, Props)]; %% wrong model %% Props ++ [{Key,Value}]; next_state(Props, _Var, {call,erlang,erase,[Key]}) -> proplists:delete(Key, Props); next_state(Props, _Var, {call,erlang,get,[_]}) -> Props. erlang-proper-1.1+gitfa58f82bdc+dfsg/test/perf_max_size.erl000066400000000000000000000025351255446327200236400ustar00rootroot00000000000000%%--------------------------------------------------------------------------- %% From: Jeff Hlywa %% Subject: Increasing max_size significantly degrades performance. %%--------------------------------------------------------------------------- %% Using the code below I get: %% 1> timer:tc(fun() -> %% proper:quickcheck(prop_identity(), [5, {max_size, 42}]) end). %% ..... %% OK: Passed 5 test(s). %% {8170,true} %% %% 2> timer:tc(fun() -> %% proper:quickcheck(prop_identity(), [5, {max_size, 16#ffffffff}]) end). %% .... %% OK: Passed 5 test(s). %% {658751072,true} %% %% Not able to determine the cause of the slowdown, but it's significant. %% --------------------------------------------------------------------------- %% Fixed on 29/3/2013. The fix was that when increasing the size, move %% to the next value immediately instead of trying each value one-by-one. %% --------------------------------------------------------------------------- -module(perf_max_size). -export([prop_identity/0]). -include_lib("proper/include/proper.hrl"). -record(msg, {a = 0 :: 0..16#ffffffff, b = 0 :: 0..16#f}). -type msg() :: #msg{}. prop_identity() -> ?FORALL(Msg, msg(), Msg =:= decode(encode(Msg))). -spec encode(msg()) -> binary(). encode(#msg{a = A, b = B}) -> <>. -spec decode(binary()) -> msg(). decode(<>) -> #msg{a=A, b=B}. erlang-proper-1.1+gitfa58f82bdc+dfsg/test/post_false.erl000066400000000000000000000030541255446327200231410ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Eirini Arvaniti -module(post_false). -compile(export_all). -include_lib("proper/include/proper.hrl"). -record(state, {step = 0 :: non_neg_integer()}). initial_state() -> #state{}. command(_S) -> oneof([{call,?MODULE,foo,[]}, {call,?MODULE,bar,[]}]). precondition(_, _) -> true. next_state(#state{step = Step}, _, _) -> #state{step = Step + 1}. postcondition(#state{step = Step}, _, _) -> Step < 5. foo() -> ok. bar() -> 42. prop_simple() -> ?FORALL(Cmds, commands(?MODULE), begin {_H,_S,Res} = run_commands(?MODULE, Cmds), equals(Res, ok) end). erlang-proper-1.1+gitfa58f82bdc+dfsg/test/prec_false.erl000066400000000000000000000030541255446327200231050ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Eirini Arvaniti -module(prec_false). -compile(export_all). -include_lib("proper/include/proper.hrl"). -record(state, {step = 0 :: non_neg_integer()}). initial_state() -> #state{}. command(_S) -> oneof([{call,?MODULE,foo,[]}, {call,?MODULE,bar,[]}]). precondition(#state{step = Step}, _) -> Step < 5. next_state(#state{step = Step}, _, _) -> #state{step = Step + 1}. postcondition(_, _, _) -> true. foo() -> ok. bar() -> 42. prop_simple() -> ?FORALL(Cmds, commands(?MODULE), begin {_H,_S,Res} = run_commands(?MODULE, Cmds), equals(Res, ok) end). erlang-proper-1.1+gitfa58f82bdc+dfsg/test/proper_print.erl000066400000000000000000000036141255446327200235270ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc This module contains tests to check the information printed by proper %%% on the shell -module(proper_print). -include_lib("proper/include/proper.hrl"). -include_lib("eunit/include/eunit.hrl"). %% Test that the stacktrace is not empty when something crashes in the property stacktrace_test_() -> [?_assertThrow({stacktrace, [_|_]}, proper:quickcheck(bad_proper_call_property())), ?_assertThrow({stacktrace, [_|_]}, proper:quickcheck(bad_call_property()))]. set_stacktrace_thrower(Prop) -> proper:on_output(fun throw_stacktrace/2, Prop). throw_stacktrace("Stacktrace: ~p.~n", [Stacktrace]) -> throw({stacktrace, Stacktrace}); throw_stacktrace(_, _) -> ok. bad_proper_call_property() -> set_stacktrace_thrower(?FORALL(_X, proper_types:int(), proper:foo())). bad_call_property() -> set_stacktrace_thrower(?FORALL(_X, proper_types:int(), foo:bar())). erlang-proper-1.1+gitfa58f82bdc+dfsg/test/proper_specs_tests.erl000066400000000000000000000130071255446327200247270ustar00rootroot00000000000000%%% Copyright 2010-2013 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Joseph Wayne Norton %%% @doc This modules contains PropEr's Unit tests for check %%% specs. You need the EUnit application to compile it. -module(proper_specs_tests). -include("proper.hrl"). -include_lib("eunit/include/eunit.hrl"). -export([check1_specs_test_/0, check2_specs_test_/0]). -export([test1_any/1, test2_skip/1, test3_fail/1, test4_fail_fp/2, test5_exc/2, test6_exc_fp/2, test7_exc_fp/2, test_const_bitstrs/0]). check1_specs_test_() -> ?_test(?assert(check1_specs_test())). check2_specs_test_() -> ?_test(?assert(check2_specs_test())). %%------------------------------------------------------------------------------ %% Unit tests %%------------------------------------------------------------------------------ check1_specs_test() -> Options = [quiet, long_result, {skip_mfas, [{?MODULE, check1_specs_test_, 0}, {?MODULE, check2_specs_test_, 0}, {?MODULE, test2_skip, 1}, {?MODULE, test7_exc_fp, 2}]}, {false_positive_mfas, fun check1_false_positive_mfas/3}], %% check for expected 1 test failure case proper:check_specs(?MODULE, Options) of [{{proper_specs_tests, test5_exc, 2}, [_]}] -> true; Else -> error(failed, Else) end. check2_specs_test() -> Options = [quiet, long_result, {skip_mfas, [{?MODULE, check1_specs_test_, 0}, {?MODULE, check2_specs_test_, 0}, {?MODULE, test1_any, 1}, {?MODULE, test2_skip, 1}, {?MODULE, test3_fail, 1}, {?MODULE, test4_fail_fp, 2}, {?MODULE, test5_exc, 2}, {?MODULE, test6_exc_fp, 2}]}, {false_positive_mfas, fun check2_false_positive_mfas/3}], %% check for expected 1 test failure case proper:check_specs(?MODULE, Options) of [{{proper_specs_tests, test7_exc_fp, 2}, [[Exception,_]]}] when Exception==error; Exception==exit; Exception==throw -> true; Else -> error(failed, Else) end. %%------------------------------------------------------------------------------ %% Test helpers %%------------------------------------------------------------------------------ -spec check1_false_positive_mfas(mfa(), Args::[term()], {fail,Result::term()} | {error | exit | throw,Reason::term()}) -> boolean(). check1_false_positive_mfas({?MODULE, test1_any, 1}, _Args, _) -> %% NG - should never be called false; check1_false_positive_mfas({?MODULE, test2_skip, 1}, _Args, _) -> %% NG - should never be called false; check1_false_positive_mfas({?MODULE, test3_fail, 1}, [Arg], {fail, {ng, Arg}}) -> %% OK true; check1_false_positive_mfas({?MODULE, test4_fail_fp, 2}, [_X, _Y], {fail, _Result}) -> %% NG - should never match false; check1_false_positive_mfas({?MODULE, test4_fail_fp, 2}, [_X, Y], {error, badarith}) -> %% OK Y == 0; check1_false_positive_mfas({?MODULE, test5_exc, 2}, [Class, Args], {Class, Args}) -> %% OK false; check1_false_positive_mfas({?MODULE, test6_exc_fp, 2}, [Class, Args], {Class, Args}) -> %% OK true. -spec check2_false_positive_mfas(mfa(), Args::[term()], {fail,Result::term()} | {error | exit | throw,Reason::term()}) -> boolean(). check2_false_positive_mfas({?MODULE, test7_exc_fp, 2}, [Class, Args], {Class, Args}) -> %% OK erlang:Class(Args). -spec test1_any(any()) -> any(). test1_any(Any) -> Any. -spec test2_skip(any()) -> any(). test2_skip(Any) -> Any. -spec test3_fail(any()) -> true. test3_fail(Any) -> {ng, Any}. -spec test4_fail_fp(number(), number()) -> number(). test4_fail_fp(X, Y) -> X / Y. -spec test5_exc(error | exit | throw, badarg | any()) -> any(). test5_exc(Class, Any) -> erlang:Class(Any). -spec test6_exc_fp(error | exit | throw, badarg | any()) -> any(). test6_exc_fp(Class, Any) -> erlang:Class(Any). -spec test7_exc_fp(error | exit | throw, badarg | any()) -> any(). test7_exc_fp(Class, Any) -> erlang:Class(Any). %% Tests constant (and quite weird) bitstr type specifications -spec test_const_bitstrs() -> {<<_:16>>, <<_:16,_:_*0>>, <<_:16,_:_*1>>, <<_:16,_:_*3>>, <<_:8,_:_*8>>, <<_:17>>, <<_:17,_:_*0>>, <<_:17,_:_*1>>, <<_:11,_:_*3>>, <<_:8,_:_*3>>}. test_const_bitstrs() -> Bin = <<"42">>, B17 = <<"42", 0:1>>, {Bin, Bin, Bin, Bin, Bin, B17, B17, B17, B17, B17}. erlang-proper-1.1+gitfa58f82bdc+dfsg/test/proper_tests.erl000066400000000000000000001534471255446327200235470ustar00rootroot00000000000000%%% Copyright 2010-2015 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2015 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc This modules contains PropEr's Unit tests. You need the EUnit %%% application to compile it. -module(proper_tests). -include("proper.hrl"). -include_lib("eunit/include/eunit.hrl"). %%------------------------------------------------------------------------------ %% Helper macros %%------------------------------------------------------------------------------ %% NOTE: Never add long_result to Opts for these macros. state_is_clean() -> get() =:= []. assertEqualsOneOf(_X, none) -> ok; assertEqualsOneOf(X, List) -> ?assert(lists:any(fun(Y) -> Y =:= X end, List)). -define(_passes(Test), ?_passes(Test, [])). -define(_passes(Test, Opts), ?_assertRun(true, Test, Opts, true)). -define(_errorsOut(ExpReason, Test), ?_errorsOut(ExpReason, Test, [])). -define(_errorsOut(ExpReason, Test, Opts), ?_assertRun({error,ExpReason}, Test, Opts, true)). -define(_assertRun(ExpResult, Test, Opts, AlsoLongResult), ?_test(begin ?assertMatch(ExpResult, proper:quickcheck(Test,Opts)), proper:clean_garbage(), ?assert(state_is_clean()), case AlsoLongResult of true -> ?assertMatch(ExpResult, proper:quickcheck(Test,[long_result|Opts])), proper:clean_garbage(), ?assert(state_is_clean()); false -> ok end end)). -define(_assertCheck(ExpShortResult, CExm, Test), ?_assertCheck(ExpShortResult, CExm, Test, [])). -define(_assertCheck(ExpShortResult, CExm, Test, Opts), ?_test(?assertCheck(ExpShortResult, CExm, Test, Opts))). -define(assertCheck(ExpShortResult, CExm, Test, Opts), begin ?assertMatch(ExpShortResult, proper:check(Test,CExm,Opts)), ?assert(state_is_clean()) end). -define(_fails(Test), ?_fails(Test, [])). -define(_fails(Test, Opts), ?_failsWith(_, Test, Opts)). -define(_failsWith(ExpCExm, Test), ?_failsWith(ExpCExm, Test, [])). -define(_failsWith(ExpCExm, Test, Opts), ?_assertFailRun(ExpCExm, none, Test, Opts)). -define(_failsWithOneOf(AllCExms, Test), ?_failsWithOneOf(AllCExms, Test, [])). -define(_failsWithOneOf(AllCExms, Test, Opts), ?_assertFailRun(_, AllCExms, Test, Opts)). -define(SHRINK_TEST_OPTS, [{start_size,10},{max_shrinks,10000}]). -define(_shrinksTo(ExpShrunk, Type), ?_assertFailRun([ExpShrunk], none, ?FORALL(_X,Type,false), ?SHRINK_TEST_OPTS)). -define(_shrinksToOneOf(AllShrunk, Type), ?_assertFailRun(_, [[X] || X <- AllShrunk], ?FORALL(_X,Type,false), ?SHRINK_TEST_OPTS)). -define(_nativeShrinksTo(ExpShrunk, TypeStr), ?_assertFailRun([ExpShrunk], none, ?FORALL(_X,assert_can_translate(?MODULE,TypeStr),false), ?SHRINK_TEST_OPTS)). -define(_nativeShrinksToOneOf(AllShrunk, TypeStr), ?_assertFailRun(_, [[X] || X <- AllShrunk], ?FORALL(_X,assert_can_translate(?MODULE,TypeStr),false), ?SHRINK_TEST_OPTS)). -define(_assertFailRun(ExpCExm, AllCExms, Test, Opts), ?_test(begin ShortResult = proper:quickcheck(Test, Opts), CExm1 = get_cexm(), ?checkCExm(CExm1, ExpCExm, AllCExms, Test, Opts), ?assertEqual(false, ShortResult), LongResult = proper:quickcheck(Test, [long_result|Opts]), CExm2 = get_cexm(), ?checkCExm(CExm2, ExpCExm, AllCExms, Test, Opts), ?checkCExm(LongResult, ExpCExm, AllCExms, Test, Opts) end)). get_cexm() -> CExm = proper:counterexample(), proper:clean_garbage(), ?assert(state_is_clean()), CExm. -define(checkCExm(CExm, ExpCExm, AllCExms, Test, Opts), begin ?assertCheck(false, CExm, Test, Opts), ?assertMatch(ExpCExm, CExm), assertEqualsOneOf(CExm, AllCExms) end). -define(_assertTempBecomesN(N, ExpShortResult, Prop), ?_assertTempBecomesN(N, ExpShortResult, Prop, [])). -define(_assertTempBecomesN(N, ExpShortResult, Prop, Opts), ?_test(begin ?assertMatch(ExpShortResult, proper:quickcheck(Prop, Opts)), ?assertEqual(N, get_temp()), erase_temp(), proper:clean_garbage(), ?assert(state_is_clean()) end)). inc_temp() -> inc_temp(1). inc_temp(Inc) -> case get(temp) of undefined -> put(temp, Inc); X -> put(temp, X + Inc) end, ok. get_temp() -> get(temp). erase_temp() -> erase(temp), ok. non_deterministic(Behaviour) -> inc_temp(), N = get_temp(), {MustReset,Result} = get_result(N, 0, Behaviour), case MustReset of true -> erase_temp(); false -> ok end, Result. get_result(N, Sum, [{M,Result}]) -> {N >= Sum + M, Result}; get_result(N, Sum, [{M,Result} | Rest]) -> NewSum = Sum + M, case N =< NewSum of true -> {false, Result}; false -> get_result(N, NewSum, Rest) end. setup_run_commands(Module, Cmds, Env) -> Module:set_up(), Res = proper_statem:run_commands(Module, Cmds, Env), Module:clean_up(), Res. %%------------------------------------------------------------------------------ %% Helper Functions %%------------------------------------------------------------------------------ assert_type_works({Type,Are,_Target,Arent,TypeStr}, IsSimple) -> case Type of none -> ok; _ -> lists:foreach(fun(X) -> assert_is_instance(X,Type) end, Are), assert_can_generate(Type, IsSimple), lists:foreach(fun(X) -> assert_not_is_instance(X,Type) end, Arent) end, case TypeStr of none -> ok; _ -> TransType = assert_can_translate(?MODULE, TypeStr), lists:foreach(fun(X) -> assert_is_instance(X,TransType) end, Are), assert_can_generate(TransType, IsSimple), lists:foreach(fun(X) -> assert_not_is_instance(X,TransType) end, Arent) end. assert_can_translate(Mod, TypeStr) -> proper_typeserver:start(), Type = {Mod,TypeStr}, Result1 = proper_typeserver:translate_type(Type), Result2 = proper_typeserver:translate_type(Type), proper_typeserver:stop(), ?assert(state_is_clean()), {ok,Type1} = Result1, {ok,Type2} = Result2, ?assert(proper_types:equal_types(Type1,Type2)), Type1. assert_cant_translate(Mod, TypeStr) -> proper_typeserver:start(), Result = proper_typeserver:translate_type({Mod,TypeStr}), proper_typeserver:stop(), ?assert(state_is_clean()), ?assertMatch({error,_}, Result). %% TODO: after fixing the typesystem, use generic reverse function. assert_is_instance(X, Type) -> ?assert(proper_types:is_inst(X, Type) andalso state_is_clean()). assert_can_generate(Type, CheckIsInstance) -> lists:foreach(fun(Size) -> try_generate(Type,Size,CheckIsInstance) end, [1, 2, 5, 10, 20, 40, 50]). try_generate(Type, Size, CheckIsInstance) -> {ok,Instance} = proper_gen:pick(Type, Size), ?assert(state_is_clean()), case CheckIsInstance of true -> assert_is_instance(Instance, Type); false -> ok end. assert_seeded_runs_return_same_result(Type) -> lists:foreach(fun(Size) -> try_generate_seeded(Type, Size) end, [1, 2, 5, 10, 20, 40, 50]). try_generate_seeded(Type, Size) -> Seed = os:timestamp(), {ok, Instance1} = proper_gen:pick(Type, Size, Seed), {ok, Instance2} = proper_gen:pick(Type, Size, Seed), ?assert(Instance1 =:= Instance2). assert_native_can_generate(Mod, TypeStr, CheckIsInstance) -> assert_can_generate(assert_can_translate(Mod,TypeStr), CheckIsInstance). assert_cant_generate(Type) -> ?assertEqual(error, proper_gen:pick(Type)), ?assert(state_is_clean()). assert_cant_generate_cmds(Type, N) -> ?assertEqual(error, proper_gen:pick(?SUCHTHAT(T, Type, length(T) > N))), ?assert(state_is_clean()). assert_not_is_instance(X, Type) -> ?assert(not proper_types:is_inst(X, Type) andalso state_is_clean()). assert_function_type_works(FunType) -> {ok,F} = proper_gen:pick(FunType), %% TODO: this isn't exception-safe ?assert(proper_types:is_instance(F, FunType)), assert_is_pure_function(F), proper:global_state_erase(), ?assert(state_is_clean()). assert_is_pure_function(F) -> {arity,Arity} = erlang:fun_info(F, arity), ArgsList = [lists:duplicate(Arity,0), lists:duplicate(Arity,1), lists:seq(1,Arity), lists:seq(0,Arity-1)], lists:foreach(fun(Args) -> ?assertEqual(apply(F,Args),apply(F,Args)) end, ArgsList). %%------------------------------------------------------------------------------ %% Unit test arguments %%------------------------------------------------------------------------------ simple_types_with_data() -> [{integer(), [-1,0,1,42,-200], 0, [0.3,someatom,<<1>>], "integer()"}, {integer(7,88), [7,8,87,88,23], 7, [1,90,a], "7..88"}, {integer(0,42), [0,11,42], 0, [-1,43], "0..42"}, {integer(-99,0), [-88,-99,0], 0, [1,-1112], "-99..0"}, {integer(-999,-12), [-34,-999,-12], -12, [0,5], "-999..-12"}, {integer(-99,21), [-98,0,21], 0, [-100], "-99..21"}, {integer(0,0), [0], 0, [1,-1,100,-100], "0..0"}, {pos_integer(), [12,1,444], 1, [-12,0], "pos_integer()"}, {non_neg_integer(), [42,0], 0, [-9,rr], "non_neg_integer()"}, {neg_integer(), [-222,-1], -1, [0,1111], "neg_integer()"}, {float(), [17.65,-1.12], 0.0, [11,atomm,<<>>], "float()"}, {float(7.4,88.0), [7.4,88.0], 7.4, [-1.0,3.2], none}, {float(0.0,42.1), [0.1,42.1], 0.0, [-0.1], none}, {float(-99.9,0.0), [-0.01,-90.0], 0.0, [someatom,-12,-100.0,0.1], none}, {float(-999.08,-12.12), [-12.12,-12.2], -12.12, [-1111.0,1000.0], none}, {float(-71.8,99.0), [-71.8,99.0,0.0,11.1], 0.0, [100.0,-71.9], none}, {float(0.0,0.0), [0.0], 0.0, [0.1,-0.1], none}, {non_neg_float(), [88.8,98.9,0.0], 0.0, [-12,1,-0.01], none}, {atom(), [elvis,'Another Atom',''], '', ["not_an_atom",12,12.2], "atom()"}, {binary(), [<<>>,<<12,21>>], <<>>, [<<1,2:3>>,binary_atom,42], "binary()"}, {binary(), [], <<>>, [], "<<_:_*8>>"}, {binary(3), [<<41,42,43>>], <<0,0,0>>, [<<1,2,3,4>>], "<<_:24>>"}, {binary(0), [<<>>], <<>>, [<<1>>], "<<_:0>>"}, {bitstring(), [<<>>,<<87,76,65,5:4>>], <<>>, [{12,3},11], "bitstring()"}, {bitstring(), [], <<>>, [], "<<_:_*1>>"}, {bitstring(18), [<<0,1,2:2>>,<<1,32,123:2>>], <<0,0,0:2>>, [<<12,1,1:3>>], "<<_:18, _:_*0>>"}, {bitstring(32), [<<120,120,120,120>>], <<0,0,0,0>>, [7,8], "<<_:32>>"}, {bitstring(0), [<<>>], <<>>, [<<1>>], "<<>>"}, {list(integer()), [[],[2,42],[0,1,1,2,3,5,8,13,21,34,55,89,144]], [], [[4,4.2],{12,1},<<12,113>>], "[integer()]"}, {list(atom()), [[on,the,third,day,'of',christmas,my,true,love,sent,to,me]], [], [['not',1,list,'of',atoms],not_a_list], "[atom()]"}, {list(union([integer(),atom()])), [[3,french,hens,2],[turtle,doves]], [], [{'and',1}], "[integer() | atom()]"}, {vector(5,atom()), [[partridge,in,a,pear,tree],[a,b,c,d,e]], ['','','','',''], [[a,b,c,d],[a,b,c,d,e,f]], none}, {vector(2,float()), [[0.0,1.1],[4.4,-5.5]], [0.0,0.0], [[1,1]], none}, {vector(0,integer()), [[]], [], [[1],[2]], none}, {union([good,bad,ugly]), [good,bad,ugly], good, [clint,"eastwood"], "good | bad | ugly"}, {union([integer(),atom()]), [twenty_one,21], 0, ["21",<<21>>], "integer() | atom()"}, {weighted_union([{10,luck},{20,skill},{15,concentrated_power_of_will}, {5,pleasure},{50,pain},{100,remember_the_name}]), [skill,pain,pleasure], luck, [clear,20,50], none}, {{integer(0,42),list(atom())}, [{42,[a,b]},{21,[c,de,f]},{0,[]}], {0,[]}, [{-1,[a]},{12},{21,[b,c],12}], "{0..42,[atom()]}"}, {tuple([atom(),integer()]), [{the,1}], {'',0}, [{"a",0.0}], "{atom(),integer()}"}, {{}, [{}], {}, [[],{1,2}], "{}"}, {loose_tuple(integer()), [{1,44,-1},{},{99,-99}], {}, [4,{hello,2},[1,2]], none}, {loose_tuple(union([atom(),float()])), [{a,4.4,b},{},{'',c},{1.2,-3.4}], {}, [an_atom,0.4,{hello,2},[aa,bb,3.1]], none}, {loose_tuple(list(integer())), [{[1,-1],[],[2,3,-12]},{}], {}, [[[1,2],[3,4]],{1,12},{[1,99,0.0],[]}], none}, {loose_tuple(loose_tuple(integer())), [{},{{}},{{1,2},{-1,11},{}}], {}, [{123},[{12},{24}]], none}, {exactly({[writing],unit,[tests,is],{2},boring}), [{[writing],unit,[tests,is],{2},boring}], {[writing],unit,[tests,is],{2},boring}, [no,its,'not','!'], none}, {[], [[]], [], [[a],[1,2,3]], "[]"}, {fixed_list([neg_integer(),pos_integer()]), [[-12,32],[-1,1]], [-1,1], [[0,0]], none}, {[atom(),integer(),atom(),float()], [[forty_two,42,forty_two,42.0]], ['',0,'',0.0], [[proper,is,licensed],[under,the,gpl]], none}, {[42 | list(integer())], [[42],[42,44,22]], [42], [[],[11,12]], none}, {number(), [12,32.3,-9,-77.7], 0, [manolis,papadakis], "number()"}, {boolean(), [true,false], false, [unknown], "boolean()"}, {string(), ["hello","","world"], "", ['hello'], "string()"}, {?LAZY(integer()), [0,2,99], 0, [1.1], "integer()"}, {?LAZY(list(float())), [[0.0,1.2,1.99],[]], [], [1.1,[1,2]], "[float()]"}, {zerostream(10), [[0,0,0],[],[0,0,0,0,0,0,0]], [], [[1,0,0],[0.1]], none}, {?SHRINK(pos_integer(),[0]), [1,12,0], 0, [-1,-9,6.0], none}, {?SHRINK(float(),[integer(),atom()]), [1.0,0.0,someatom,'',42,0], 0, [<<>>,"hello"], none}, {noshrink(?SHRINK(42,[0,1])), [42,0,1], 42, [-1], "42 | 0 | 1"}, {non_empty(list(integer())), [[1,2,3],[3,42],[11]], [0], [[],[0.1]], "[integer(),...]"}, {default(42,float()), [4.1,-99.0,0.0,42], 42, [43,44], "42 | float()"}, {?SUCHTHAT(X,non_neg_integer(),X rem 4 =:= 1), [1,5,37,89], 1, [4,-12,11], none}, {?SUCHTHATMAYBE(X,non_neg_integer(),X rem 4 =:= 1), [1,2,3,4,5,37,89], 0, [1.1,2.2,-12], "non_neg_integer()"}, {any(), [1,-12,0,99.9,-42.2,0.0,an_atom,'',<<>>,<<1,2>>,<<1,2,3:5>>,[], [42,<<>>],{},{tag,12},{tag,[vals,12,12.2],[],<<>>}], 0, [], "any()"}, {list(any()), [[<<>>,a,1,-42.0,{11.8,[]}]], [], [{1,aa},<<>>], "[any()]"}, {deeplist(), [[[],[]], [[[]],[]]], [], [[a]], "deeplist()"}, {none, [[234,<<1>>,[<<78>>,[]],0],[]], [], [21,3.1,[7.1],<<22>>], "iolist()"}, {none, [[234,<<1>>,[<<78>>,[]],0],[],<<21,15>>], <<>>, [21,3.1,[7.1]], "iodata()"}]. %% TODO: These rely on the intermediate form of the instances. constructed_types_with_data() -> [{?LET({A,B},{bitstring(3),binary()},<>), [{'$used',{<<1:3>>,<<3,4>>},<<32,96,4:3>>}], <<0:3>>, [], "<<_:3,_:_*8>>"}, {?LET(X,range(1,5),X*X), [{'$used',1,1},{'$used',5,25}], 1, [4,{'$used',3,8},{'$used',0,0}], none}, {?LET(L,non_empty(list(atom())),oneof(L)), [{'$used',[aa],aa},{'$used',[aa,bb],aa},{'$used',[aa,bb],bb}], '', [{'$used',[],''},{'$used',[aa,bb],cc}], none}, {?LET(X,pos_integer(),?LET(Y,range(0,X),X-Y)), [{'$used',3,{'$used',2,1}},{'$used',9,{'$used',9,0}}, {'$used',5,{'$used',0,5}}], 1, [{'$used',0,{'$used',0,0}},{'$used',3,{'$used',4,-1}}, {'$used',7,{'$used',6,2}}], none}, {?LET(Y,?LET(X,integer(),X*X),-Y), [{'$used',{'$used',-9,81},-81},{'$used',{'$used',2,4},-4}], 0, [{'$used',{'$used',1,2},-2},{'$used',{'$used',3,9},9}], none}, {?SUCHTHAT(Y,?LET(X,oneof([1,2,3]),X+X),Y>3), [{'$used',2,4},{'$used',3,6}], 4, [{'$used',1,2}], none}, {?LET(X,?SUCHTHAT(Y,pos_integer(),Y=/=0),X*X), [{'$used',3,9},{'$used',1,1},{'$used',11,121}], 1, [{'$used',-1,1},{'$used',0,0}], none}, {tree(integer()), [{'$used',[null,null],{node,42,null,null}}, {'$used',[{'$used',[null,null],{node,2,null,null}}, {'$used',[null,null],{node,3,null,null}}], {node,-1,{node,2,null,null},{node,3,null,null}}}, {'$to_part',null}, {'$to_part',{'$used',[null,null],{node,7,null,null}}}], null, [{'$used',[null,null],{node,1.1,null,null}}], "tree(integer())"}, {?LETSHRINK(L,[],{tag,L}), [{'$used',[],{tag,[]}}], {tag,[]}, [], none}, {?LETSHRINK(L,non_empty(list(atom())),{tag,L}), [{'$used',[aa],{tag,[aa]}},{'$to_part',aa}], '', [], none}, {a(), [aleaf, {'$used',[aleaf],{anode,aleaf,bleaf}}, {'$used',[aleaf],{anode,aleaf,{'$to_part',bleaf}}}], aleaf, [], "a()"}, {b(), [bleaf, {'$used',[bleaf],{bnode,aleaf,bleaf}}, {'$used',[bleaf],{bnode,{'$to_part',aleaf},bleaf}}], bleaf, [], "b()"}, {gen_tree(integer()), [{'$used',[null,null],{12,[null,null]}},{'$to_part',null}], null, [{'$used',[],{42,[]}}], "gen_tree(integer())"}, {none, [{'$used',[],{tag,[]}}, {'$used',[null,null],{tag,[null,null]}}, {'$used',[{'$used',[],{tag,[]}},{'$to_part',null}], {tag,[{tag,[]},null]}}, {'$to_part',{'$used',[],{tag,[]}}}], null, [], "g()"}, {none, [{'$used',[null],{tag,[{ok,null}]}}, {'$to_part',null}, {'$used',[null,null],{tag,[{ok,null},{ok,null}]}}], null, [], "h()"}, {none, [{'$used',[null,null,{'$used',[null],{tag,null,[]}}], {tag,null,[null,{tag,null,[]}]}}, {'$to_part',null}], null, [], "i()"}, {none, [{'$used',[{'$to_part',null},{'$used',[null],{one,null}},null,null], {tag,null,{one,null},[null,null],[null]}}], null, [], "j()"}, {none, [{tag,[]}, {tag,[{null,null}]}, {tag,[{{tag,[]},null},{null,{tag,[]}}]}], null, [{'$to_part',null}], "k()"}, {none, [{'$used',[null,null,{'$used',[null,null],{tag,null,[null]}}], {tag,null,[null,{tag,null,[null]}]}}, {'$to_part',null}], null, [{'$used',[null],{tag,null,[]}}], "l()"}, {utf8(), [{'$used',{'$used',0,[]},<<>>}, {'$used',{'$used',1,[0]},<<0>>}, {'$used',{'$used',1,[127]},<<127>>}, {'$used',{'$used',1,[353]},<<197,161>>}], <<>>, [{'$used',{'$used',1,[128]},<<128>>}], none}, {utf8(0), [{'$used',{'$used',0,[]},<<>>}], <<>>, [], none}, {utf8(1), [{'$used',{'$used',0,[]},<<>>}, {'$used',{'$used',1,[127]},<<127>>}, {'$used',{'$used',1,[353]},<<197,161>>}], <<>>, [], none}, {utf8(2), [{'$used',{'$used',1,[353]},<<197,161>>}, {'$used',{'$used',2,[127,353]},<<127,197,161>>}], <<>>, [], none}, {utf8(inf, 1), [{'$used',{'$used',0,[]},<<>>}, {'$used',{'$used',1,[0]},<<0>>}, {'$used',{'$used',2,[0,0]},<<0,0>>}, {'$used',{'$used',3,[0,0,0]},<<0,0,0>>}], <<>>, [], none}, {utf8(inf, 2), [{'$used',{'$used',3,[0,0,0]},<<0,0,0>>}, {'$used',{'$used',1,[353]},<<197,161>>}], <<>>, [], none}]. function_types() -> [{function([],atom()), "fun(() -> atom())"}, {function([integer(),integer()],atom()), "fun((integer(),integer()) -> atom())"}, {function(5,union([a,b])), "fun((_,_,_,_,_) -> a | b)"}, {function(0,function(1,integer())), "fun(() -> fun((_) -> integer()))"}]. remote_native_types() -> [{types_test1,["#rec1{}","rec1()","exp1()","type1()","type2(atom())", "rem1()","rem2()","types_test1:exp1()", "types_test2:exp1(float())","types_test2:exp2()"]}, {types_test2,["exp1(#rec1{})","exp2()","#rec1{}","types_test1:exp1()", "types_test2:exp1(binary())","types_test2:exp2()"]}]. impossible_types() -> [?SUCHTHAT(X, pos_integer(), X =< 0), ?SUCHTHAT(X, non_neg_integer(), X < 0), ?SUCHTHAT(X, neg_integer(), X >= 0), ?SUCHTHAT(X, integer(1,10), X > 20), ?SUCHTHAT(X, float(0.0,10.0), X < 0.0), ?SUCHTHAT(L, vector(12,integer()), length(L) =/= 12), ?SUCHTHAT(B, binary(), lists:member(256,binary_to_list(B))), ?SUCHTHAT(X, exactly('Lelouch'), X =:= 'vi Brittania'), ?SUCHTHAT(X, utf8(), unicode:characters_to_list(X) =:= [16#D800]), ?SUCHTHAT(X, utf8(1, 1), size(X) > 1)]. impossible_native_types() -> [{types_test1, ["1.1","no_such_module:type1()","no_such_type()"]}, {types_test2, ["types_test1:type1()","function()","fun((...) -> atom())", "pid()","port()","ref()"]}]. recursive_native_types() -> [{rec_test1, ["a()","b()","a()|b()","d()","f()","deeplist()", "mylist(float())","aa()","bb()","expc()"]}, {rec_test2, ["a()","expa()","rec()"]}]. impossible_recursive_native_types() -> [{rec_test1, ["c()","e()","cc()","#rec{}","expb()"]}, {rec_test2, ["b()","#rec{}","aa()"]}]. symb_calls() -> [{[3,2,1], "lists:reverse([1,2,3])", [], {call,lists,reverse,[[1,2,3]]}}, {[a,b,c,d], "erlang:'++'([a,b],[c,d])", [{a,some_value}], {call,erlang,'++',[[a,b],[c,d]]}}, {42, "erlang:'*'(erlang:'+'(3,3),erlang:'-'(8,1))", [{b,dummy_value},{e,another_dummy}], {call,erlang,'*',[{call,erlang,'+',[3,3]},{call,erlang,'-',[8,1]}]}}, {something, "something", [{a,somebody},{b,put},{c,something},{d,in_my_drink}], {var,c}}, {{var,b}, "{var,b}", [{a,not_this},{c,neither_this}], {var,b}}, {42, "erlang:'+'(40,2)", [{m,40},{n,2}], {call,erlang,'+',[{var,m},{var,n}]}}, {[i,am,{var,iron},man], "erlang:'++'(lists:reverse([am,i]),erlang:'++'([{var,iron}],[man]))", [{a,man},{b,woman}], {call,erlang,'++',[{call,lists,reverse,[[am,i]]}, {call,erlang,'++',[[{var,iron}],[{var,a}]]}]}}]. undefined_symb_calls() -> [{call,erlang,error,[an_error]}, {call,erlang,throw,[a_throw]}, {call,erlang,exit,[an_exit]}, {call,lists,reverse,[<<12,13>>]}, {call,erlang,'+',[1,2,3]}]. combinations() -> [{[{1,[1,3,5,7,9,10]}, {2,[2,4,6,8,11]}], 5, 11, [1,2,3,4,5,6,7,8,9,10,11], 2, 2, [{1,[1,3,5,7,8,11]}, {2,[2,4,6,9,10]}]}, {[{1,[1,3,5]}, {2,[7,8,9]}, {3,[2,4,6]}], 3, 9, [1,3,5,7,8,9], 3, 2, [{1,[6,8,9]}, {2,[1,3,5]}, {3,[2,4,7]}]}]. first_comb() -> [{10,3,3,[{1,[7,8,9,10]}, {2,[4,5,6]}, {3,[1,2,3]}]}, {11,5,2,[{1,[6,7,8,9,10,11]}, {2,[1,2,3,4,5]}]}, {12,3,4,[{1,[10,11,12]}, {2,[7,8,9]}, {3,[4,5,6]}, {4,[1,2,3]}]}]. lists_to_zip() -> [{[],[],[]}, {[], [dummy, atom], []}, {[1, 42, 1, 42, 1, 2 ,3], [], []}, {[a, b, c], lists:seq(1,6), [{a,1}, {b,2}, {c,3}]}, {[a, b, c], lists:seq(1,3), [{a,1}, {b,2}, {c,3}]}, {[a, d, d, d, d], lists:seq(1,3), [{a,1}, {d,2}, {d,3}]}]. command_names() -> [{[{set,{var,1},{call,erlang,put,[a,0]}}, {set,{var,3},{call,erlang,erase,[a]}}, {set,{var,4},{call,erlang,get,[b]}}], [{erlang,put,2}, {erlang,erase,1}, {erlang,get,1}]}, {[{set,{var,1},{call,foo,bar,[]}}, {set,{var,2},{call,bar,foo,[a,{var,1}]}}, {set,{var,3},{call,bar,foo,[a,[[3,4]]]}}], [{foo,bar,0}, {bar,foo,2}, {bar,foo,2}]}, {[],[]}]. valid_command_sequences() -> %% {module, initial_state, command_sequence, symbolic_state_after, %% dynamic_state_after,initial_environment} [{pdict_statem, [], [{init,[]}, {set,{var,1},{call,erlang,put,[a,0]}}, {set,{var,2},{call,erlang,put,[b,1]}}, {set,{var,3},{call,erlang,erase,[a]}}, {set,{var,4},{call,erlang,get,[b]}}, {set,{var,5},{call,erlang,erase,[b]}}, {set,{var,6},{call,erlang,put,[a,4]}}, {set,{var,7},{call,erlang,put,[a,42]}}], [{a,42}], [{a,42}], []}, {pdict_statem, [], [{init,[]}, {set,{var,1},{call,erlang,put,[b,5]}}, {set,{var,2},{call,erlang,erase,[b]}}, {set,{var,3},{call,erlang,put,[a,5]}}], [{a,5}], [{a,5}], []}, {pdict_statem, [], [{init,[]}, {set,{var,1},{call,erlang,put,[a,{var,start_value}]}}, {set,{var,2},{call,erlang,put,[b,{var,another_start_value}]}}, {set,{var,3},{call,erlang,get,[b]}}, {set,{var,4},{call,erlang,get,[b]}}], [{b,{var,another_start_value}}, {a,{var,start_value}}], [{b,-1}, {a, 0}], [{start_value, 0}, {another_start_value, -1}]}]. symbolic_init_invalid_sequences() -> %% {module, command_sequence, environment, shrunk} [{pdict_statem, [{init,[{a,{call,foo,bar,[some_arg]}}]}, {set,{var,1},{call,erlang,put,[b,42]}}, {set,{var,2},{call,erlang,get,[b]}}], [{some_arg, 0}], [{init,[{a,{call,foo,bar,[some_arg]}}]}]}]. invalid_precondition() -> %% {module, command_sequence, environment, shrunk} [{pdict_statem, [{init,[]}, {set,{var,1},{call,erlang,put,[a,0]}}, {set,{var,2},{call,erlang,put,[b,1]}}, {set,{var,3},{call,erlang,erase,[a]}}, {set,{var,4},{call,erlang,get,[a]}}], [], [{set,{var,4},{call,erlang,get,[a]}}]}]. invalid_var() -> [{pdict_statem, [{init,[]}, {set,{var,2},{call,erlang,put,[b,{var,1}]}}]}, {pdict_statem, [{init,[]}, {set,{var,1},{call,erlang,put,[b,9]}}, {set,{var,5},{call,erlang,put,[a,3]}}, {set,{var,6},{call,erlang,get,[{var,2}]}}]}]. arguments_not_defined() -> [{[simple,atoms,are,valid,{var,42}], []}, {[{var,1}], [{var,2},{var,3},{var,4}]}, {[hello,world,[hello,world,{var,6}]], []}, {[{1,2,3,{var,1},{var,2}},not_really], []}, {[[[[42,{var,42}]]]], []}, {[{43,41,{1,{var,42}}},why_not], []}]. all_data() -> [1, 42.0, "$hello", "world\n", [smelly, cat, {smells,bad}], '$this_should_be_copied', '$this_one_too', 'but$ this$ not', or_this]. dollar_data() -> ['$this_should_be_copied', '$this_one_too']. %%------------------------------------------------------------------------------ %% Unit tests %%------------------------------------------------------------------------------ %% TODO: write tests for old datatypes, use old tests %% TODO: check output redirection, quiet, verbose, to_file, on_output/2 (maybe %% by writing to a string in the process dictionary), statistics printing, %% standard verbose behaviour %% TODO: fix compiler warnings %% TODO: LET and LETSHRINK testing (these need their intermediate form for %% standalone instance testing and shrinking) - update needed after %% fixing the internal shrinking in LETs, use recursive datatypes, like %% trees, for testing, also test with noshrink and LAZY %% TODO: use size=100 for is_instance testing? %% TODO: typeserver: check that the same type is returned for consecutive calls, %% even with no caching (no_caching option?) %% TODO: typeserver: recursive types containing functions %% TODO: ?LET, ?LETSHRINK: only the top-level base type can be a native type %% TODO: Test with native types: ?SUCHTHATMAYBE, noshrink, ?LAZY, ?SHRINK, %% resize, ?SIZED %% TODO: no debug_info at compile time => call, not type %% no debug_info at runtime => won't find type %% no module in code path at runtime => won't find type %% TODO: try some more expressions with a ?FORALL underneath %% TODO: various constructors like '|' (+ record notation) are parser-rejected %% TODO: test nonempty recursive lists %% TODO: test list-recursive with instances %% TODO: more ADT tests: check bad declarations, bad variable use, multi-clause, %% is_subtype, unacceptable range, unexported opaque, no-specs opaque, %% unexported/unspecced functions, unbound variables, check as constructed %% TODO: module, check_spec, check_module_specs, retest_spec (long result mode %% too, other options pass) %% TODO: proper_typeserver:is_instance (with existing types too, plus types we %% can't produce, such as impropers) (also check that everything we %% produce based on a type is an instance) %% TODO: check that functions that throw exceptions pass %% TODO: property inside a ?TIMEOUT returning false %% TODO: some branch of a ?FORALL has a collect while another doesn't %% TODO: symbolic functions returning functions are evaluated? %% TODO: pure_check %% TODO: spec_timeout option %% TODO: defined option precedence %% TODO: conversion of maybe_improper_list %% TODO: use demo_is_instance and demo_translate_type %% TODO: debug option to output tests passed, fail reason, etc. %% TODO: test expected distribution of random functions simple_types_test_() -> [?_test(assert_type_works(TD, true)) || TD <- simple_types_with_data()]. constructed_types_test_() -> [?_test(assert_type_works(TD, false)) || TD <- constructed_types_with_data()]. %% TODO: specific test-starting instances would be useful here %% (start from valid Xs) shrinks_to_test_() -> [?_shrinksTo(Target, Type) || {Type,_Xs,Target,_Ys,_TypeStr} <- simple_types_with_data() ++ constructed_types_with_data(), Type =/= none]. native_shrinks_to_test_() -> [?_nativeShrinksTo(Target, TypeStr) || {_Type,_Xs,Target,_Ys,TypeStr} <- simple_types_with_data() ++ constructed_types_with_data(), TypeStr =/= none]. cant_generate_test_() -> [?_test(assert_cant_generate(Type)) || Type <- impossible_types()]. native_cant_translate_test_() -> [?_test(assert_cant_translate(Mod,TypeStr)) || {Mod,Strings} <- impossible_native_types(), TypeStr <- Strings]. remote_native_types_test_() -> [?_test(assert_can_translate(Mod,TypeStr)) || {Mod,Strings} <- remote_native_types(), TypeStr <- Strings]. recursive_native_types_test_() -> [?_test(assert_native_can_generate(Mod,TypeStr,false)) || {Mod,Strings} <- recursive_native_types(), TypeStr <- Strings]. recursive_native_cant_translate_test_() -> [?_test(assert_cant_translate(Mod,TypeStr)) || {Mod,Strings} <- impossible_recursive_native_types(), TypeStr <- Strings]. random_functions_test_() -> [[?_test(assert_function_type_works(FunType)), ?_test(assert_function_type_works(assert_can_translate(proper,TypeStr)))] || {FunType,TypeStr} <- function_types()]. parse_transform_test_() -> [?_passes(auto_export_test1:prop_1()), ?_assertError(undef, auto_export_test2:prop_1()), ?_assertError(undef, no_native_parse_test:prop_1()), ?_assertError(undef, no_out_of_forall_test:prop_1())]. native_type_props_test_() -> [?_passes(?FORALL({X,Y}, {my_native_type(),my_proper_type()}, is_integer(X) andalso is_atom(Y))), ?_passes(?FORALL([X,Y,Z], [my_native_type(),my_proper_type(),my_native_type()], is_integer(X) andalso is_atom(Y) andalso is_integer(Z))), ?_passes(?FORALL([Y,X,{Z,W}], [my_proper_type() | [my_native_type()]] ++ [{my_native_type(),my_proper_type()}], is_integer(X) andalso is_atom(Y) andalso is_integer(Z) andalso is_atom(W))), ?_passes(?FORALL([X|Y], [my_native_type()|my_native_type()], is_integer(X) andalso is_integer(Y))), ?_passes(?FORALL(X, type_and_fun(), is_atom(X))), ?_passes(?FORALL(X, type_only(), is_integer(X))), ?_passes(?FORALL(L, [integer()], length(L) =:= 1)), ?_fails(?FORALL(L, id([integer()]), length(L) =:= 1)), ?_passes(?FORALL(_, types_test1:exp1(), true)), ?_assertError(undef, ?FORALL(_,types_test1:rec1(),true)), ?_assertError(undef, ?FORALL(_,no_such_module:some_call(),true)), {setup, fun() -> code:purge(to_remove), code:delete(to_remove), code:purge(to_remove), file:rename("tests/to_remove.beam", "tests/to_remove.bak") end, fun(_) -> file:rename("tests/to_remove.bak", "tests/to_remove.beam") end, ?_passes(?FORALL(_, to_remove:exp1(), true))}, ?_passes(rec_props_test1:prop_1()), ?_passes(rec_props_test2:prop_2()), ?_passes(?FORALL(L, vector(2,my_native_type()), length(L) =:= 2 andalso lists:all(fun erlang:is_integer/1, L))), ?_passes(?FORALL(F, function(0,my_native_type()), is_integer(F()))), ?_passes(?FORALL(X, union([my_proper_type(),my_native_type()]), is_integer(X) orelse is_atom(X))), ?_assertError(undef, begin Vector5 = fun(T) -> vector(5,T) end, ?FORALL(V, Vector5(types_test1:exp1()), length(V) =:= 5) end), ?_passes(?FORALL(X, ?SUCHTHAT(Y,types_test1:exp1(),is_atom(Y)), is_atom(X))), ?_passes(?FORALL(L,non_empty(lof()),length(L) > 0)), ?_passes(?FORALL(X, ?LET(L,lof(),lists:min([99999.9|L])), is_float(X))), ?_shrinksTo(0, ?LETSHRINK([X],[my_native_type()],{'tag',X})), ?_passes(weird_types:prop_export_all_works()), ?_passes(weird_types:prop_no_auto_import_works()), ?_passes(?FORALL(B, utf8(), unicode:characters_to_binary(B) =:= B)), ?_passes(?FORALL(B, utf8(1), length(unicode:characters_to_list(B)) =< 1)), ?_passes(?FORALL(B, utf8(1, 1), size(B) =< 1)), ?_passes(?FORALL(B, utf8(2, 1), size(B) =< 2)), ?_passes(?FORALL(B, utf8(4), size(B) =< 16)), ?_passes(?FORALL(B, utf8(), length(unicode:characters_to_list(B)) =< size(B))) ]. -type bin4() :: <<_:32>>. -type bits42() :: <<_:42>>. -type bits5x() :: <<_:_*5>>. -type bits7x() :: <<_:_*7>>. -record(untyped, {a, b = 12}). -type untyped() :: #untyped{}. true_props_test_() -> [?_passes(?FORALL(X,integer(),X < X + 1)), ?_passes(?FORALL(A,atom(),list_to_atom(atom_to_list(A)) =:= A)), ?_passes(?FORALL(B,bin4(),byte_size(B) =:= 4)), ?_passes(?FORALL(B,bits42(),bit_size(B) =:= 42)), ?_passes(?FORALL(B,bits5x(),bit_size(B) =/= 42)), ?_passes(?FORALL(B,bits7x(),bit_size(B) rem 7 =:= 0)), ?_passes(?FORALL(L,list(integer()),is_sorted(L,quicksort(L)))), ?_passes(?FORALL(L,ulist(integer()),is_sorted(L,lists:usort(L)))), ?_passes(?FORALL(L,non_empty(list(integer())),L =/= [])), ?_passes(?FORALL({I,L}, {integer(),list(integer())}, ?IMPLIES(no_duplicates(L), not lists:member(I,lists:delete(I,L))))), ?_passes(?FORALL(L, ?SIZED(Size,resize(Size div 5,list(integer()))), length(L) =< 20), [{max_size,100}]), %% TODO: check that the samples are collected correctly ?_passes(?FORALL(L, list(integer()), collect(length(L), collect(L =:= [], lists:reverse(lists:reverse(L)) =:= L)))), ?_passes(?FORALL(L, list(integer()), aggregate(smaller_lengths_than_my_own(L), true))), ?_assertTempBecomesN(300, true, numtests(300,?FORALL(_,1,begin inc_temp(),true end))), ?_assertTempBecomesN(30, true, ?FORALL(X, ?SIZED(Size,Size), begin inc_temp(X),true end), [{numtests,12},{max_size,4}]), ?_assertTempBecomesN(12, true, ?FORALL(X, ?SIZED(Size,Size), begin inc_temp(X),true end), [{numtests,3},{start_size,4},{max_size,4}]), ?_passes(?FORALL(X, integer(), ?IMPLIES(abs(X) > 1, X * X > X))), ?_passes(?FORALL(X, integer(), ?IMPLIES(X >= 0, true))), ?_passes(?FORALL({X,Lim}, {int(),?SIZED(Size,Size)}, abs(X) =< Lim)), ?_passes(?FORALL({X,Lim}, {nat(),?SIZED(Size,Size)}, X =< Lim)), ?_passes(?FORALL(L, orderedlist(integer()), is_sorted(L))), ?_passes(conjunction([ {one, ?FORALL(_, integer(), true)}, {two, ?FORALL(X, integer(), collect(X > 0, true))}, {three, conjunction([{a,true},{b,true}])} ])), ?_passes(?FORALL(X, untyped(), is_record(X, untyped))), ?_passes(pdict_statem:prop_pdict()), ?_passes(symb_statem:prop_simple()), {timeout, 20, ?_passes(symb_statem:prop_parallel_simple())}, {timeout, 10, ?_passes(ets_statem:prop_ets())}, {timeout, 20, ?_passes(ets_statem:prop_parallel_ets())}, {timeout, 20, ?_passes(pdict_fsm:prop_pdict())}]. false_props_test_() -> [?_failsWith([[_Same,_Same]], ?FORALL(L,list(integer()),is_sorted(L,lists:usort(L)))), ?_failsWith([[_Same,_Same],_Same], ?FORALL(L, non_empty(list(union([a,b,c,d]))), ?FORALL(X, elements(L), not lists:member(X,lists:delete(X,L))))), ?_failsWith(['\000\000\000\000'], ?FORALL(A, atom(), length(atom_to_list(A)) < 4)), %% TODO: check that these only run once ?_failsWith([1], ?FORALL(X, non_neg_integer(), case X > 0 of true -> throw(not_zero); false -> true end)), ?_fails(?FORALL(_,1,lists:min([]) > 0)), ?_failsWith([[12,42]], ?FORALL(L, [12,42|list(integer())], case lists:member(42, L) of true -> erlang:exit(you_got_it); false -> true end)), ?_fails(?FORALL(_, integer(), ?TIMEOUT(100,timer:sleep(150) =:= ok))), ?_failsWith([20], ?FORALL(X, pos_integer(), ?TRAPEXIT(creator(X) =:= ok))), ?_assertTempBecomesN(7, false, ?FORALL(X, ?SIZED(Size,integer(Size,Size)), begin inc_temp(), X < 5 end), [{numtests,5}, {max_size,5}]), %% it runs 2 more times: one while shrinking (recursing into the property) %% and one when the minimal input is rechecked ?_assertTempBecomesN(2, false, ?FORALL(L, list(atom()), ?WHENFAIL(inc_temp(),length(L) < 5))), ?_assertTempBecomesN(3, false, ?FORALL(S, ?SIZED(Size,Size), begin inc_temp(), S =< 20 end), [{numtests,3},{max_size,40},noshrink]), ?_failsWithOneOf([[{true,false}],[{false,true}]], ?FORALL({B1,B2}, {boolean(),boolean()}, equals(B1,B2))), ?_failsWith([2,1], ?FORALL(X, integer(1,10), ?FORALL(Y, integer(1,10), X =< Y))), ?_failsWith([1,2], ?FORALL(Y, integer(1,10), ?FORALL(X, integer(1,10), X =< Y))), ?_failsWithOneOf([[[0,1]],[[0,-1]],[[1,0]],[[-1,0]]], ?FORALL(L, list(integer()), lists:reverse(L) =:= L)), ?_failsWith([[1,2,3,4,5,6,7,8,9,10]], ?FORALL(_L, shuffle(lists:seq(1,10)), false)), %% TODO: check that these don't shrink ?_fails(?FORALL(_, integer(0,0), false)), ?_fails(?FORALL(_, float(0.0,0.0), false)), ?_fails(fails(?FORALL(_, integer(), false))), ?_failsWith([16], ?FORALL(X, ?LET(Y,integer(),Y*Y), X < 15)), ?_failsWith([0.0], ?FORALL(_, ?LETSHRINK([A,B], [float(),atom()], {A,B}), false)), ?_failsWith([], conjunction([{some,true},{thing,false}])), ?_failsWith([{2,1},[{group,[[{sub_group,[1]}]]},{stupid,[1]}]], ?FORALL({X,Y}, {pos_integer(),pos_integer()}, conjunction([ {add_next, ?IMPLIES(X > Y, X + 1 > Y)}, {symmetry, conjunction([ {add_sym, collect(X+Y, X+Y =:= Y+X)}, {sub_sym, ?WHENFAIL(io:format("'-' isn't symmetric!~n",[]), X-Y =:= Y-X)} ])}, {group, conjunction([ {add_group, ?WHENFAIL(io:format("This shouldn't happen!~n",[]), ?FORALL(Z, pos_integer(), (X+Y)+Z =:= X+(Y+Z)))}, {sub_group, ?WHENFAIL(io:format("'-' doesn't group!~n",[]), ?FORALL(W, pos_integer(), (X-Y)-W =:= X-(Y-W)))} ])}, {stupid, ?FORALL(_, pos_integer(), throw(woot))} ]))), {timeout, 20, ?_fails(ets_counter:prop_ets_counter())}, ?_fails(post_false:prop_simple()), ?_fails(error_statem:prop_simple())]. error_props_test_() -> [?_errorsOut(cant_generate, ?FORALL(_, ?SUCHTHAT(X, pos_integer(), X =< 0), true)), ?_errorsOut(cant_satisfy, ?FORALL(X, pos_integer(), ?IMPLIES(X =< 0, true))), ?_errorsOut(type_mismatch, ?FORALL({X,Y}, [integer(),integer()], X < Y)), ?_assertCheck({error,rejected}, [2], ?FORALL(X, integer(), ?IMPLIES(X > 5, X < 6))), ?_assertCheck({error,too_many_instances}, [1,ab], ?FORALL(X, pos_integer(), X < 0)), ?_errorsOut(cant_generate, prec_false:prop_simple()), ?_errorsOut(cant_generate, nogen_statem:prop_simple()), ?_errorsOut(non_boolean_result, ?FORALL(_, integer(), not_a_boolean)), ?_errorsOut(non_boolean_result, ?FORALL(_, ?SHRINK(42,[0]), non_deterministic([{2,false},{1,not_a_boolean}]))), ?_assertRun(false, ?FORALL(_, ?SHRINK(42,[0]), non_deterministic([{4,false},{1,true}])), [], false), ?_assertRun(false, ?FORALL(_, ?SHRINK(42,[0]), non_deterministic([{3,false},{1,true},{1,false}])), [], false), ?_assertRun(false, ?FORALL(_, ?LAZY(non_deterministic([{1,1},{1,2},{1,3},{1,4}])), false), [], false)]. eval_test_() -> [?_assertEqual(Result, eval(Vars,SymbCall)) || {Result,_Repr,Vars,SymbCall} <- symb_calls()]. pretty_print_test_() -> [?_assert(equal_ignoring_ws(Repr, proper_symb:pretty_print(Vars,SymbCall))) || {_Result,Repr,Vars,SymbCall} <- symb_calls()]. not_defined_test_() -> [?_assertNot(defined(SymbCall)) || SymbCall <- undefined_symb_calls()]. options_test_() -> [?_assertTempBecomesN(300, true, ?FORALL(_, 1, begin inc_temp(), true end), [{numtests,300}]), ?_assertTempBecomesN(300, true, ?FORALL(_, 1, begin inc_temp(), true end), [300]), ?_failsWith([42], ?FORALL(_,?SHRINK(42,[0,1]),false), [noshrink]), ?_failsWith([42], ?FORALL(_,?SHRINK(42,[0,1]),false), [{max_shrinks,0}]), ?_fails(?FORALL(_,integer(),false), [fails]), ?_assertRun({error,cant_generate}, ?FORALL(_,?SUCHTHAT(X,pos_integer(),X > 0),true), [{constraint_tries,0}], true), ?_failsWith([12], ?FORALL(_,?SIZED(Size,integer(Size,Size)),false), [{start_size,12}])]. adts_test_() -> [{timeout, 20, % for Kostis' old laptop ?_passes(?FORALL({X,S},{integer(),set()}, sets:is_element(X,sets:add_element(X,S))), [20])}, ?_passes(?FORALL({X,Y,D}, {integer(),float(),dict(integer(),float())}, dict:fetch(X,dict:store(X,Y,eval(D))) =:= Y), [30]), ?_fails(?FORALL({X,D}, {boolean(),dict(boolean(),integer())}, dict:erase(X, dict:store(X,42,D)) =:= D))]. parameter_test_() -> ?_passes(?FORALL(List, [zero1(),zero2(),zero3(),zero4()], begin [?assertMatch(undefined, proper_types:parameter(P)) || P <- [x1,x2,y2,x3,y3,x4,y4,v,w,z]], lists:all(fun is_zero/1, List) end)). zip_test_() -> [?_assertEqual(proper_statem:zip(X, Y), Expected) || {X,Y,Expected} <- lists_to_zip()]. command_names_test_() -> [?_assertEqual(proper_statem:command_names(Cmds), Expected) || {Cmds,Expected} <- command_names()]. command_names_parallel1_test_() -> [?_assertEqual(proper_statem:command_names({Cmds,[]}), Expected) || {Cmds,Expected} <- command_names()]. command_names_parallel2_test_() -> [?_assertEqual(proper_statem:command_names({[],[Cmds]}), Expected) || {Cmds,Expected} <- command_names()]. command_names_parallel3_test_() -> [?_assertEqual(proper_statem:command_names({Cmds,[Cmds]}), Expected++Expected) || {Cmds,Expected} <- command_names()]. command_names_parallel4_test_() -> [?_assertEqual(proper_statem:command_names({Cmds,[Cmds,Cmds]}), Expected++Expected++Expected) || {Cmds,Expected} <- command_names()]. valid_cmds_test_() -> [?_assert(proper_statem:is_valid(Mod, State, Cmds, Env)) || {Mod,State,Cmds,_,_,Env} <- valid_command_sequences()]. invalid_cmds_test_() -> [?_assertNot(proper_statem:is_valid(Mod, Mod:initial_state(), Cmds, [])) || {Mod,Cmds,_,_} <- invalid_precondition()] ++ [?_assertNot(proper_statem:is_valid(Mod, Mod:initial_state(), Cmds, [])) || {Mod,Cmds} <- invalid_var()]. state_after_test_() -> [?_assertEqual(proper_statem:state_after(Mod, Cmds), StateAfter) || {Mod,_,Cmds,StateAfter,_,_} <- valid_command_sequences()]. cannot_generate_commands_test_() -> [?_test(assert_cant_generate_cmds(proper_statem:commands(Mod), 6)) || Mod <- [prec_false]]. can_generate_commands0_test_() -> [?_test(assert_can_generate(proper_statem:commands(Mod), false)) || Mod <- [pdict_statem]]. can_generate_commands1_test_() -> [?_test(assert_can_generate(proper_statem:commands(Mod, StartState), false)) || {Mod,StartState} <- [{pdict_statem,[{a,1},{b,1},{c,100}]}]]. can_generate_parallel_commands0_test_() -> {timeout, 20, [?_test(assert_can_generate(proper_statem:parallel_commands(Mod), false)) || Mod <- [ets_counter]]}. can_generate_parallel_commands1_test_() -> {timeout, 20, [?_test(assert_can_generate( proper_statem:parallel_commands(Mod, Mod:initial_state()), false)) || Mod <- [ets_counter]]}. seeded_runs_return_same_result_test_() -> [?_test(assert_seeded_runs_return_same_result(proper_statem:commands(Mod))) || Mod <- [pdict_statem]]. run_valid_commands_test_() -> [?_assertMatch({_H,DynState,ok}, setup_run_commands(Mod, Cmds, Env)) || {Mod,_,Cmds,_,DynState,Env} <- valid_command_sequences()]. run_invalid_precondition_test_() -> [?_assertMatch({_H,_S,{precondition,false}}, setup_run_commands(Mod, Cmds, Env)) || {Mod,Cmds,Env,_Shrunk} <- invalid_precondition()]. run_init_error_test_() -> [?_assertMatch({_H,_S,initialization_error}, setup_run_commands(Mod, Cmds, Env)) || {Mod,Cmds,Env,_Shrunk} <- symbolic_init_invalid_sequences()]. run_postcondition_false_test() -> ?_assertMatch({_H,_S,{postcondition,false}}, run_commands(post_false, proper_statem:commands(post_false))). run_exception_test() -> ?_assertMatch( {_H,_S,{exception,throw,badarg,_}}, run_commands(post_false, proper_statem:commands(error_statem))). get_next_test_() -> [?_assertEqual(Expected, proper_statem:get_next(L, Len, MaxIndex, Available, W, N)) || {L, Len, MaxIndex, Available, W, N, Expected} <- combinations()]. mk_first_comb_test_() -> [?_assertEqual(Expected, proper_statem:mk_first_comb(N, Len, W)) || {N, Len, W, Expected} <- first_comb()]. args_not_defined_test() -> [?_assertNot(proper_statem:args_defined(Args, SymbEnv)) || {Args, SymbEnv} <- arguments_not_defined()]. command_props_test_() -> {timeout, 150, [?_assertEqual([], proper:module(command_props))]}. %% TODO: is_instance check fails because of ?LET in fsm_commands/1? can_generate_fsm_commands_test_() -> [?_test(assert_can_generate(proper_fsm:commands(Mod), false)) || Mod <- [pdict_fsm, numbers_fsm]]. transition_target_test_() -> {timeout, 20, [?_assertEqual([], proper:module(numbers_fsm))]}. dollar_only_cp_test_() -> ?_assertEqual( dollar_data(), [K || K <- all_data(), is_atom(K), re:run(atom_to_list(K), ["^[$]"], [{capture,none}]) =:= match]). %%------------------------------------------------------------------------------ %% Performance tests %%------------------------------------------------------------------------------ max_size_test() -> %% issue a call to load the test module and ensure the test exists ?assert(lists:member({prop_identity,0}, perf_max_size:module_info(exports))), %% run some tests with a small and a big max_size option {Ts,true} = timer:tc(fun() -> max_size_test_aux(42) end), {Tb,true} = timer:tc(fun() -> max_size_test_aux(16#ffffffff) end), %% ensure that the test with the big max_size option does not take %% much longer than the small one to complete ?assert(2*Ts >= Tb). max_size_test_aux(Size) -> proper:quickcheck(perf_max_size:prop_identity(), [5,{max_size,Size}]). %%------------------------------------------------------------------------------ %% Helper Predicates %%------------------------------------------------------------------------------ no_duplicates(L) -> length(lists:usort(L)) =:= length(L). is_sorted([]) -> true; is_sorted([_]) -> true; is_sorted([A | [B|_] = T]) when A =< B -> is_sorted(T); is_sorted(_) -> false. same_elements(L1, L2) -> length(L1) =:= length(L2) andalso same_elems(L1, L2). same_elems([], []) -> true; same_elems([H|T], L) -> lists:member(H, L) andalso same_elems(T, lists:delete(H, L)); same_elems(_, _) -> false. is_sorted(Old, New) -> same_elements(Old, New) andalso is_sorted(New). equal_ignoring_ws(Str1, Str2) -> WhiteSpace = [32,9,10], equal_ignoring_chars(Str1, Str2, WhiteSpace). equal_ignoring_chars([], [], _Ignore) -> true; equal_ignoring_chars([_SameChar|Rest1], [_SameChar|Rest2], Ignore) -> equal_ignoring_chars(Rest1, Rest2, Ignore); equal_ignoring_chars([Char1|Rest1] = Str1, [Char2|Rest2] = Str2, Ignore) -> case lists:member(Char1, Ignore) of true -> equal_ignoring_chars(Rest1, Str2, Ignore); false -> case lists:member(Char2, Ignore) of true -> equal_ignoring_chars(Str1, Rest2, Ignore); false -> false end end. smaller_lengths_than_my_own(L) -> lists:seq(0, length(L)). is_zero(X) -> X =:= 0. %%------------------------------------------------------------------------------ %% Functions to test %%------------------------------------------------------------------------------ partition(Pivot, List) -> partition_tr(Pivot, List, [], []). partition_tr(_Pivot, [], Lower, Higher) -> {Lower, Higher}; partition_tr(Pivot, [H|T], Lower, Higher) -> if H =< Pivot -> partition_tr(Pivot, T, [H|Lower], Higher); H > Pivot -> partition_tr(Pivot, T, Lower, [H|Higher]) end. quicksort([]) -> []; quicksort([H|T]) -> {Lower, Higher} = partition(H, T), quicksort(Lower) ++ [H] ++ quicksort(Higher). creator(X) -> Self = self(), spawn_link(fun() -> destroyer(X,Self) end), receive _ -> ok end. destroyer(X, Father) -> if X < 20 -> Father ! not_yet; true -> exit(this_is_the_end) end. %%------------------------------------------------------------------------------ %% Datatypes to test %%------------------------------------------------------------------------------ %% TODO: remove this if you make 'shuffle' a default constructor shuffle([]) -> []; shuffle(L) -> ?LET(X, elements(L), [X | shuffle(lists:delete(X,L))]). ulist(ElemType) -> ?LET(L, list(ElemType), L--(L--lists:usort(L))). zerostream(ExpectedMeanLen) -> ?LAZY(frequency([ {1, []}, {ExpectedMeanLen, [0 | zerostream(ExpectedMeanLen)]} ])). -type my_native_type() :: integer(). my_proper_type() -> atom(). -type type_and_fun() :: integer(). type_and_fun() -> atom(). -type type_only() :: integer(). -type id(X) :: X. -type lof() :: [float()]. -type deeplist() :: [deeplist()]. deeplist() -> ?SIZED(Size, deeplist(Size)). deeplist(0) -> []; deeplist(Size) -> ?LAZY(proper_types:distlist(Size, fun deeplist/1, false)). -type tree(T) :: 'null' | {'node',T,tree(T),tree(T)}. tree(ElemType) -> ?SIZED(Size, tree(ElemType,Size)). tree(_ElemType, 0) -> null; tree(ElemType, Size) -> LeftTree = tree(ElemType, Size div 2), RightTree = tree(ElemType, Size div 2), frequency([ {1, tree(ElemType,0)}, {5, ?LETSHRINK([L,R], [LeftTree,RightTree], {node,ElemType,L,R})} ]). -type a() :: 'aleaf' | {'anode',a(),b()}. -type b() :: 'bleaf' | {'bnode',a(),b()}. a() -> ?SIZED(Size, a(Size)). a(0) -> aleaf; a(Size) -> union([ ?LAZY(a(0)), ?LAZY(?LETSHRINK([A], [a(Size div 2)], {anode,A,b(Size)})) ]). b() -> ?SIZED(Size, b(Size)). b(0) -> bleaf; b(Size) -> union([ ?LAZY(b(0)), ?LAZY(?LETSHRINK([B], [b(Size div 2)], {bnode,a(Size),B})) ]). -type gen_tree(T) :: 'null' | {T,[gen_tree(T),...]}. gen_tree(ElemType) -> ?SIZED(Size, gen_tree(ElemType,Size)). gen_tree(_ElemType, 0) -> null; gen_tree(ElemType, Size) -> SubGen = fun(S) -> gen_tree(ElemType,S) end, oneof([ ?LAZY(gen_tree(ElemType,0)), ?LAZY(?LETSHRINK(Children, proper_types:distlist(Size, SubGen, true), {ElemType,Children})) ]). -type g() :: 'null' | {'tag',[g()]}. -type h() :: 'null' | {'tag',[{'ok',h()}]}. -type i() :: 'null' | {'tag',i(),[i()]}. -type j() :: 'null' | {'one',j()} | {'tag',j(),j(),[j()],[j()]}. -type k() :: 'null' | {'tag',[{k(),k()}]}. -type l() :: 'null' | {'tag',l(),[l(),...]}. zero1() -> proper_types:with_parameter( x1, 0, ?SUCHTHAT(I, range(-1, 1), I =:= proper_types:parameter(x1))). zero2() -> proper_types:with_parameters( [{x2,41}], ?LET(X, proper_types:with_parameter( y2, 43, ?SUCHTHAT( I, range(41, 43), I > proper_types:parameter(x2) andalso I < proper_types:parameter(y2))), X - 42)). zero3() -> ?SUCHTHAT(I, range(-1, 1), I > proper_types:parameter(x3, -1) andalso I < proper_types:parameter(y3, 1)). zero4() -> proper_types:with_parameters( [{x4,-2}, {y4,2}], proper_types:with_parameters( [{x4,-1}, {y4,1}], ?SUCHTHAT(I, range(-1, 1), I > proper_types:parameter(x4) andalso I < proper_types:parameter(y4)))). %%------------------------------------------------------------------------------ %% Old Tests and datatypes %%------------------------------------------------------------------------------ % nelist(ElemType) -> % [ElemType | list(ElemType)]. % % uvector(0, _ElemType) -> % []; % uvector(N, ElemType) -> % ?LET(Rest, % uvector(N-1, ElemType), % ?LET(Elem, % ?SUCHTHAT(E, ElemType, not lists:member(E,Rest)), % [Elem | Rest])). % % subset(Generators) -> % ?LET(Keep, % [{boolean(),G} || G <- Generators], % [G || {true,G} <- Keep]). % % unique(ElemTypes) -> % ?LET(Values, % list(ElemTypes), % lists:usort(Values)). % % ulist2(ElemType) -> % ?SUCHTHAT(L, list(ElemType), no_duplicates(L)). % % kvlist(KeyType, ValueType) -> % ?LET(Keys, % list(KeyType), % [{K,ValueType} || K <- Keys]). % % tree_member(_X, {node,_X,_L,_R}) -> true; % tree_member(X, {node,_Y,L,R}) -> tree_member(X, L) orelse tree_member(X, R); % tree_member(_X, {empty}) -> false. % % symbdict(KeyType, ValueType) -> % ?SIZED(Size, symbdict(Size, KeyType, ValueType)). % % symbdict(0, _KeyType, _ValueType) -> % {call,dict,new,[]}; % symbdict(Size, KeyType, ValueType) -> % ?LAZY( % frequency([ % {1,symbdict(0, KeyType, ValueType)}, % {4,?LETSHRINK([Smaller], [symbdict(Size - 1, KeyType, ValueType)], % {call, dict, append,[KeyType,ValueType,Smaller]})} % ]) % ). % % test(15) -> % ?FORALL(T, % ?LET(L, % non_empty(list(integer())), % ?LET(Y, % elements(L), % {Y,L})), % erlang:element(1,T) =/= 42); % test(18) -> % ?FORALL(L, kvlist(atom(),integer()), not lists:keymember(42,2,L)); % test(19) -> % ?FORALL(T, tree(integer()), not tree_member(42, T)); % test(20) -> % ?FORALL(X, % ?LET(L, non_empty(list(integer())), list(oneof(L))), % length(X) < 10); % test(27) -> % ?FORALL(SD, % symbdict(integer(),integer()), % not dict:is_key(42, eval(SD))); % test(29) -> % ?FORALL({F,L}, % {function(1,integer(1,100)), list(integer())}, % lists:all(fun(X) -> F(X) =/= 42 end, L)); % correct_smaller_length_aggregation(Tests, SmallerLens) -> % {Zeros,Larger} = lists:partition(fun(X) -> X =:= 0 end, SmallerLens), % length(Zeros) =:= Tests % andalso correct_smaller_length_aggregation(Tests, Larger, 1). % % correct_smaller_length_aggregation(0, SmallerLens, _Len) -> % SmallerLens =:= []; % correct_smaller_length_aggregation(NotMoreThan, SmallerLens, Len) -> % {Lens,Larger} = lists:partition(fun(X) -> X =:= Len end, SmallerLens), % Num = length(Lens), % Num =< NotMoreThan % andalso correct_smaller_length_aggregation(Num, Larger, Len+1). erlang-proper-1.1+gitfa58f82bdc+dfsg/test/rec_props_test1.erl000066400000000000000000000024001255446327200241100ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc This module tests whether the parse transform can read module %%% information from source. -module(rec_props_test1). -export_type([exp1/0]). -include_lib("proper/include/proper.hrl"). -type exp1() :: integer(). prop_1() -> ?FORALL(_, rec_props_test2:exp2(), true). erlang-proper-1.1+gitfa58f82bdc+dfsg/test/rec_props_test2.erl000066400000000000000000000024001255446327200241110ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc This module tests whether the parse transform can read module %%% information from source. -module(rec_props_test2). -export_type([exp2/0]). -include_lib("proper/include/proper.hrl"). -type exp2() :: integer(). prop_2() -> ?FORALL(_, rec_props_test1:exp1(), true). erlang-proper-1.1+gitfa58f82bdc+dfsg/test/rec_test1.erl000066400000000000000000000032401255446327200226700ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc This module contains types for testing the typeserver. -module(rec_test1). -export_type([expb/0, expc/0]). -type a() :: 'aleaf' | b() | [{'rec',a()}] | c() | d(). -type b() :: 'bleaf' | {'bnode',b(),b()}. -type c() :: [c()] | {'cnode1',a()} | {'cnode2',d()}. -type d() :: [a()]. -type e() :: {'e','none' | e()}. -type f() :: {'f','none'} | {'f',f()}. -type deeplist() :: [deeplist()]. -type mylist(T) :: [] | {'cons',T,mylist(T)}. -type aa() :: {} | mylist(aa()). -type bb() :: mylist(integer()). -type cc() :: mylist(cc()). -record(rec, {a = 0 :: integer(), b = 'nil' :: 'nil' | #rec{}}). -opaque expb() :: {'a',rec_test2:expa()}. -type expc() :: 'c' | {'node',?MODULE:expc()}. erlang-proper-1.1+gitfa58f82bdc+dfsg/test/rec_test2.erl000066400000000000000000000025341255446327200226760ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc This module contains types for testing the typeserver. -module(rec_test2). -export_type([expa/0]). -type a() :: 'aleaf' | {'anode',b()}. -opaque b() :: {'bnode',b()} | a(). -type expa() :: 'a' | rec_test1:expb(). -record(rec, {a = 0 :: integer(), b = 'nil' :: 'nil' | #rec{}}). -type rec() :: #rec{b :: 'nil'} | #rec{b :: rec()}. -type aa() :: {aa(),aa()}. erlang-proper-1.1+gitfa58f82bdc+dfsg/test/symb_statem.erl000066400000000000000000000044741255446327200233400ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Eirini Arvaniti -module(symb_statem). -compile(export_all). -include_lib("proper/include/proper.hrl"). -record(state, {foo = [], bar = []}). initial_state() -> #state{}. command(_S) -> oneof([{call,?MODULE,foo,[integer()]}, {call,?MODULE,bar,[integer()]}]). precondition(_, _) -> true. next_state(S = #state{foo=Foo}, V, {call,_,foo,[_Arg]}) -> V1 = {call,erlang,element,[1,V]}, S#state{foo = [V1|Foo]}; next_state(S = #state{bar=Bar}, V, {call,_,bar,[_Arg]}) -> V1 = {call,erlang,hd,[V]}, S#state{foo = [V1|Bar]}. postcondition(S, {call,_,foo,[_Arg]}, Res) when is_tuple(Res) -> lists:all(fun is_integer/1, S#state.foo); postcondition(S, {call,_,bar,[_Arg]}, Res) when is_list(Res) -> lists:all(fun is_integer/1, S#state.bar); postcondition(_, _, _) -> false. foo(I) when is_integer(I) -> erlang:make_tuple(3, I). bar(I) when is_integer(I) -> lists:duplicate(3, I). prop_simple() -> ?FORALL(Cmds, commands(?MODULE), begin {H,S,Res} = run_commands(?MODULE, Cmds), ?WHENFAIL( io:format("H: ~w\nState: ~w\n:Res: ~w\n", [H,S,Res]), Res =:= ok) end). prop_parallel_simple() -> ?FORALL(Cmds, parallel_commands(?MODULE), begin {S,P,Res} = run_parallel_commands(?MODULE, Cmds), ?WHENFAIL( io:format("Seq: ~w\nParallel: ~w\n:Res: ~w\n", [S,P,Res]), Res =:= ok) end). erlang-proper-1.1+gitfa58f82bdc+dfsg/test/to_remove.erl000066400000000000000000000021771255446327200230060ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc This module tests whether the typeserver can read files from source. -module(to_remove). -export_type([exp1/0]). -type exp1() :: binary(). erlang-proper-1.1+gitfa58f82bdc+dfsg/test/types_test1.erl000066400000000000000000000026251255446327200232710ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc This module contains types for testing the typeserver. -module(types_test1). -export_type([exp1/0]). -record(rec1, {a = 42 :: integer(), b :: float(), c = this_atom}). -type rec1() :: #rec1{}. -opaque exp1() :: rec1() | atom(). -type type1() :: {exp1(), [float() | boolean()]}. -type type2(T) :: {T,T} | [T]. -type rem1() :: types_test2:exp1(integer()) | integer(). -type rem2() :: {bitstring(), types_test2:exp2()}. erlang-proper-1.1+gitfa58f82bdc+dfsg/test/types_test2.erl000066400000000000000000000024211255446327200232640ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc This module contains types for testing the typeserver. -module(types_test2). -export_type([exp1/1, exp2/0]). -type exp1(T) :: {'a' | 'b', binary()} | {'c', T}. -type exp2() :: atom() | [types_test1:exp1()]. -record(rec1, {f :: exp1(fun(() -> integer())), g :: fun((_,_) -> float())}). erlang-proper-1.1+gitfa58f82bdc+dfsg/test/weird_types.erl000066400000000000000000000026501255446327200233410ustar00rootroot00000000000000%%% Copyright 2010-2011 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% @copyright 2010-2011 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas %%% @version {@version} %%% @author Manolis Papadakis %%% @doc This module tests a weird scenario for the parse transform. -module(weird_types). -export([]). -export_type([foo/0]). -compile(export_all). -compile([{no_auto_import,[hd/1]}]). -include_lib("proper/include/proper.hrl"). -type foo() :: atom(). foo() -> integer(). -type hd(T) :: {'head',T}. prop_export_all_works() -> ?FORALL(X, ?MODULE:foo(), is_integer(X)). prop_no_auto_import_works() -> ?FORALL(X, hd([42]), is_tuple(X)). erlang-proper-1.1+gitfa58f82bdc+dfsg/write_compile_flags000077500000000000000000000045211255446327200232630ustar00rootroot00000000000000#!/usr/bin/env escript %%% Copyright 2010-2015 Manolis Papadakis , %%% Eirini Arvaniti %%% and Kostis Sagonas %%% %%% This file is part of PropEr. %%% %%% PropEr 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. %%% %%% PropEr 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 PropEr. If not, see . %%% Author: Manolis Papadakis %%% Description: Compilation environment setup script: This script computes and %%% prints out the correct set of compilation flags for the %%% currently running version of the OTP. -spec main([file:filename(),...]) -> 'ok'. main([OutFile]) -> CurrVer = parse_version_string(erlang:system_info(version)), {ok, Handle} = file:open(OutFile, [write]), ToDefine = %% older than 18.0 => erl_scan:line() type not marked deprecated case CurrVer < [7,0] of true -> ["USE_ERL_SCAN_LINE"]; false -> [] end ++ %% older than 17.0 => queue(), set(), etc. were built-in types case CurrVer < [6,0] of true -> ["NO_MODULES_IN_OPAQUES"]; false -> ["AT_LEAST_17"] end ++ %% older than R15B => no location information in stacktraces case CurrVer < [5,9] of true -> ["OLD_STACKTRACE_FORMAT"]; false -> [] end ++ %% older than R13B04 => can't handle recursive type declarations case CurrVer < [5,7,5] of true -> ["NO_TYPES"]; false -> [] end, lists:foreach(fun(X) -> io:format(Handle, "-define(~s, 1).~n", [X]) end, ToDefine), ok = file:close(Handle), ok. %% the stupid try-catch construct below is due to e.g. the R15A %% release being denoted as having "5.9.pre" as version info :-( -spec parse_version_string(string()) -> [non_neg_integer()]. parse_version_string(VerStr) -> [try list_to_integer(S) catch _:_ -> 0 end || S <- string:tokens(VerStr, ".")].