"racket-test" clean-up

Move a few tests, and clear out a lot of junk.

pkgs/compatibility-pkgs/compatibility-test/COPYING.txt

@@ -0,0 +1,676 @@
+
+		    GNU GENERAL PUBLIC LICENSE
+		       Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ 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.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    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 <http://www.gnu.org/licenses/>.
+
+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:
+
+    <program>  Copyright (C) <year>  <name of author>
+    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
+<http://www.gnu.org/licenses/>.
+
+  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
+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+

pkgs/compatibility-pkgs/compatibility-test/COPYING_LESSER.txt

@@ -0,0 +1,165 @@
+		   GNU LESSER GENERAL PUBLIC LICENSE
+                       Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+  This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+  0. Additional Definitions. 
+
+  As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+  "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+  An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+  A "Combined Work" is a work produced by combining or linking an
+Application with the Library.  The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+  The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+  The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+  1. Exception to Section 3 of the GNU GPL.
+
+  You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+  2. Conveying Modified Versions.
+
+  If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+   a) under this License, provided that you make a good faith effort to
+   ensure that, in the event an Application does not supply the
+   function or data, the facility still operates, and performs
+   whatever part of its purpose remains meaningful, or
+
+   b) under the GNU GPL, with none of the additional permissions of
+   this License applicable to that copy.
+
+  3. Object Code Incorporating Material from Library Header Files.
+
+  The object code form of an Application may incorporate material from
+a header file that is part of the Library.  You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+   a) Give prominent notice with each copy of the object code that the
+   Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the object code with a copy of the GNU GPL and this license
+   document.
+
+  4. Combined Works.
+
+  You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+   a) Give prominent notice with each copy of the Combined Work that
+   the Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the Combined Work with a copy of the GNU GPL and this license
+   document.
+
+   c) For a Combined Work that displays copyright notices during
+   execution, include the copyright notice for the Library among
+   these notices, as well as a reference directing the user to the
+   copies of the GNU GPL and this license document.
+
+   d) Do one of the following:
+
+       0) Convey the Minimal Corresponding Source under the terms of this
+       License, and the Corresponding Application Code in a form
+       suitable for, and under terms that permit, the user to
+       recombine or relink the Application with a modified version of
+       the Linked Version to produce a modified Combined Work, in the
+       manner specified by section 6 of the GNU GPL for conveying
+       Corresponding Source.
+
+       1) Use a suitable shared library mechanism for linking with the
+       Library.  A suitable mechanism is one that (a) uses at run time
+       a copy of the Library already present on the user's computer
+       system, and (b) will operate properly with a modified version
+       of the Library that is interface-compatible with the Linked
+       Version. 
+
+   e) Provide Installation Information, but only if you would otherwise
+   be required to provide such information under section 6 of the
+   GNU GPL, and only to the extent that such information is
+   necessary to install and execute a modified version of the
+   Combined Work produced by recombining or relinking the
+   Application with a modified version of the Linked Version. (If
+   you use option 4d0, the Installation Information must accompany
+   the Minimal Corresponding Source and Corresponding Application
+   Code. If you use option 4d1, you must provide the Installation
+   Information in the manner specified by section 6 of the GNU GPL
+   for conveying Corresponding Source.)
+
+  5. Combined Libraries.
+
+  You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+   a) Accompany the combined library with a copy of the same work based
+   on the Library, uncombined with any other library facilities,
+   conveyed under the terms of this License.
+
+   b) Give prominent notice with the combined library that part of it
+   is a work based on the Library, and explaining where to find the
+   accompanying uncombined form of the same work.
+
+  6. Revised Versions of the GNU Lesser General Public License.
+
+  The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser 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
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+  If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.

pkgs/compatibility-pkgs/compatibility-test/LICENSE.txt

@@ -0,0 +1,10 @@
+compatibility-lib
+Copyright (c) 2010-2013 PLT Design Inc.
+
+This package is distributed under the GNU Lesser General Public
+License (LGPL).  This means that you can link Racket into proprietary
+applications, provided you follow the rules stated in the LGPL.  You
+can also modify this package; if you distribute a modified version,
+you must distribute it under the terms of the LGPL, which in
+particular means that you must release the source code for the
+modified software.  See COPYING_LESSER.txt for more information.

pkgs/compatibility-pkgs/compatibility-test/info.rkt

@@ -0,0 +1,8 @@
+#lang info
+(define collection 'multi)
+(define deps '("base"
+               "racket-test"))
+
+(define pkg-desc "tests for \"compatibility-lib\"")
+
+(define pkg-authors '(mflatt))

pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/awk.rktl

@@ -8,8 +8,8 @@
 (define-syntax (test-awk stx)
   (syntax-case stx ()
     [(_ val body ...) 
-     (with-syntax ([next (datum->syntax-object stx 'next)]
+     (with-syntax ([next (datum->syntax stx 'next)]
-		   [result (datum->syntax-object stx 'result)])
+		   [result (datum->syntax stx 'result)])
        (syntax
 	(let* ([p (open-input-string "Hello world.")]
 	       [next (lambda () (let ([o (read p)])

pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/cmdline.rktl

@@ -0,0 +1,38 @@
+
+(load-relative "loadtest.rktl")
+
+(Section 'command-line)
+
+(require mzlib/cmdline)
+
+(test (void) 'cmdline
+      (command-line "something" #("-ab")
+        (once-each
+         [("-a") "ok" 5]
+         [("-b" "--more") "Help" 7])))
+
+;; test that keywords are compared for the literal symbol
+(test "foo" 'cmdline
+      (let ([once-each 3] [args "args"])
+        (command-line "something" #("-ab" "foo")
+          (once-each
+           [("-a") "ok" 5]
+           [("-b" "--more") "Help" 7])
+          (args (x) x))))
+
+(syntax-test #'(command-line))
+(syntax-test #'(command-line "hello"))
+(err/rt-test (command-line 'hello #("ok")))
+(syntax-test #'(command-line "hello" #("ok") (bad)))
+(syntax-test #'(command-line "hello" #("ok") (once-any ())))
+(syntax-test #'(command-line "hello" #("ok") (once-any ("-ok"))))
+(syntax-test #'(command-line "hello" #("ok") (once-any ("-ok" "the ok flag"))))
+(syntax-test #'(command-line "hello" #("ok") (once-any ("-ok" a "the ok flag"))))
+(syntax-test #'(command-line "hello" #("ok") (once-any ("-ok" (a) "the ok flag"))))
+(syntax-test #'(command-line "hello" #("ok") (once-any ("-ok" a "the ok flag") ())))
+(syntax-test #'(command-line "hello" #("ok") (args 'done) (once-any ("-ok" a "the ok flag" 7))))
+(syntax-test #'(command-line "hello" #("ok") (args (ok) 'done) (once-any ("-ok" a "the ok flag" 7))))
+(syntax-test #'(command-line "hello" #("ok") (=> 'done) (once-any ("-ok" a "the ok flag" 7))))
+(syntax-test #'(command-line "hello" #("ok") (=> 1 2 3 4) (once-any ("-ok" a "the ok flag" 7))))
+
+(report-errs)

pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/etc.rktl

@@ -49,5 +49,21 @@
 		 (define goo 10)
 		 12))
 
+(let ()
+  (test 3 (rec f (λ (x) 3)) 3)
+  (test 3 (rec f (λ (x) x)) 3)
+  (test 2 (rec f (λ (x) (if (= x 3) (f 2) x))) 3)
+  (test 3 (rec (f x) 3) 3)
+  (test 3 (rec (f x) x) 3)
+  (test 2 (rec (f x) (if (= x 3) (f 2) x)) 3)
+  (test 2 (rec (f x . y) (car y)) 1 2 3)
+  (test 2 'no-duplications
+        (let ([x 1]) (rec ignored (begin (set! x (+ x 1)) void)) x))
+  (test 'f object-name (rec (f x) x))
+  (test 'f object-name (rec (f x . y) x))
+  (test 'f object-name (rec  f (lambda (x) x)))
+  (test (list 2) (rec (f . x) (if (= (car x) 3) (f 2) x)) 3))
+
+
 (report-errs)
 

pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/loadtest.rktl

@@ -0,0 +1 @@
+(load (collection-file-path "loadtest.rktl" "tests/racket"))

pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/serialize.rktl

@@ -0,0 +1,16 @@
+
+(load-relative "loadtest.rktl")
+
+(Section 'serialization)
+
+(module ser-mod mzscheme
+   (require mzlib/serialize)
+   (provide ser-mod-test)
+
+   (define-serializable-struct foo (a b))
+
+   (define (ser-mod-test)
+     (foo-a (deserialize (serialize (make-foo 1 2))))))
+
+(require 'ser-mod)
+(test 1 ser-mod-test)

pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/test.rkt

@@ -0,0 +1,4 @@
+#lang racket/load
+
+(define quiet-load (collection-file-path "tests.rktl" "tests" "mzlib"))
+(load (collection-file-path "quiet.rktl" "tests" "racket"))

pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/testing.rktl

@@ -0,0 +1 @@
+(load (collection-file-path "testing.rktl" "tests/racket"))

pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/tests.rktl

@@ -0,0 +1,17 @@
+(load "loadtest.rktl")
+
+(load-in-sandbox "kw.rktl")
+(load-in-sandbox "awk.rktl")
+(load-in-sandbox "etc.rktl")
+(load-in-sandbox "compat.rktl")
+(load-in-sandbox "unit.rktl")
+(load-in-sandbox "unitsig.rktl")
+(load-in-sandbox "string-mzlib.rktl")
+(load-in-sandbox "threadlib.rktl")
+(load-in-sandbox "serialize.rktl")
+(load-in-sandbox "pconvert.rktl")
+(load-in-sandbox "cmdline.rktl")
+(load-in-sandbox "restart.rktl")
+(load-in-sandbox "macrolib.rktl")
+(load-in-sandbox "structlib.rktl")
+(load-in-sandbox "contract-mzlib-test.rktl")

pkgs/gui-pkgs/gui-test/info.rkt

@@ -13,7 +13,8 @@
                      "rackunit-lib"
                      "scribble-lib"
                      "pconvert-lib"
-                     "compatibility-lib"))
+                     "compatibility-lib"
+                     "sandbox-lib"))
 
 (define pkg-desc "tests for \"gui\"")
 

pkgs/gui-pkgs/gui-test/tests/gracket/cache-image-snip-test.rktl

@@ -1,4 +1,4 @@
-(load-relative "loadtest.rktl")
+(load (collection-file-path "loadtest.rktl" "tests/racket"))
 
 (require racket/gui/base
          mrlib/cache-image-snip

pkgs/main-distribution-test/info.rkt

@@ -18,6 +18,7 @@
                "scribble-test"
                "unstable-test"
                "compiler-test"
+               "compatibility-test"
                "data-test"
                "net-test"
                "planet-test"

pkgs/net-pkgs/net-test/tests/net/base64.rkt

@@ -1,16 +1,9 @@
+#lang racket/base
+(require net/base64)
 
-(load-relative "loadtest.rktl")
+(define (test expect f . args)
-
+  (unless (equal? expect (apply f args))
-(Section 'net)
+    (error "fail")))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; other net tests
-;;
-
-(require net/base64
-         net/qp
-         mzlib/port)
 
 (test #"" base64-encode #"")
 (test #"" base64-encode #"" #"<>")
@@ -18,5 +11,3 @@
       base64-encode #"Why do axe murderers only attack\nWhen you're partially nude\nOr you're taking a bath")
 (test #"V2h5IGRvIGF4ZSBtdXJkZXJlcnMgb25seSBhdHRhY2sKV2hlbiB5b3UncmUgcGFydGlhbGx5<>IG51ZGUKT3IgeW91J3JlIHRha2luZyBhIGJhdGg=<>"
       base64-encode #"Why do axe murderers only attack\nWhen you're partially nude\nOr you're taking a bath" #"<>")
-
-(report-errs)

pkgs/net-pkgs/net-test/tests/net/head.rkt

@@ -91,6 +91,32 @@
    (append-headers test-header/bytes #"Athird: data\r\n\r\n")
    => #"From: abc\r\nTo: field is\r\n continued\r\nAnother: zoo\r\n continued\r\nAthird: data\r\n\r\n"
 
-   ))
+   )
+
+  (let ([test (lambda (expect f . args)
+                (unless (equal? expect (apply f args))
+                  (error "failed")))])
+    (for-each 
+     (lambda (addr)
+       (test '("o.gu@racket-lang.com") extract-addresses (car addr) 'address)
+       (test '("o.gu@racket-lang.com" "o.gu@racket-lang.com") extract-addresses 
+             (format "~a, ~a" (car addr) (car addr))
+             'address)
+       (test (list (cdr addr)) extract-addresses (car addr) 'name)
+       (for-each 
+        (lambda (addr2)
+          (let ([two (format " ~a, \n\t~a" (car addr) (car addr2))])
+            (test '("o.gu@racket-lang.com" "s.gu@racket-lang.org") extract-addresses two 'address)
+            (test (list (cdr addr) (cdr addr2)) extract-addresses two 'name)))
+        '(("s.gu@racket-lang.org" . "s.gu@racket-lang.org")
+          ("<s.gu@racket-lang.org>" . "s.gu@racket-lang.org")
+          ("s.gu@racket-lang.org (Gu, Sophia)" . "Gu, Sophia")
+          ("s.gu@racket-lang.org (Sophia Gu)" . "Sophia Gu")
+          ("s.gu@racket-lang.org (Sophia \"Sophie\" Gu)" . "Sophia \"Sophie\" Gu")
+          ("Sophia Gu <s.gu@racket-lang.org>" . "Sophia Gu")
+          ("\"Gu, Sophia\" <s.gu@racket-lang.org>" . "\"Gu, Sophia\"")
+          ("\"Gu, Sophia (Sophie)\" <s.gu@racket-lang.org>" . "\"Gu, Sophia (Sophie)\""))))
+     '(("o.gu@racket-lang.com" . "o.gu@racket-lang.com")))
+    (printf "more tests passed\n")))
 
 (module+ test (require (submod ".." main))) ; for raco test & drdr

pkgs/net-pkgs/net-test/tests/net/imap.rkt

@@ -0,0 +1,182 @@
+#lang racket/base
+(require openssl/mzssl
+	 net/imap
+	 mzlib/etc)
+
+(define (test expect f . args)
+  (define got (if (procedure? f)
+                  (apply f args)
+                  (car args)))
+  (unless (equal? expect got)
+    (error 'test "failed: ~s vs. ~s" expect got)))
+
+(define imap-config-file
+  (build-path (find-system-path 'home-dir) ".imap-test-config"))
+
+(when (file-exists? imap-config-file)
+  (define config (with-input-from-file imap-config-file
+                   read))
+
+  (define imap-server (hash-ref config 'imap-server))
+  (define imap-port-no (hash-ref config 'imap-port-no))
+  (define username (hash-ref config 'username))
+  (define pw (hash-ref config 'pw))
+  (define mailbox-name (hash-ref config 'mailbox-name "INBOX.tmp")) ;; !!! ALL CONTENT WILL BE DELETED !!!
+
+  (define (test-connect)
+    (if (zero? (random 2))
+        (parameterize ([imap-port-number 993])
+          (imap-connect #:tls? #t imap-server username pw mailbox-name))
+        (let ([c (ssl-make-client-context)])
+          (let-values ([(in out) (ssl-connect imap-server imap-port-no c)])
+            (imap-connect* in out username pw mailbox-name)))))
+
+  (define-values (imap cnt recent) (test-connect))
+
+  (printf "Msgs: ~a; Validity: ~a\n" cnt (imap-uidvalidity imap))
+
+  (test cnt imap-messages imap)
+  (test recent imap-recent imap)
+  (test #t number? (imap-uidvalidity imap))
+  (test #f imap-pending-expunges? imap)
+  (test #f imap-pending-updates? imap)
+  (test #f imap-new? imap)
+
+  (define (delete-all)
+    (let ([cnt (imap-messages imap)])
+      (unless (zero? cnt)
+        (let ([all (build-list cnt add1)])
+          (test (void) imap-store imap '+ all '|\Deleted|)
+          (test (void) imap-expunge imap)
+          (test #t imap-pending-expunges? imap)
+          (test all imap-get-expunges imap)
+          (test null imap-get-expunges imap)
+          (test #f imap-pending-expunges? imap)))))
+
+  (delete-all)
+  (test #f imap-new? imap)
+  (test 0 imap-messages imap)
+  (test '(0 0) 'noop (let-values ([(a b) (imap-noop imap)])
+                       (list a b)))
+  (test (void) imap-poll imap)
+  (test 0 imap-messages imap)
+  (test 0 imap-recent imap)
+
+  (test #f imap-new? imap)
+
+  (define (add-one content total)
+    (test (void) imap-append imap mailbox-name content)
+    (imap-noop imap)
+    (test total imap-messages imap)
+    (test #t imap-new? imap)
+    (let ([uids (imap-get-messages imap (build-list total add1) '(uid))])
+      (test #t list? uids)
+      (test total length uids)
+      (let ([l (list-ref uids (sub1 total))])
+        (test #t list? l)
+        (test 1 length l)
+        (test #t number? (car l))
+        (car l))))
+
+  (define sample-head #"Subject: Hello\r\n\r\n")
+  (define sample-body #"Hi there.\r\n")
+
+  (let ([uid (add-one (bytes-append sample-head sample-body) 1)])
+    (test (list (list uid 
+                      sample-head
+                      sample-body
+                      '(|\Seen| |\Recent|)))
+          imap-get-messages imap '(1) '(uid header body flags)))
+  (test (void) imap-store imap '+ '(1) (list (symbol->imap-flag 'answered)))
+  (test (list '((|\Answered| |\Seen| |\Recent|))) imap-get-messages imap '(1) '(flags))
+  (test (void) imap-store imap '- '(1) (list (symbol->imap-flag 'answered)))
+  (test (list '((|\Seen| |\Recent|))) imap-get-messages imap '(1) '(flags))
+  (test (void) imap-store imap '+ '(1) (list (symbol->imap-flag 'deleted)))
+  (test (list '((|\Deleted| |\Seen| |\Recent|))) imap-get-messages imap '(1) '(flags))
+  (test (void) imap-store imap '! '(1) (list (symbol->imap-flag 'answered)))
+  (test (list '((|\Answered| |\Recent|))) imap-get-messages imap '(1) '(flags))
+
+  (test #f imap-pending-updates? imap)
+  (test null imap-get-updates imap)
+
+  ;; Test multiple-client access:
+  (let ()
+    (define-values (imap2 cnt2 recent2) (test-connect))
+    (test '(1 0) list cnt2 recent2)
+    
+    (let ([uid (add-one (bytes-append sample-head sample-body) 2)])
+      (let loop ([n 5])
+        (when (zero? n)
+          (imap-noop imap2))
+        (imap-poll imap2)
+        (unless (imap-new? imap2)
+          (sleep 0.2)
+          (loop (sub1 n))))
+      (test #t imap-new? imap2)
+      (test 2 imap-messages imap2)
+      (let ([uids (imap-get-messages imap2 '(2) '(uid))])
+        (test uid caar uids)))
+
+    ;; Delete message on imap2, check notifcation to imap
+    (test (void) imap-store imap2 '+ '(2) (list (symbol->imap-flag 'deleted)))
+    (test (void) imap-expunge imap2)
+    (test '(2) imap-get-expunges imap2)
+    (imap-noop imap)
+    (test 'exn values (with-handlers ([exn:fail:contract? (lambda (x) 'exn)])
+                        (imap-store imap '+ '(2) (list (symbol->imap-flag 'answered)))))
+    (test #t imap-pending-expunges? imap)
+    (test '(2) imap-get-expunges imap)
+
+    ;; Adjust flags on imap2, check notifcation to imap
+    (test #f imap-pending-updates? imap)
+    (test (void) imap-store imap2 '+ '(1) (list (symbol->imap-flag 'deleted)))
+    (imap-noop imap)
+    (test #t imap-pending-updates? imap)
+    (test #t list? (imap-get-updates imap))
+    (test #f imap-pending-updates? imap)
+
+    ;; Check that multiple updates are collapsed:
+    (test (void) imap-store imap2 '- '(1) (list (symbol->imap-flag 'deleted)))  
+    (imap-noop imap)
+    (test #t imap-pending-updates? imap)
+    (test (void) imap-store imap2 '+ '(1) (list (symbol->imap-flag 'deleted)))
+    (test (void) imap-store imap2 '- '(1) (list (symbol->imap-flag 'deleted)))
+    (imap-noop imap)
+    (test #t imap-pending-updates? imap)
+    (test 1 length (imap-get-updates imap))
+    
+    (test (void) imap-reset-new! imap2)
+    (add-one (bytes-append sample-head sample-body) 2)
+    (add-one (bytes-append sample-head sample-body) 3)
+    (add-one (bytes-append sample-head sample-body) 4)
+    (add-one (bytes-append sample-head sample-body) 5)
+    (imap-noop imap2)
+    (test #t imap-new? imap2)
+    (test 5 imap-messages imap)
+    (test 5 imap-messages imap2)
+
+    (test #t list? (imap-get-messages imap '(1 2 3 4 5) '(uid)))
+    (test #t list? (imap-get-messages imap2 '(1 2 3 4 5) '(uid)))
+    
+    ;; Test deleteing multiple messages, and shifts in flag updates
+    (test (void) imap-store imap2 '+ '(2 4) (list (symbol->imap-flag 'deleted)))
+    (test (void) imap-store imap2 '+ '(3 5) (list (symbol->imap-flag 'answered)))
+    (test (void) imap-expunge imap2)
+    (imap-noop imap)
+    (imap-noop imap2)
+    (test #t imap-pending-expunges? imap)
+    (test #t imap-pending-expunges? imap2)
+    (test '(2 4) imap-get-expunges imap)
+    (test '(2 4) imap-get-expunges imap2)
+    (test #t imap-pending-updates? imap)
+    (test '(2 3) map car (imap-get-updates imap))
+
+    (imap-disconnect imap2))
+
+  (imap-disconnect imap)
+  
+  (printf "tests passed\n"))
+
+
+
+

pkgs/plt-services/meta/props

@@ -651,6 +651,16 @@ path/s is either such a string or a list of them.
 "pkgs/compatibility-pkgs/compatibility-lib/mzlib/plt-match.rkt" responsible (samth)
 "pkgs/compatibility-pkgs/compatibility-lib/mzlib/shared.rkt" responsible (robby)
 "pkgs/compatibility-pkgs/compatibility-lib/mzlib/traceld.rkt" drdr:command-line #f
+"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/awk.rktl" drdr:command-line #f
+"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/binc.rktl" drdr:command-line #f
+"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/contract-mzlib-test.rktl" responsible (robby) drdr:command-line (racket "-r" *)
+"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/pconvert.rktl" drdr:command-line #f
+"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/serialize.rktl" drdr:random #t
+"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/structlib.rktl" drdr:random #t
+"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/tests.rktl" drdr:command-line #f
+"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/threadlib.rktl" drdr:random #t
+"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/ttt/uinc4.rktl" drdr:command-line #f
+"pkgs/compatibility-pkgs/compatibility-test/tests/mzlib/uinc3.rktl" drdr:command-line #f
 "pkgs/compiler-pkgs" responsible (mflatt jay)
 "pkgs/compiler-pkgs/compiler-lib/compiler/commands/exe-dir.rkt" drdr:command-line #f
 "pkgs/compiler-pkgs/compiler-lib/compiler/commands/exe.rkt" drdr:command-line #f
@@ -1282,47 +1292,35 @@ path/s is either such a string or a list of them.
 "pkgs/racket-pkgs/racket-test/tests/pkg/test.rkt" drdr:command-line (raco "test" *)
 "pkgs/racket-pkgs/racket-test/tests/racket" responsible (mflatt)
 "pkgs/racket-pkgs/racket-test/tests/racket/all.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/awk.rktl" drdr:command-line #f
+"pkgs/racket-pkgs/racket-test/tests/racket/basic.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/basic.rktl" drdr:random #t
-"pkgs/racket-pkgs/racket-test/tests/racket/binc.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/chez-module.rktl" drdr:command-line #f
+"pkgs/racket-pkgs/racket-test/tests/racket/cm.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/cm.rktl" drdr:random #t
-"pkgs/racket-pkgs/racket-test/tests/racket/compile.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/contmark.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/contract" responsible (robby)
 "pkgs/racket-pkgs/racket-test/tests/racket/contract/all.rkt" drdr:command-line (raco "make" *)
-"pkgs/racket-pkgs/racket-test/tests/racket/contract-mzlib-test.rktl" responsible (robby) drdr:command-line (racket "-r" *)
 "pkgs/racket-pkgs/racket-test/tests/racket/contract-opt-tests.rkt" responsible (robby) drdr:command-line (racket "-r" *)
 "pkgs/racket-pkgs/racket-test/tests/racket/contract-stress-argmin.rkt" responsible (robby) drdr:command-line (racket "-r" *)
 "pkgs/racket-pkgs/racket-test/tests/racket/contract-stress-take-right.rkt" responsible (robby) drdr:command-line (racket "-r" *)
-"pkgs/racket-pkgs/racket-test/tests/racket/date.rktl" drdr:random #t
+"pkgs/racket-pkgs/racket-test/tests/racket/date.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/embed-in-c.rkt" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/expand.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/file.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/filelib.rktl" drdr:command-line #f drdr:timeout 360
+"pkgs/racket-pkgs/racket-test/tests/racket/filelib.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/fixnum.rktl" drdr:timeout 360 drdr:random #t
+"pkgs/racket-pkgs/racket-test/tests/racket/fixnum.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/foreign-test.rktl" drdr:random #t
+"pkgs/racket-pkgs/racket-test/tests/racket/foreign-test.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/format.rkt" drdr:random #t
-"pkgs/racket-pkgs/racket-test/tests/racket/imap.rktl" drdr:command-line #f
+"pkgs/racket-pkgs/racket-test/tests/racket/iostream.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/iostream.rktl" drdr:random #t
 "pkgs/racket-pkgs/racket-test/tests/racket/link.rkt" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/list.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/module.rktl" drdr:random #t
+"pkgs/racket-pkgs/racket-test/tests/racket/module.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/mz-tests.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/mzlib-tests.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/mzq.rktl" drdr:timeout 200
 "pkgs/racket-pkgs/racket-test/tests/racket/number.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/object-old.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/object.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/pack.rktl" drdr:random #t
+"pkgs/racket-pkgs/racket-test/tests/racket/pack.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/package-gen.rktl" drdr:timeout 600 drdr:random #t
 "pkgs/racket-pkgs/racket-test/tests/racket/parallel-build.rkt" drdr:random #t
 "pkgs/racket-pkgs/racket-test/tests/racket/parallel-plot.rkt" drdr:timeout 400
 "pkgs/racket-pkgs/racket-test/tests/racket/parallel.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/path.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/pconvert.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/place-chan-rand-help.rkt" responsible (tewk)
 "pkgs/racket-pkgs/racket-test/tests/racket/place-chan-rand.rkt" responsible (tewk)
 "pkgs/racket-pkgs/racket-test/tests/racket/place-channel-fd.rkt" responsible (tewk) drdr:random #t
@@ -1339,45 +1337,38 @@ path/s is either such a string or a list of them.
 "pkgs/racket-pkgs/racket-test/tests/racket/prompt-sfs.rkt" drdr:random #t
 "pkgs/racket-pkgs/racket-test/tests/racket/prompt-tests.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/prompt.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/quiet.rktl" drdr:timeout 600
+"pkgs/racket-pkgs/racket-test/tests/racket/quiet.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/read.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/resource.rktl" drdr:random #t
+"pkgs/racket-pkgs/racket-test/tests/racket/resource.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/runaway-place.rkt" drdr:random #t
 "pkgs/racket-pkgs/racket-test/tests/racket/rx.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/scheme-tests.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/sequence.rktl" drdr:random #t
+"pkgs/racket-pkgs/racket-test/tests/racket/sequence.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/serialize.rktl" drdr:random #t
+"pkgs/racket-pkgs/racket-test/tests/racket/serialize.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/set.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/setup.rktl" drdr:random #t
+"pkgs/racket-pkgs/racket-test/tests/racket/setup.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/shared-tests.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/sp.rktl" drdr:random #t
 "pkgs/racket-pkgs/racket-test/tests/racket/srcloc.rktl" responsible (cce)
 "pkgs/racket-pkgs/racket-test/tests/racket/stress" responsible (jay) drdr:random #t
 "pkgs/racket-pkgs/racket-test/tests/racket/stress/contract-lifting.rkt" responsible (robby sstrickl)
 "pkgs/racket-pkgs/racket-test/tests/racket/stress/dict.rkt" drdr:timeout 180
 "pkgs/racket-pkgs/racket-test/tests/racket/stress/fuzz.rkt" responsible (samth mflatt) drdr:command-line (racket * "-c") drdr:timeout 600
 "pkgs/racket-pkgs/racket-test/tests/racket/stress/module-stack.rkt" drdr:timeout 500
-"pkgs/racket-pkgs/racket-test/tests/racket/structlib.rktl" drdr:random #t
+"pkgs/racket-pkgs/racket-test/tests/racket/stx.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/stx.rktl" drdr:random #t
+"pkgs/racket-pkgs/racket-test/tests/racket/submodule.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/submodule.rktl" drdr:random #t
+"pkgs/racket-pkgs/racket-test/tests/racket/subprocess.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/subprocess.rktl" drdr:random #t
 "pkgs/racket-pkgs/racket-test/tests/racket/sync.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/syntax-tests.rktl" drdr:random #t
 "pkgs/racket-pkgs/racket-test/tests/racket/syntax.rktl" drdr:command-line #f
+"pkgs/racket-pkgs/racket-test/tests/racket/test.rkt" drdr:timeout 600
 "pkgs/racket-pkgs/racket-test/tests/racket/thread.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/threadlib.rktl" drdr:random #t
 "pkgs/racket-pkgs/racket-test/tests/racket/thrport.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/trace.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/ttt/uinc4.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/udp.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/uinc3.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/uni-norm.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/unicode.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/unsafe.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/racket/vector.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/will.rktl" drdr:random #t
+"pkgs/racket-pkgs/racket-test/tests/racket/will.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/zo-marshal.rktl" drdr:command-line #f
-"pkgs/racket-pkgs/racket-test/tests/racket/ztest.rktl" drdr:command-line #f
 "pkgs/racket-pkgs/racket-test/tests/run-automated-tests.rkt" responsible (eli) drdr:command-line (mzc "-k" *) drdr:timeout 600
 "pkgs/racket-pkgs/racket-test/tests/stress.rkt" responsible (jay)
 "pkgs/racket-pkgs/racket-test/tests/stxparse" responsible (ryanc)

pkgs/racket-pkgs/racket-test/tests/racket/README

@@ -1,33 +0,0 @@
-
-To run most of the tests, run:
- > (load "PATHTOHERE/all.ss")
-where PATHTOHERE is the path to this directory.  
-
-Test failures may cause the test to stop before finishing, but most
-test failures will let the test continue, and a summary message at the
-end will enummerate the failures that occurred.
-
-Some files and directories are created (in the current directory)
-during the run. The files are named "tmp<N>" where <N> is a number.
-The directory is named "deep". If the test suite passes, the directory
-should be removed, but some "tmp<N>" files will remain. (The "tmp<N>"
-files are automatically replaced if the test suite is run again.)
-
-Additionally, test `expand' by running:
- > (load "PATHTOHERE/expand.ss")
-
-Test compilation and writing/reading compiled code with:
- > (load "PATHTOHERE/compile.ss")
-
-Run the standard tests with no output except for the results with:
- > (load "PATHTOHERE/quiet.ss")
-(Also get an error code -- use with scripts.)
-
-Run 3 copies of the test suite concurrently in separate threads:
- > (load "PATHTOHERE/parallel.ss")
-
-
-Please report bugs using Help Desk, or
-  http://bugs.racket-lang.org/
-or (as a last resort) send mail to
-  racket@racket-lang.org

pkgs/racket-pkgs/racket-test/tests/racket/all.rktl

@@ -1,9 +1,49 @@
 
 (load-relative "loadtest.rktl")
-(load-relative "mz-tests.rktl")
+
-(load-relative "scheme-tests.rktl")
+(load-relative "core-tests.rktl")
-(load-relative "mzlib-tests.rktl")
+
-(load-relative "syntax-tests.rktl")
+(load-in-sandbox "setup.rktl")
+(load-in-sandbox "for.rktl")
+(load-in-sandbox "list.rktl")
+(load-in-sandbox "math.rktl")
+(load-in-sandbox "vector.rktl")
+(load-in-sandbox "function.rktl")
+(load-in-sandbox "dict.rktl")
+(load-in-sandbox "fixnum.rktl")
+(load-in-sandbox "flonum.rktl")
+
+(load-in-sandbox "mpair.rktl")
+(load-in-sandbox "async-channel.rktl")
+(load-in-sandbox "pathlib.rktl")
+(load-in-sandbox "filelib.rktl")
+(load-in-sandbox "portlib.rktl")
+(load-in-sandbox "set.rktl")
+(load-in-sandbox "date.rktl")
+(load-in-sandbox "cmdline.rktl")
+(load-in-sandbox "stream.rktl")
+(load-in-sandbox "sequence.rktl")
+(load-in-sandbox "generator.rktl")
+(load-in-sandbox "pretty.rktl")
+(load-in-sandbox "control.rktl")
+(load-in-sandbox "serialize.rktl")
+(load-in-sandbox "package.rktl")
+(load-in-sandbox "sandbox.rktl")
+(load-in-sandbox "shared.rktl")
+(load-in-sandbox "resource.rktl")
+(load-in-sandbox "syntaxlibs.rktl")
+(load-in-sandbox "subprocess.rktl")
+(load-in-sandbox "char-set.rktl")
+(load-in-sandbox "bytes.rktl")
+(load-in-sandbox "trace.rktl")
+(load-in-sandbox "trait.rktl")
+
+(load-in-sandbox "moddep.rktl")
+(load-in-sandbox "boundmap-test.rktl")
+(load-in-sandbox "id-table-test.rktl")
+(load-in-sandbox "cm.rktl")
+(load-in-sandbox "module-reader.rktl")
+
 (load-in-sandbox "version.rktl")
 (load-in-sandbox "foreign-test.rktl")
 (load-in-sandbox "cstruct.rktl")

pkgs/racket-pkgs/racket-test/tests/racket/chez-module.rktl

@@ -1,271 +0,0 @@
-
-;; Run this file with -r, and inspect the
-;; printouts.
-
-(module helpers mzscheme
-  (require scheme/package)
-
-  (provide identifier-syntax with-implicit
-	   (rename define-package module)
-	   (rename open-package import))
-
-  (define-syntax (identifier-syntax stx)
-    (syntax-case stx ()
-      [(_ id) (if (identifier? #'id)
-		  #'(make-rename-transformer (quote-syntax id))
-		  ;; Cheating in this case... examples only
-		  ;; use this in a non-applied position
-		  #'(lambda (stx) (quote-syntax id)))]))
-
-  (define-syntax with-implicit
-    (syntax-rules ()
-      [(_ (orig id ...) body)
-       (with-syntax ([id (datum->syntax-object #'orig (syntax-e #'id))]
-		     ...)
-	 body)])))
-    
-
-(require 'helpers)
-(require (for-syntax 'helpers))
-
-;; Make evaluation print the result, for testing
-(let ([eh (current-eval)])
-  (current-eval (lambda (x)
-		  (let ([v (eh x)])
-		    (unless (void? v)
-		      (printf "~s~n" v))
-		    v))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; From "Extending the Scope of Syntactic Abstraction"
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(let ((x 1))
-  (module M (x setter)
-    (define-syntax x (identifier-syntax z))
-    (define setter (lambda (x) (set! z x)))
-    (define z 5))
-  (let ((y x) (z 0))
-    (import M)
-    (setter 3)
-    (list x y z)))
-"(3 1 0) is correct"
-
-
-(define-syntax from
-  (syntax-rules ()
-    ((_ M id) (let () (import M) id))))
-(let ((x 10))
-  (module m1 (x) (define x 1))
-  (module m2 (x) (define x 2))
-  (list (from m1 x) (from m2 x)))
-"(1 2) is correct"
-
-(define-syntax module*
-  (syntax-rules ()
-    [(_ (id ...) form ...)
-     (begin
-       (module tmp (id ...) form ...)
-       (import tmp))]
-    [(_ name (id ...) form ...)
-     (module name (id ...) form ...)]))
-(let ([w 88])
-  (module* (f)
-   (define (f) w)
-   (define w 17))
-  (list (f) w))
-"(17 88) is correct"
-
-(define-syntax define-alias
-  (syntax-rules ()
-    [(_ x y)
-     (define-syntax x 
-       (identifier-syntax y))]))
-
-(define-syntax import*
-  (syntax-rules ()
-    [(_ M) (begin)]
-    [(_ M (new old))
-     (module* (new)
-      (define-alias new tmp)
-      (module* (tmp)
-       (import M)
-       (define-alias tmp old)))]
-    [(_ M id) (module* (id) (import M))]
-    [(_ M spec0 spec1 ...)
-     (begin (import* M spec0)
-            (import* M spec1 ...))]))
-(module m (x y z)
-  (define x 'x)
-  (define y 'y)
-  (define z 'z))
-(import* m x (y z) (z y))
-(list x y z)
-"(x z y) is correct"
-
-(module A (x y)
-  (define x 1)
-  (define y 2))
-(module B (y z)
-  (define y 3) 
-  (define z 4))
-(module C (a b c d)
-  (import* A (a x) (b y))
-  (import* B (c y) (d z)))
-(module D (a c) 
-  (import C)) 
-(module E (b d) 
-  (import C))
-(let ([a 'a]
-      [b 'b]
-      [c 'c]
-      [d 'd])
-  (import D)
-  (list a b c d))
-"(1 b 3 d) is correct"
-(let ([a 'a]
-      [b 'b]
-      [c 'c]
-      [d 'd])
-  (import E)
-  (list a b c d))
-"(a 2 c 4) is correct"
-
-(module* (A B)
- (module A (x) 
-   (define x (lambda () y)))
- (module B (y)
-   (define y (lambda () x)))
- (import A)
- (import B))
-(import A)
-(import B)
-(and (eq? x (y)) (eq? (y) x))
-"#t is correct"
-
-
-(define-syntax rec-modules
-  (syntax-rules ()
-    ((_ (module N (id ...) form ...) ...)
-     (module* (N ...)
-      (module N (id ...) form ...) ...
-      (import N) ...))))
-(rec-modules
- (module O (odd)
-   (define (odd x)
-     (if (zero? x) #f (even (sub1 x)))))
- (module E (even)
-   (define (even x)
-     (if (zero? x) #t (odd (sub1 x))))))
-(import O)
-(list (odd 17) (odd 32))
-"(#t #f) is correct"
-
-
-(define-syntax define-interface
-  (syntax-rules ()
-    [(_ name (export ...))
-     (define-syntax name
-       (lambda (x)
-	 (syntax-case x ()
-	   [(_ n defs)
-	    (with-implicit (n export ...)
-	     #'(module n (export ...) . defs))])))]))
-(define-syntax define-module
-  (syntax-rules ()
-    [(_ name interface defn ...)
-     (interface name (defn ...))]))
-(define-interface simple (a b))
-(define-module M simple
-  (define-syntax a (identifier-syntax 1))
-  (define b (lambda () c))
-  (define c 2))
-(let ()
-  (import M)
-  (list a (b)))
-"(1 2) is right"
-
-(define-syntax define-interface
-  (syntax-rules (compound-interface)
-    [(_ name (compound-interface i0 i1 ...))
-     (d-i-help name (i0 i1 ...) ())]
-    [(_ name (export ...))
-     (define-syntax name
-       (lambda (x)
-	 (syntax-case x (expand-exports)
-	   [(_ n defs)
-	    (with-implicit (n export ...)
-	     #'(module n (export ...) . defs))]
-	   [(_ (expand-exports i-name mac)) 
-	    (with-implicit (i-name export ...)
-	     #'(mac i-name export ...))])))]))
-(define-syntax d-i-help
-  (syntax-rules ()
-    [(_ name () (export ...))
-     (define-interface name (export ...))]
-    [(_ name (i0 i1 ...) (e ...))
-     (begin
-       (define-syntax tmp
-	 (syntax-rules ()
-	   [(_ name expt (... ...))
-	    (d-i-help name (i1 ...)
-		      (e ... expt (... ...)))]))
-       (i0 (expand-exports name tmp)))]))
-(define-syntax define-module
-  (syntax-rules (compound-interface)
-    [(_ name (compound-interface i ...) defn ...)
-     (begin
-       (define-interface tmp(compound-interface i ...))
-       (define-module name tmp defn ...))]
-    [(_ name interface defn ...) (interface name (defn ...))])) 
-(define-interface one (a b))
-(define-interface two (c d))
-(define-interface both
-  (compound-interface one two))
-(define-module M (compound-interface one two)
-  (define a 1)
-  (define b 2)
-  (define c 3) 
-  (define d 4))
-(let () 
-  (import M) 
-  (list a b c d))
-"(1 2 3 4) is correct"
-
-(define-syntax declare
-  (syntax-rules ()
-    [(_ id) (define id (void))]))
-(define-syntax satisfy
-  (syntax-rules ()
-    [(_ id val) (set! id val)]))
-
-(define-syntax abstract-module
-  (syntax-rules ()
-    ((_ name (ex ...) (mac ...) defn ...)
-     (module name (ex ... mac ...)
-       (declare ex) 
-       ... defn ...))))
-(define-syntax implement
-  (syntax-rules ()
-    ((_ name form ...)
-     (module* () 
-      (import name)
-      form ...))))
-(abstract-module E (even?) ())
-(abstract-module 
- O (odd?) (pred)
- (define-syntax pred
-   (syntax-rules () ((_ exp) (- exp 1)))))
-(implement E
- (import O)
- (satisfy even? 
-  (lambda (x) (or (zero? x) (odd? (pred x))))))
-(implement O
- (import E)
- (satisfy 
-  odd?
-  (lambda (x) (not (even? x))))) 
-(import O)
-(list (odd? 10) (odd? 13))
-"(#f #t) is correct"
-

pkgs/racket-pkgs/racket-test/tests/racket/cmdline.rktl

@@ -3,7 +3,7 @@
 
 (Section 'command-line)
 
-(require mzlib/cmdline)
+(require racket/cmdline)
 
 (define (r-append opt . rest)
   (append opt (list (list->vector rest))))
@@ -170,34 +170,39 @@
 (err/rt-test (parse-command-line "test" #() null (lambda (x y) null) null) exn:fail?)
 
 (test (void) 'cmdline
-      (command-line "something" #("-ab")
+      (command-line 
-        (once-each
+       #:program "something"
-         [("-a") "ok" 5]
+       #:argv #("-ab")
-         [("-b" "--more") "Help" 7])))
+       #:once-each
+       [("-a") "ok" 5]
+       [("-b" "--more") "Help" 7]))
 
 ;; test that keywords are compared for the literal symbol
 (test "foo" 'cmdline
       (let ([once-each 3] [args "args"])
-        (command-line "something" #("-ab" "foo")
+        (command-line 
-          (once-each
+         #:program "something" 
-           [("-a") "ok" 5]
+         #:argv #("-ab" "foo")
-           [("-b" "--more") "Help" 7])
+         #:once-each
-          (args (x) x))))
+         [("-a") "ok" 5]
+         [("-b" "--more") "Help" 7]
+         #:args
+         (x)
+         x)))
 
-(syntax-test #'(command-line))
+(syntax-test #'(command-line . x))
 (syntax-test #'(command-line "hello"))
-(err/rt-test (command-line 'hello #("ok")))
+(err/rt-test (command-line #:program 'hello #:argv #("ok")))
-(syntax-test #'(command-line "hello" #("ok") (bad)))
+(syntax-test #'(command-line #:program "hello" #:argv #("ok") #:bad))
-(syntax-test #'(command-line "hello" #("ok") (once-any ())))
+(syntax-test #'(command-line #:program "hello" #:argv #("ok") (bad)))
-(syntax-test #'(command-line "hello" #("ok") (once-any ("-ok"))))
+(syntax-test #'(command-line #:program "hello" #:argv #("ok") #:once-any ()))
-(syntax-test #'(command-line "hello" #("ok") (once-any ("-ok" "the ok flag"))))
+(syntax-test #'(command-line #:program "hello" #:argv #("ok") #:once-any [("-ok")]))
-(syntax-test #'(command-line "hello" #("ok") (once-any ("-ok" a "the ok flag"))))
+(syntax-test #'(command-line #:program "hello" #:argv #("ok") #:once-any ["-ok" "the ok flag"]))
-(syntax-test #'(command-line "hello" #("ok") (once-any ("-ok" (a) "the ok flag"))))
+(syntax-test #'(command-line #:program "hello" #:argv #("ok") #:once-any ["-ok" a "the ok flag"]))
-(syntax-test #'(command-line "hello" #("ok") (once-any ("-ok" a "the ok flag") ())))
+(syntax-test #'(command-line #:program "hello" #:argv #("ok") #:once-any [("-ok") #() "the ok flag"]))
-(syntax-test #'(command-line "hello" #("ok") (args 'done) (once-any ("-ok" a "the ok flag" 7))))
+(syntax-test #'(command-line #:program "hello" #:argv #("ok") #:once-any [("-ok") a "the ok flag"] ()))
-(syntax-test #'(command-line "hello" #("ok") (args (ok) 'done) (once-any ("-ok" a "the ok flag" 7))))
+(syntax-test #'(command-line #:program "hello" #:argv #("ok") #:args 'done #:once-any [("-ok") a 7]))
-(syntax-test #'(command-line "hello" #("ok") (=> 'done) (once-any ("-ok" a "the ok flag" 7))))
+(syntax-test #'(command-line #:program "hello" #:argv #("ok") #:args (ok) 'done #:once-any [("-ok") a "the ok flag" 7]))
-(syntax-test #'(command-line "hello" #("ok") (=> 1 2 3 4) (once-any ("-ok" a "the ok flag" 7))))
 
 (err/rt-test (parse-command-line "test" #("x") null (lambda () 'too-few) '("arg")))
 (err/rt-test (parse-command-line "test" #("x") null (lambda (x) 'still-too-few) '("arg")))

pkgs/racket-pkgs/racket-test/tests/racket/compile.rktl

@@ -1,117 +0,0 @@
-
-; Tests compilation and writing/reading compiled code
-;  by setting the eval handler and running all tests
-
-(load-relative "loadtest.rktl")
-
-(namespace-variable-value 
- 'compile-load
- #f
- (lambda ()
-   (namespace-set-variable-value! 'compile-load "mzq.rktl")))
-
-(define file
-  (if #f
-      (open-output-file "x" 'replace)
-      (make-output-port 'nowhere
-			always-evt
-			(lambda (s start end non-block? breakable?) (- end start))
-			void
-			(lambda (special non-block? breakable?) #t)
-			(lambda (s start end) (wrap-evt
-					       always-evt
-					       (lambda (x)
-						 (- end start))))
-			(lambda (special) (wrap-evt always-evt (lambda (x) #t))))))
-
-(define try-one
-  (lambda (e)
-    (let ([c (compile-syntax e)]
-	  [ec (compile-syntax (expand e))]
-	  [p (open-output-bytes)]
-	  [ep (open-output-bytes)])
-      (write c p)
-      (write ec ep)
-      (let ([s (get-output-bytes p)]
-	    [es (get-output-bytes ep)])
-	(unless (equal? s es)
-	  (error 'try "bad expand ~e\n" e))
-	; (write (string->list s)) (newline)
-	(let ([e (parameterize ([read-accept-compiled #t])
-		     (read (open-input-bytes s)))])
-	  (eval e))))))
-
-(letrec ([orig (current-eval)]
-	 [orig-load (current-load)]
-	 [my-load
-	  (lambda (filename expected-module)
-	    (let ([f (open-input-file filename)])
-	      (dynamic-wind
-	       void
-	       (lambda ()
-		 (let loop ([results (list (void))])
-		   (let ([v (parameterize ([read-accept-compiled #t])
-			       (read f))])
-		     (if (eof-object? v)
-			 (apply values results)
-			 (loop (call-with-values
-				(lambda () (my-eval v orig))
-				list))))))
-	       (lambda ()
-		 (close-input-port f)))))]
-	 [my-eval
-	  (case-lambda 
-	   [(x next-eval)
-	    (if (or (compiled-expression? x)
-		    (and (syntax? x) (compiled-expression? (syntax-e x)))
-		    (current-module-declare-name))
-		(next-eval x)
-		(begin
-		  ;; (fprintf file ": ~a\n" +)
-		  ;; (write x file) (newline file)
-		  (let ([p (open-output-bytes)]
-			[ep (open-output-bytes)]
-			[c ((if (syntax? x) compile-syntax compile) x)]
-			[ec (compile-syntax ((if (syntax? x) expand-syntax expand) x))])
-		    (write c p)
-		    (write ec ep)
-		    (let ([s (get-output-bytes p)]
-			  [es (get-output-bytes ep)])
-		      (unless (equal? s es)
-			'(fprintf (current-error-port) "bad expand (~a,~a) ~e\n" 
-				  (bytes-length s) (bytes-length es) x))
-					; (display s file) (newline file)
-		      (let ([e (parameterize ([read-accept-compiled #t])
-				 (read (open-input-bytes s)))])
-					; (write e file) (newline file)
-			(parameterize ([current-eval next-eval])
-			  (orig e)))))))]
-	   [(x) (my-eval x orig)])])
-  (dynamic-wind
-   (lambda ()
-     (set! teval (lambda (x) (my-eval x my-eval)))
-     ; (read-accept-compiled #t)
-     (current-eval my-eval)
-     (current-load my-load))
-   (lambda ()
-     (load-relative compile-load))
-   (lambda ()
-     (set! teval eval)
-     (close-output-port file)
-     ; (read-accept-compiled #f)
-     (current-eval orig)
-     (current-load orig-load))))
-
-; Check compiled number I/O:
-(let ([l (let loop ([n -512][l null])
-	   (if (= n 513)
-	       l
-	       (loop (add1 n) (cons n l))))]
-      [p (open-output-bytes)])
-  (write (compile `(quote ,l)) p)
-  (let ([s (open-input-bytes (get-output-bytes p))])
-    (let ([l2 (parameterize ([read-accept-compiled #t])
-		    (eval (read s)))])
-      (test #t equal? l l2))))
-
-(report-errs)

pkgs/racket-pkgs/racket-test/tests/racket/control.rktl

@@ -8,119 +8,118 @@
 
 (Section 'control)
 
-(require mzlib/control
+(require racket/control)
-         (only-in mzlib/etc rec))
 
-;-----------------------------------------------------------------------
+;;-----------------------------------------------------------------------
 
 (define-syntax ctest
   (syntax-rules ()
     [(_ expr expect)
      (test expect 'expr expr)]))
 
-;-----------------------------------------------------------------------
+;;-----------------------------------------------------------------------
-;                       Shift tests
+;;                       Shift tests
 
 (ctest (+ 10 (reset (+ 2 (shift k (+ 100 (k (k 3)))))))
-      117)
+       117)
 
 (ctest (* 10 (reset (* 2 (shift g (reset 
                                    (* 5 (shift f (+ (f 1) 1))))))))
-      60)
+       60)
 
 (ctest (let ((f (lambda (x) (shift k (k (k x))))))
          (+ 1 (reset (+ 10 (f 100)))))
-      121)
+       121)
 
 (ctest (reset
-       (let ((x (shift f (cons 'a (f '())))))
+        (let ((x (shift f (cons 'a (f '())))))
-         (shift g x)))
+          (shift g x)))
-      '(a))
+       '(a))
 
 (define (shift* p) (shift f (p f)))
 (ctest (reset (let ((x 'abcde)) (eq? x ((shift* shift*) x))))
-      #t)
+       #t)
 
 (define traverse
   (lambda (xs)
     (letrec ((visit
-               (lambda (xs)
+              (lambda (xs)
-                 (if (null? xs)
+                (if (null? xs)
-                   '()
+                    '()
-                   (visit (shift k
+                    (visit (shift k
-                                 (cons (car xs)
+                                  (cons (car xs)
-                                       (k (cdr xs)))))))))
+                                        (k (cdr xs)))))))))
       (reset
        (visit xs)))))
 
 (ctest (traverse '(1 2 3 4 5))
-      '(1 2 3 4 5))
+       '(1 2 3 4 5))
 
-;-----------------------------------------------------------------------
+;;-----------------------------------------------------------------------
-;                       Control tests
+;;                       Control tests
-; Example from Sitaram, Felleisen
+;; Example from Sitaram, Felleisen
 
 (define (abort v) (control k v))
 
 (ctest (let ((g (prompt (* 2 (control k k)))))
-        (* 3 (prompt (* 5 (abort (g 7))))))
+         (* 3 (prompt (* 5 (abort (g 7))))))
-      42)
+       42)
 
-; Olivier Danvy's puzzle
+;; Olivier Danvy's puzzle
 
 (define traverse
   (lambda (xs)
     (letrec ((visit
-               (lambda (xs)
+              (lambda (xs)
-                 (if (null? xs)
+                (if (null? xs)
-                   '()
+                    '()
-                   (visit (control k
+                    (visit (control k
-                                   (cons (car xs) 
+                                    (cons (car xs) 
-                                         (k (cdr xs)))))))))
+                                          (k (cdr xs)))))))))
       (prompt
        (visit xs)))))
 
 (ctest (traverse '(1 2 3 4 5))
-      '(5 4 3 2 1))
+       '(5 4 3 2 1))
 
 (ctest (+ 10 (prompt (+ 2 (control k (+ 100 (k (k 3)))))))
-      117)
+       117)
 
 (ctest (prompt (let ((x (control f (cons 'a (f '()))))) (control g x)))
-      '())
+       '())
 
 (ctest (prompt ((lambda (x) (control l 2))
-               (control l (+ 1 (l 0)))))
+                (control l (+ 1 (l 0)))))
-      2)
+       2)
 (ctest (prompt (control f (cons 'a (f '()))))
-      '(a))
+       '(a))
 (ctest (prompt (let ((x (control f (cons 'a (f '()))))) 
-                (control g (g x))))
+                 (control g (g x))))
-      '(a))
+       '(a))
 
 (define (control* f) (control k (f k)))
 (ctest (prompt (let ((x 'abcde)) (eq? x ((control* control*) x))))
-      #t)
+       #t)
 
-;------------------------------------------------------------------------
+;;------------------------------------------------------------------------
-;                       shift0/control0 tests
+;;                       shift0/control0 tests
 
 (ctest (+ 10 (prompt0 (+ 2 (control k (+ 100 (k (k 3)))))))
-      117)
+       117)
 
 (ctest (prompt0 (prompt0 
-                (let ((x (control f (cons 'a (f '()))))) 
+                 (let ((x (control f (cons 'a (f '()))))) 
-                  (control g x))))
+                   (control g x))))
-      '())
+       '())
 
 (ctest (+ 10 (prompt0 (+ 2 (shift0 k (+ 100 (k (k 3)))))))
-      117)
+       117)
 
 (ctest (prompt0 (cons 'a (prompt0 (shift0 f (shift0 g '())))))
-      '())
+       '())
 
 (ctest (prompt (cons 'a (prompt (shift0 f (shift0 g '())))))
-      '(a))
+       '(a))
 
 
 ;; ----------------------------------------
@@ -154,11 +153,11 @@
                  [else #f]))))))))
 
 (ctest (same-fringe? '(1 . (2 . (3 . 4)))
-                    '(1 . ((2 . 3) . 4)))
+                     '(1 . ((2 . 3) . 4)))
-      #t)
+       #t)
 (ctest (same-fringe? '(1 . (2 . (3 . 4)))
-                    '(1 . ((2 . 5) . 4)))
+                     '(1 . ((2 . 5) . 4)))
-      #f)
+       #f)
 
 (define all-prefixes
   (lambda (l)
@@ -168,12 +167,12 @@
                          (cons (car l)
                                (fcontrol (cdr l)))))])
       (% (loop l)
-         (rec h
+         (letrec ([h (lambda (r k)
-              (lambda (r k)
+                       (if (eq? r 'done)
-                (if (eq? r 'done)
+                           '()
-                    '()
+                           (cons (k '())
-                    (cons (k '())
+                                 (% (k (loop r)) h))))])
-                          (% (k (loop r)) h)))))))))
+           h)))))
 
 (ctest (all-prefixes '(1 2 3 4))
       '((1) (1 2) (1 2 3) (1 2 3 4)))

pkgs/racket-pkgs/racket-test/tests/racket/core-tests.rktl

@@ -17,8 +17,6 @@
 (load-relative "unsafe.rktl")
 (load-relative "object.rktl")
 (load-relative "struct.rktl")
-(load-relative "unit.rktl")
-(load-relative "unitsig.rktl")
 (load-relative "thread.rktl")
 (load-relative "logger.rktl")
 (load-relative "sync.rktl")
@@ -40,8 +38,3 @@
 (unless building-flat-tests?
   (load-relative "name.rktl"))
 (load-relative "srcloc.rktl")
-
-;; Ok, so this isn't really all of them. Here are more:
-; thrport.rktl
-
-; See also README

pkgs/racket-pkgs/racket-test/tests/racket/fact.rktl

@@ -1,6 +0,0 @@
-(define fact
-    (lambda (n)
-      (let loop ([n n][res 1])
-	(if (zero? n)
-	    res
-	    (loop (sub1 n) (* n res))))))

pkgs/racket-pkgs/racket-test/tests/racket/file.rktl

@@ -1,4 +1,4 @@
-(require mzlib/os)
+
 (load-relative "loadtest.rktl")
 
 (Section 'file)

pkgs/racket-pkgs/racket-test/tests/racket/filelib.rktl

@@ -3,9 +3,9 @@
 
 (Section 'filelib)
 
-(require scheme/file
+(require racket/file
-	 mzlib/process
+	 racket/system
-	 mzlib/list)
+	 racket/list)
 
 (define tmp-name "tmp0-filelib")
 (when (file-exists? tmp-name) (delete-file tmp-name))

pkgs/racket-pkgs/racket-test/tests/racket/function.rktl

@@ -2,7 +2,7 @@
 
 (Section 'function)
 
-(require racket/function mzlib/etc)
+(require racket/function)
 
 ;; stuff from racket/base
 
@@ -106,22 +106,6 @@
   (arity-test compose1 0 -1)
   (arity-test compose  0 -1))
 
-;; ---------- rec (from mzlib/etc) ----------
-(let ()
-  (test 3 (rec f (λ (x) 3)) 3)
-  (test 3 (rec f (λ (x) x)) 3)
-  (test 2 (rec f (λ (x) (if (= x 3) (f 2) x))) 3)
-  (test 3 (rec (f x) 3) 3)
-  (test 3 (rec (f x) x) 3)
-  (test 2 (rec (f x) (if (= x 3) (f 2) x)) 3)
-  (test 2 (rec (f x . y) (car y)) 1 2 3)
-  (test 2 'no-duplications
-        (let ([x 1]) (rec ignored (begin (set! x (+ x 1)) void)) x))
-  (test 'f object-name (rec (f x) x))
-  (test 'f object-name (rec (f x . y) x))
-  (test 'f object-name (rec  f (lambda (x) x)))
-  (test (list 2) (rec (f . x) (if (= (car x) 3) (f 2) x)) 3))
-
 ;; ---------- identity ----------
 (let ()
   (test 'foo identity 'foo)

pkgs/racket-pkgs/racket-test/tests/racket/head.rktl

@@ -1,44 +0,0 @@
-
-(load-relative "loadtest.rktl")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; net/head tests
-;;
-
-(require net/head)
-
-(for-each 
- (lambda (addr)
-   (test '("o.gu@racket-lang.com") extract-addresses (car addr) 'address)
-   (test '("o.gu@racket-lang.com" "o.gu@racket-lang.com") extract-addresses 
-	 (format "~a, ~a" (car addr) (car addr))
-	 'address)
-   (test (list (cdr addr)) extract-addresses (car addr) 'name)
-   (for-each 
-    (lambda (addr2)
-      (let ([two (format " ~a, \n\t~a" (car addr) (car addr2))])
-	(test '("o.gu@racket-lang.com" "s.gu@racket-lang.org") extract-addresses two 'address)
-	(test (list (cdr addr) (cdr addr2)) extract-addresses two 'name)))
-    '(("s.gu@racket-lang.org" . "s.gu@racket-lang.org")
-      ("<s.gu@racket-lang.org>" . "s.gu@racket-lang.org")
-      ("s.gu@racket-lang.org (Gu, Sophia)" . "Gu, Sophia")
-      ("s.gu@racket-lang.org (Sophia Gu)" . "Sophia Gu")
-      ("s.gu@racket-lang.org (Sophia \"Sophie\" Gu)" . "Sophia \"Sophie\" Gu")
-      ("Sophia Gu <s.gu@racket-lang.org>" . "Sophia Gu")
-      ("\"Gu, Sophia\" <s.gu@racket-lang.org>" . "\"Gu, Sophia\"")
-      ("\"Gu, Sophia (Sophie)\" <s.gu@racket-lang.org>" . "\"Gu, Sophia (Sophie)\""))))
- '(("o.gu@racket-lang.com" . "o.gu@racket-lang.com")
-   ("<o.gu@racket-lang.com>" . "o.gu@racket-lang.com")
-   ("o.gu@racket-lang.com (Gu, Oliver)" . "Gu, Oliver")
-   ("o.gu@racket-lang.com (Oliver Gu)" . "Oliver Gu")
-   ("o.gu@racket-lang.com (Oliver \"Ollie\" Gu)" . "Oliver \"Ollie\" Gu")
-   ("o.gu@racket-lang.com (Oliver \"Ollie Gu)" . "Oliver \"Ollie Gu")
-   ("Oliver Gu <o.gu@racket-lang.com>" . "Oliver Gu")
-   ("\"Gu, Oliver\" <o.gu@racket-lang.com>" . "\"Gu, Oliver\"")
-   ("\"Gu, Oliver (Ollie)\" <o.gu@racket-lang.com>" . "\"Gu, Oliver (Ollie)\"")
-   ("\"Gu, Oliver (Ollie\" <o.gu@racket-lang.com>" . "\"Gu, Oliver (Ollie\"")
-   ("\"Gu, Oliver (Ollie, himself)\" <o.gu@racket-lang.com>" . "\"Gu, Oliver (Ollie, himself)\"")))
-
-
-(report-errs)

pkgs/racket-pkgs/racket-test/tests/racket/imap.rktl

@@ -1,172 +0,0 @@
-
-(define imap-server "imap.cs.utah.edu")
-(define imap-port-no 993)
-(define username "mflatt")
-(define pw (with-input-from-file (build-path (current-load-relative-directory) "pw")
-	     read))
-(define mailbox-name "INBOX.tmp") ;; !!! ALL CONTENT WILL BE DELETED !!!
-
-(load-relative "loadtest.rktl")
-
-(Section 'imap)
-
-(require openssl/mzssl
-	 net/imap
-	 mzlib/etc)
-
-(define (test-connect)
-  (if (zero? (random 2))
-      (parameterize ([imap-port-number 993])
-        (imap-connect #:tls? #t imap-server username pw mailbox-name))
-      (let ([c (ssl-make-client-context)])
-        (let-values ([(in out) (ssl-connect imap-server imap-port-no c)])
-          (imap-connect* in out username pw mailbox-name)))))
-
-(define-values (imap cnt recent) (test-connect))
-
-(printf "Msgs: ~a; Validity: ~a\n" cnt (imap-uidvalidity imap))
-
-(test cnt imap-messages imap)
-(test recent imap-recent imap)
-(test #t number? (imap-uidvalidity imap))
-(test #f imap-pending-expunges? imap)
-(test #f imap-pending-updates? imap)
-(test #f imap-new? imap)
-
-(imap-disconnect imap)
-(error "comment out these two lines to finish...")
-
-(define (delete-all)
-  (let ([cnt (imap-messages imap)])
-    (unless (zero? cnt)
-      (let ([all (build-list cnt add1)])
-	(test (void) imap-store imap '+ all '|\Deleted|)
-	(test (void) imap-expunge imap)
-	(test #t imap-pending-expunges? imap)
-	(test all imap-get-expunges imap)
-	(test null imap-get-expunges imap)
-	(test #f imap-pending-expunges? imap)))))
-
-(delete-all)
-(test #f imap-new? imap)
-(test 0 imap-messages imap)
-(test '(0 0) 'noop (let-values ([(a b) (imap-noop imap)])
-		     (list a b)))
-(test (void) imap-poll imap)
-(test 0 imap-messages imap)
-(test 0 imap-recent imap)
-
-(test #f imap-new? imap)
-
-(define (add-one content total)
-  (test (void) imap-append imap mailbox-name content)
-  (imap-noop imap)
-  (test total imap-messages imap)
-  (test #t imap-new? imap)
-  (let ([uids (imap-get-messages imap (build-list total add1) '(uid))])
-    (test #t list? uids)
-    (test total length uids)
-    (let ([l (list-ref uids (sub1 total))])
-      (test #t list? l)
-      (test 1 length l)
-      (test #t number? (car l))
-      (car l))))
-  
-
-(define sample-head #"Subject: Hello\r\n\r\n")
-(define sample-body #"Hi there.\r\n")
-
-(let ([uid (add-one (bytes-append sample-head sample-body) 1)])
-  (test (list (list uid 
-		    sample-head
-		    sample-body
-		    '(|\Seen|)))
-	imap-get-messages imap '(1) '(uid header body flags)))
-(test (void) imap-store imap '+ '(1) (list (symbol->imap-flag 'answered)))
-(test (list '((|\Answered| |\Seen|))) imap-get-messages imap '(1) '(flags))
-(test (void) imap-store imap '- '(1) (list (symbol->imap-flag 'answered)))
-(test (list '((|\Seen|))) imap-get-messages imap '(1) '(flags))
-(test (void) imap-store imap '+ '(1) (list (symbol->imap-flag 'deleted)))
-(test (list '((|\Seen| |\Deleted|))) imap-get-messages imap '(1) '(flags))
-(test (void) imap-store imap '! '(1) (list (symbol->imap-flag 'answered)))
-(test (list '((|\Answered|))) imap-get-messages imap '(1) '(flags))
-
-(test #f imap-pending-updates? imap)
-(test null imap-get-updates imap)
-
-;; Test multiple-client access:
-(let ()
-  (define-values (imap2 cnt2 recent2) (test-connect))
-  (test '(1 0) list cnt2 recent2)
-  
-  (let ([uid (add-one (bytes-append sample-head sample-body) 2)])
-    (let loop ([n 5])
-      (when (zero? n)
-	(imap-noop imap2))
-      (imap-poll imap2)
-      (unless (imap-new? imap2)
-	(sleep 0.2)
-	(loop (sub1 n))))
-    (test #t imap-new? imap2)
-    (test 2 imap-messages imap2)
-    (let ([uids (imap-get-messages imap2 '(2) '(uid))])
-      (test uid caar uids)))
-
-  ;; Delete message on imap2, check notifcation to imap
-  (test (void) imap-store imap2 '+ '(2) (list (symbol->imap-flag 'deleted)))
-  (test (void) imap-expunge imap2)
-  (test '(2) imap-get-expunges imap2)
-  (imap-noop imap)
-  (err/rt-test (imap-store imap '+ '(2) (list (symbol->imap-flag 'answered))))
-  (test #t imap-pending-expunges? imap)
-  (test '(2) imap-get-expunges imap)
-
-  ;; Adjust flags on imap2, check notifcation to imap
-  (test #f imap-pending-updates? imap)
-  (test (void) imap-store imap2 '+ '(1) (list (symbol->imap-flag 'deleted)))
-  (imap-noop imap)
-  (test #t imap-pending-updates? imap)
-  (test #t list? (imap-get-updates imap))
-  (test #f imap-pending-updates? imap)
-
-  ;; Check that multiple updates are collapsed:
-  (test (void) imap-store imap2 '- '(1) (list (symbol->imap-flag 'deleted)))  
-  (imap-noop imap)
-  (test #t imap-pending-updates? imap)
-  (test (void) imap-store imap2 '+ '(1) (list (symbol->imap-flag 'deleted)))
-  (test (void) imap-store imap2 '- '(1) (list (symbol->imap-flag 'deleted)))
-  (imap-noop imap)
-  (test #t imap-pending-updates? imap)
-  (test 1 length (imap-get-updates imap))
-  
-  (test (void) imap-reset-new! imap2)
-  (add-one (bytes-append sample-head sample-body) 2)
-  (add-one (bytes-append sample-head sample-body) 3)
-  (add-one (bytes-append sample-head sample-body) 4)
-  (add-one (bytes-append sample-head sample-body) 5)
-  (imap-noop imap2)
-  (test #t imap-new? imap2)
-  (test 5 imap-messages imap)
-  (test 5 imap-messages imap2)
-
-  (test #t list? (imap-get-messages imap '(1 2 3 4 5) '(uid)))
-  (test #t list? (imap-get-messages imap2 '(1 2 3 4 5) '(uid)))
-  
-  ;; Test deleteing multiple messages, and shifts in flag updates
-  (test (void) imap-store imap2 '+ '(2 4) (list (symbol->imap-flag 'deleted)))
-  (test (void) imap-store imap2 '+ '(3 5) (list (symbol->imap-flag 'answered)))
-  (test (void) imap-expunge imap2)
-  (imap-noop imap)
-  (imap-noop imap2)
-  (test #t imap-pending-expunges? imap)
-  (test #t imap-pending-expunges? imap2)
-  (test '(2 4) imap-get-expunges imap)
-  (test '(2 4) imap-get-expunges imap2)
-  (test #t imap-pending-updates? imap)
-  (test '(2 3) map car (imap-get-updates imap))
-
-  (imap-disconnect imap2))
-
-(imap-disconnect imap)
-
-(report-errs)

pkgs/racket-pkgs/racket-test/tests/racket/ktest.rktl

@@ -1,11 +0,0 @@
-(define k 
-  (call-with-current-continuation
-   (lambda (exit)
-     (let loop ((n 60000))
-       (if (zero? n)
-	   (let ((v (call-with-current-continuation (lambda (k) k))))
-	    (if (number? v)
-		v
-		(exit v)))
-	  (- (loop (- n 1)) 1))))))
-

pkgs/racket-pkgs/racket-test/tests/racket/list.rktl

@@ -3,7 +3,7 @@
 
 (Section 'list)
 
-(require scheme/list)
+(require racket/list)
 
 (test (list 1 2 3 4) foldl cons '() (list 4 3 2 1))
 (test (list 1 2 3 4) foldr cons '() (list 1 2 3 4))

pkgs/racket-pkgs/racket-test/tests/racket/load-handler.rkt

@@ -1,6 +1,6 @@
 #lang racket/base
 (require racket/file
-         mzlib/compile)
+         compiler/compile-file)
 
 (provide try-load-handler-now)
 

pkgs/racket-pkgs/racket-test/tests/racket/ltest.rktl

@@ -1,88 +0,0 @@
-(printf "nested loop\n")
-(time
- (let loop ([n 10000])
-  (unless (zero? n)
-      (let loop2 ([m 10])
-	(if (zero? m)
-	    (loop (sub1 n))
-	    (loop2 (sub1 m)))))))
-
-(printf "single loop\n")
-(time
- (let loop ([n 100000])
-   (unless (zero? n)
-	   (loop (sub1 n)))))
-
-(printf "Y loop\n")
-(time
- ((lambda (f n) (f f n))
-  (lambda (loop n)
-    (unless (zero? n)
-	    (loop loop (sub1 n))))
-  100000))
-
-
-(printf "let closure recur\n")
-(time
- (let ([f (lambda (x) (sub1 x))])
-   (let loop ([n 100000])
-     (unless (zero? n)
-	     (loop (f n))))))
-
-(printf "direct closure recur\n")
-(time
- (let loop ([n 100000])
-   (unless (zero? n)
-	   (loop ((lambda (x) (sub1 x)) n)))))
-
-(printf "direct closure recur if\n")
-(time
- (let loop ([n 100000])
-   (if (zero? n)
-       (void)
-       (loop ((lambda (x) (sub1 x)) n)))))
-
-(printf "let closure top-level\n")
-(define loop
- (let ([f (lambda (x) (sub1 x))])
-   (lambda (n)
-     (unless (zero? n)
-	     (loop (f n))))))
-(time (loop 100000))
-
-(printf "direct closure top-level\n")
-(define loop
-  (lambda (n)
-    (unless (zero? n)
-	    (loop ((lambda (x) (sub1 x)) n)))))
-(time (loop 100000))
-
-
-; > (load "ltest.rkt")
-; cpu time: 1820  real time: 1826
-; cpu time: 1420  real time: 1422
-; cpu time: 1960  real time: 1957
-; cpu time: 2630  real time: 2626
-; > (load "ltest.rkt")
-; cpu time: 1790  real time: 1803
-; cpu time: 1430  real time: 1468
-; cpu time: 2150  real time: 2159
-; cpu time: 2820  real time: 2824
-
-; > (load "ltest.rkt")
-; nested loop
-; cpu time: 1750  real time: 1817
-; single loop
-; cpu time: 1430  real time: 1425
-; Y loop
-; cpu time: 1500  real time: 1500
-; let closure recur
-; cpu time: 1830  real time: 1835
-; direct closure recur
-; cpu time: 1790  real time: 1791
-; direct closure recur if
-; cpu time: 1800  real time: 1793
-; let closure top-level
-; cpu time: 1810  real time: 1804
-; direct closure top-level
-; cpu time: 1760  real time: 1758

pkgs/racket-pkgs/racket-test/tests/racket/mzlib-tests.rktl

@@ -1,37 +0,0 @@
-
-; Test MzLib
-; See also pptest.rkt and ztest.rkt
-
-(load-relative "loadtest.rktl")
-(load-in-sandbox "mpair.rktl")
-(load-in-sandbox "etc.rktl")
-(load-in-sandbox "structlib.rktl")
-(load-in-sandbox "async-channel.rktl")
-(load-in-sandbox "restart.rktl")
-(load-in-sandbox "string-mzlib.rktl")
-(load-in-sandbox "pathlib.rktl")
-(load-in-sandbox "filelib.rktl")
-(load-in-sandbox "portlib.rktl")
-(load-in-sandbox "threadlib.rktl")
-(load-in-sandbox "set.rktl")
-(load-in-sandbox "date.rktl")
-(load-in-sandbox "compat.rktl")
-(load-in-sandbox "cmdline.rktl")
-(load-in-sandbox "stream.rktl")
-(load-in-sandbox "sequence.rktl")
-(load-in-sandbox "generator.rktl")
-(load-in-sandbox "pconvert.rktl")
-(load-in-sandbox "pretty.rktl")
-(load-in-sandbox "control.rktl")
-(load-in-sandbox "serialize.rktl")
-(load-in-sandbox "package.rktl")
-(load-in-sandbox "contract-mzlib-test.rktl")
-(load-in-sandbox "sandbox.rktl")
-(load-in-sandbox "shared.rktl")
-(load-in-sandbox "kw.rktl")
-(load-in-sandbox "macrolib.rktl")
-(load-in-sandbox "resource.rktl")
-(load-in-sandbox "syntaxlibs.rktl")
-(load-in-sandbox "subprocess.rktl")
-
-(report-errs)

pkgs/racket-pkgs/racket-test/tests/racket/mzlonglong.c

@@ -1,96 +0,0 @@
-
-#include "escheme.h"
-
-static Scheme_Object *llsize(int argc, Scheme_Object **argv)
-{
-  return scheme_make_integer(sizeof(mzlonglong));
-}
-
-static Scheme_Object *toll(int argc, Scheme_Object **argv)
-{
-  mzlonglong l;
-
-  if (scheme_get_long_long_val(argv[0], &l))
-    return scheme_make_sized_byte_string((char *)&l, sizeof(mzlonglong), 1);
-  else
-    return scheme_false;
-}
-
-static Scheme_Object *toull(int argc, Scheme_Object **argv)
-{
-  umzlonglong l;
-
-  if (scheme_get_unsigned_long_long_val(argv[0], &l))
-    return scheme_make_sized_byte_string((char *)&l, sizeof(umzlonglong), 1);
-  else
-    return scheme_false;
-}
-
-static Scheme_Object *fromll(int argc, Scheme_Object **argv)
-{
-  mzlonglong l;
-
-  if (!SCHEME_BYTE_STRINGP(argv[0])
-      || (SCHEME_BYTE_STRTAG_VAL(argv[0]) != sizeof(mzlonglong)))
-    scheme_wrong_type("long-long-bytes->integer", 
-		      "byte string of mzlonglong size",
-		      0, argc, argv);
-
-
-  l = *(mzlonglong *)SCHEME_BYTE_STR_VAL(argv[0]);
-
-  return scheme_make_integer_value_from_long_long(l);
-}
-
-static Scheme_Object *fromull(int argc, Scheme_Object **argv)
-{
-  umzlonglong l;
-
-  if (!SCHEME_BYTE_STRINGP(argv[0])
-      || (SCHEME_BYTE_STRTAG_VAL(argv[0]) != sizeof(umzlonglong)))
-    scheme_wrong_type("unsigned-long-long-bytes->integer", 
-		      "byte string of mzlonglong size",
-		      0, argc, argv);
-
-
-  l = *(umzlonglong *)SCHEME_BYTE_STR_VAL(argv[0]);
-
-  return scheme_make_integer_value_from_unsigned_long_long(l);
-}
-
-
-
-Scheme_Object *scheme_reload(Scheme_Env *env)
-{
-  scheme_add_global("long-long-size", 
-		    scheme_make_prim_w_arity(llsize, "long-long-size", 0, 0),
-		    env);
-
-  scheme_add_global("integer->long-long-bytes", 
-		    scheme_make_prim_w_arity(toll, "integer->long-long-bytes", 1, 1),
-		    env);
-  scheme_add_global("integer->unsigned-long-long-bytes", 
-		    scheme_make_prim_w_arity(toull, "integer->unsigned-long-long-bytes", 1, 1),
-		    env);
-
-  scheme_add_global("long-long-bytes->integer", 
-		    scheme_make_prim_w_arity(fromll, "long-long-bytes->integer", 1, 1),
-		    env);
-  scheme_add_global("unsigned-long-long-bytes->integer", 
-		    scheme_make_prim_w_arity(fromull, "unsigned-long-long-bytes->integer", 1, 1),
-		    env);
-
-  return scheme_void;
-}
-
-Scheme_Object *scheme_initialize(Scheme_Env *env)
-{
-  /* First load is same as every load: */
-  return scheme_reload(env);
-}
-
-Scheme_Object *scheme_module_name()
-{
-  /* This extension doesn't define a module: */
-  return scheme_false;
-}

pkgs/racket-pkgs/racket-test/tests/racket/mzq.rktl

@@ -1,3 +0,0 @@
-
-(define quiet-load "mz-tests.rktl")
-(load-relative "quiet.rktl")

pkgs/racket-pkgs/racket-test/tests/racket/nch.rktl

@@ -1,30 +0,0 @@
-
-(define (fact n)
-  (if (zero? n)
-      1
-      (* n (fact (- n 1)))))
-
-(define f1000 (fact 1000))
-
-(define (divall n d)
-  (if (<= n 1)
-      d
-      (divall (/ n d) (+ 1 d))))
-
-(define (nch n c)
-  (/ (fact n) (fact (- n c)) (fact c)))
-
-(define (snch n)
-  (letrec ((loop
-	    (lambda (i)
-	      (if (> i n)
-		  0
-		  (+ (nch n i) (loop (+ i 1)))))))
-    (loop 0)))
-
-(define (fsum n)
-  (if (zero? n)
-      1
-      (+ (fact n) (fsum (- n 1)))))
-
-

pkgs/racket-pkgs/racket-test/tests/racket/object-old.rktl

@@ -1,657 +0,0 @@
-
-; Test Racket's object system
-
-(load-relative "loadtest.rktl")
-
-(require mzlib/class)
-
-(Section 'object)
-
-(define (stx-test e)
-  (syntax-test (datum->syntax-object #f e #f)))
-(define (err-test e exn)
-  (error-test (datum->syntax-object #f e #f) exn))
-
-(define (test-class* cl* renames)
-  (stx-test  `(,cl*))
-  (stx-test  `(,cl* ,@renames . x))
-  (stx-test  `(,cl* ,@renames 0))
-  (stx-test  `(,cl* ,@renames object% . x))
-  (stx-test  `(,cl* ,@renames object% 0))
-  (stx-test  `(,cl* ,@renames object% x))
-  (stx-test  `(,cl* ,@renames object% ()))
-  (stx-test  `(,cl* ,@renames object% () (0) x))
-  (stx-test  `(,cl* ,@renames object% () 0))
-  (stx-test  `(,cl* ,@renames object% () . x))
-  (stx-test  `(,cl* ,@renames object% () () . x))
-  (stx-test  `(,cl* ,@renames object% () () x))
-  (stx-test  `(,cl* ,@renames object% () () public))
-  (stx-test  `(,cl* ,@renames object% () () (x)))
-  (stx-test  `(,cl* ,@renames object% () (x) ()))
-
-  (let ()
-    (define (try-dotted cl)
-      (stx-test  `(,cl* ,@renames object% () () (,cl . x))))
-    
-    (map try-dotted '(public override private inherit rename
-			     inherit-from rename-from
-			     sequence)))
-  
-  (let ()
-    (define (try-defn-kind cl)
-      (stx-test  `(,cl* ,@renames object% () () (,cl 8)))
-      (stx-test  `(,cl* ,@renames object% () () (,cl [8 9])))
-      (stx-test  `(,cl* ,@renames object% () () (,cl [(x) 9])))
-      (stx-test  `(,cl* ,@renames object% () () (,cl [(x y x) 9])))
-      (stx-test  `(,cl* ,@renames object% () () (,cl [x . 1])))
-      (stx-test  `(,cl* ,@renames object% () () (,cl [x 1 . 3])))
-      (stx-test  `(,cl* ,@renames object% () () (,cl [x 1 3]))))
-    
-    (try-defn-kind 'public)
-    (try-defn-kind 'override)
-    (try-defn-kind 'private))
-
-  (let ()
-    (define (try-defn-rename-kind cl)
-      (stx-test  `(,cl* ,@renames object% () () (,cl [((x) y) 9])))
-      (stx-test  `(,cl* ,@renames object% () () (,cl [(x (y)) 9])))
-      (stx-test  `(,cl* ,@renames object% () () (,cl [(x . y) 9])))
-      (stx-test  `(,cl* ,@renames object% () () (,cl [(x 1) 9])))
-      (stx-test  `(,cl* ,@renames object% () () (,cl [(1 x) 9]))))
-    (try-defn-rename-kind 'public)
-    (try-defn-rename-kind 'override))
-
-  (let ()
-    (define (try-ref-kind cl)
-      (stx-test  `(,cl* ,@renames object% () () (,cl 8)))
-      (stx-test  `(,cl* ,@renames object% () () (,cl x 8)))
-      (stx-test  `(,cl* ,@renames object% () () (,cl (x . y))))
-      (stx-test  `(,cl* ,@renames object% () () (,cl (x y z)))))
-    
-    (map try-ref-kind '(inherit rename share)))
-  (err-test `(,cl* ,@renames object% () () (inherit x)) exn:object?)
-  (err-test `(,cl* ,@renames object% () () (inherit (x y))) exn:object?)
-  (err-test `(,cl* ,@renames object% () () (override [x void])) exn:object?)
-  (err-test `(,cl* ,@renames object% () () (override [(x y) void])) exn:object?)
-  (stx-test  `(,cl* ,@renames object% () () (inherit (x y z))))
-  (stx-test  `(,cl* ,@renames object% () () (inherit (x 5))))
-  (stx-test  `(,cl* ,@renames object% () () (inherit (x))))
-  (stx-test  `(,cl* ,@renames object% () () (rename x)))
-  (stx-test  `(,cl* ,@renames object% () () (rename (x))))
-  (stx-test  `(,cl* ,@renames object% () () (rename ((x) y))))
-  (stx-test  `(,cl* ,@renames object% () () (rename ((x y) y))))
-  (stx-test  `(,cl* ,@renames object% () () (rename ((1) y))))
-
-  (stx-test  `(,cl* ,@renames object% () () (inherit x) (sequence (set! x 5))))
-  (stx-test  `(,cl* ,@renames object% () () (rename [x y]) (sequence (set! x 5))))
-
-  (stx-test  `(,cl* ,@renames object% () () (sequence 1 . 2)))
-  
-  (stx-test  `(,cl* ,@renames object% () () (public [x 7] [x 9])))
-  (stx-test  `(,cl* ,@renames object% () (x) (public [x 7])))
-  (stx-test  `(,cl* ,@renames object% () (x) (public [(x w) 7])))
-  (stx-test  `(,cl* ,@renames object% () () (public [(x y) 7] [(z y) 9])))
-  (stx-test  `(,cl* ,@renames object% () () (public [(x y) 7] [(x z) 9])))
-
-  (stx-test  `(,cl* ,@renames object% a ()))
-  (stx-test  `(,cl* ,@renames object% (1 . a) ())))
-
-(test-class* 'class* ())
-(test-class* 'class*/names '((this super)))
-
-(stx-test #'(class*/names 8 object% () () ()))
-(stx-test #'(class*/names () object% () ()))
-(stx-test #'(class*/names (8) object% () ()))
-(stx-test #'(class*/names (this . 8) object% () ()))
-(stx-test #'(class*/names (this 8) object% () ()))
-(stx-test #'(class*/names (this super-init . 8) object% () ()))
-(stx-test #'(class*/names (this super-init 8) object% () ()))
-
-(test #t class? (class* object% () ()))
-(test #t class? (class* object% () ()))
-(test #t class? (class* object% () x))
-(test #t class? (class* object% () () (public)))
-(test #t class? (class* object% () () (public sequence)))
-(test #t class? (class* object% () (x) (public [(y x) 9])))
-(test #t class? (class*/names (this super-init) object% () () (public)))
-
-(define c (class object% () (public x)))
-(err/rt-test (class c () (public x)) exn:object?)
-(err/rt-test (class c () (public ([y x] 5))) exn:object?)
-(err/rt-test (class c () (override ([x y] 5))) exn:object?)
-
-(stx-test #'(interface))
-(stx-test #'(interface . x))
-(stx-test #'(interface 8))
-(stx-test #'(interface () 8))
-(stx-test #'(interface () x . y))
-(stx-test #'(interface () x 8))
-(stx-test #'(interface () x x))
-(err/rt-test (interface (8) x) exn:object?)
-
-(err/rt-test (interface ((class->interface (class object% ()))
-			 (class->interface (class object% ()))))
-	    exn:object?)
-
-(err/rt-test (interface ((interface () x)) x) exn:object?)
-(err/rt-test (interface ((interface ((interface () x)) y)) x) exn:object?)
-(test #t interface? (let ([i (interface () x)]
-			  [j (interface () x)])
-		      (interface (i j) y)))
-(err/rt-test (let ([i (interface () x)]
-		   [j (interface () x)])
-	       (interface (i j) x))
-	    exn:object?)
-(err/rt-test (interface ((class->interface (class object% () (public w)))) w)
-	    exn:object?)
-
-(test #t interface? (interface ()))
-(test #t interface? (interface () x))
-(test #f interface? (class* object% () ()))
-
-(define i0.1 (interface () x y))
-(define i0.2 (interface () y c d))
-(define i1 (interface (i0.1 i0.2) e))
-(define ix (interface () x y))
-
-(test #t interface-extension? i1 i0.1)
-(test #t interface-extension? i1 i0.2)
-(test #f interface-extension? i0.1 i1)
-(test #f interface-extension? i0.2 i1)
-(test #f interface-extension? i0.2 i0.1)
-(test #f interface-extension? i0.1 i0.2)
-
-(err/rt-test (let [(bad (class* object% (i0.1) ()))] bad) exn:object?)
-(test #t class? (class* object% (i0.1) () (public x y)))
-(err/rt-test (let ([cl (class* object% (i0.1 i0.2) () (public x y c))]) cl) exn:object?)
-(err/rt-test (class* object% (i1) () (public x y c)) exn:object?)
-(test #t class? (class* object% (i0.1 i0.1) () (public x y c d)))
-(err/rt-test (class* object% (i1) () (public x y c d)) exn:object?)
-(test #t class? (class* object% (i1) () (public x y c d e)))
-
-; No initialization:
-(define no-init-c% (class* object% () ()))
-(err/rt-test (make-object no-init-c%) exn:object?)
-
-(define c1 
-  (let ((v 10))
-    (class* object% (i1) (in [in-2 'banana] . in-rest)
-	   (public (x 1) (y 2))
-	   (private (a in) (b3 3))
-	   (public (b1 2) (b2 2) (e 0))
-	   (public (c 3) (d 7)
-		   (f-1-a (lambda () a))
-		   (f-1-b1 (lambda () b1))
-		   (f-1-b2 (lambda () b2))
-		   (f-1-c (lambda () c))
-		   (f-1-v (lambda () v))
-		   (f-1-x (lambda () x))
-		   (f-1-top-a (lambda () (ivar this a)))
-		   (f-1-other-e (lambda (o) (ivar o e)))
-		   (f-1-set-b2 (lambda (v) (set! b2 v) b2))
-		   (f-1-in-2 (lambda () in-2))
-		   (f-1-in-rest (lambda () in-rest)))
-	   (sequence
-	     (set! e in)
-	     (super-init)))))
-  
-(test #t implementation? c1 i0.1)
-(test #t implementation? c1 i0.2)
-(test #t implementation? c1 (class->interface c1))
-(test #t implementation? c1 i1)
-(test #f implementation? c1 ix)
-
-(test #t implementation? object% (class->interface object%))
-(test #t implementation? c1 (class->interface c1))
-(test #t implementation? (class c1 ()) (class->interface c1))
-(let ([i (interface ((class->interface c1)))])
-  (test #f implementation? c1 i)
-  (test #t implementation? (class* c1 (i) ()) i))
-
-(define o1 (make-object c1 0 'apple "first" "last"))
-
-(define c2 
-  (let ((v 20))
-    (class c1 ()
-	   (inherit b2 (sup-set-b2 f-1-set-b2))
-	   (rename (also-e e)
-		   (also-b2 b2))
-	   (override (b1 5) (c 6))
-	   (public (a 4)
-		   (f-2-a (lambda () a))
-		   (f-2-b1 (lambda () b1))
-		   (f-2-b2 (lambda () b2))
-		   (f-2-also-b2 (lambda () also-b2))
-		   (f-2-c (lambda () c))
-		   ((i-f-2-v f-2-v) (lambda () v))
-		   (f-2-v-copy (lambda () (i-f-2-v)))
-		   (f-2-set-b2 (lambda (v) (sup-set-b2 v))))
-	   (private (y 3))
-	   (sequence
-	     (super-init 1)))))
-
-(test #t implementation? c2 i0.1)
-(test #t implementation? c2 i0.2)
-(test #t implementation? c2 i1)
-(test #f implementation? c2 ix)
-(test #t implementation? c2 (class->interface c2))
-(test #t implementation? c2 (class->interface c1))
-(test #f implementation? c1 (class->interface c2))
-
-(test #t interface-extension? (class->interface c2) (class->interface object%))
-(test #t interface-extension? (class->interface c2) (class->interface c1))
-(test #t interface-extension? (class->interface c2) (class->interface c2))
-(test #f interface-extension? (class->interface c1) (class->interface c2))
-(test #t interface-extension? (class->interface c2) i0.1)
-(test #f interface-extension? i0.1 (class->interface c2))
-
-(define o2 (make-object c2))
-
-(define c2.1
-  (class*/names (this c2-init) c2 () ()
-	  (sequence
-	    (c2-init))))
-
-(define o2.1 (make-object c2.1))
-
-(test #t interface? (interface ((class->interface c2)
-				(class->interface c2.1))))
-
-(define c3
-  (class* object% () ()
-	  (public (x 6) (z 7) (b2 8)
-		  (f-3-b2 (lambda () b2)))
-	  (sequence (super-init))))
-
-(define o3 (make-object c3))
-
-(define c6
-  (class object% (x-x)
-    (public
-     [(i-a x-a) (lambda () 'x-a)]
-     [(x-a i-a) (lambda () 'i-a)]
-     [(i-x x-x) (lambda () 'x-x)]
-     [x-a-copy (lambda () (i-a))]
-     [i-a-copy (lambda () (x-a))])
-    (sequence (super-init))))
-
-(define o6 (make-object c6 'bad))
-
-(define c7
-  (class*/names (self super-init) object% () ()
-    (public
-     [get-self (lambda () self)])
-    (sequence (super-init))))
-
-(define o7 (make-object c7))
-
-(define display-test 
-  (lambda (p v)
-    (printf "Should be ~s: ~s ~a\n"
-	    p v (if (equal? p v)
-		    ""
-		    "ERROR"))))
-
-(define ivar? exn:object?)
-
-(test #t is-a? o1 c1)
-(test #t is-a? o1 i1)
-(test #t is-a? o1 (class->interface c1))
-(test #f is-a? o1 (interface ((class->interface c1))))
-(test #t is-a? o2 c1)
-(test #t is-a? o2 i1)
-(test #f is-a? o1 c2)
-(test #f is-a? o1 (class->interface c2))
-(test #t is-a? o2 c2)
-(test #t is-a? o2.1 c1)
-(test #f is-a? o1 c3)
-(test #f is-a? o2 c3)
-(test #f is-a? o1 ix)
-(test #f is-a? o2 ix)
-(test #f is-a? o3 i1)
-(test #f is-a? i1 i1)
-(test #t subclass? c2 c1)
-(test #t subclass? c2.1 c1)
-(test #f subclass? c1 c2)
-(test #f subclass? c1 c3)
-(test #f subclass? i1 c3)
-(test #t ivar-in-interface? 'f-1-a (class->interface c1))
-(test #t ivar-in-interface? 'f-1-a (class->interface c2))
-(test #f ivar-in-interface? 'f-2-a (class->interface c1))
-(test #t ivar-in-interface? 'f-2-a (class->interface c2))
-(test #t ivar-in-interface? 'x i0.1)
-(test #t ivar-in-interface? 'x i1)
-(test #f ivar-in-interface? 'x i0.2)
-(test #f ivar-in-interface? 'c i0.1)
-(test #t ivar-in-interface? 'c i0.2)
-(test #t ivar-in-interface? 'c i1)
-(test #f ivar-in-interface? 'zzz i1)
-(test #t ivar-in-interface? 'f-1-a (class->interface c2))
-(test #t ivar-in-interface? 'f-1-a (interface ((class->interface c2)) one-more-method))
-(test #f ivar-in-interface? 'f-2-a (class->interface c1))
-
-(err/rt-test (is-a? o1 o1))
-(err/rt-test (subclass? o1 o1))
-(err/rt-test (subclass? o1 i1))
-(err/rt-test (implementation? o1 o1))
-(err/rt-test (implementation? o1 c1))
-(err/rt-test (ivar-in-interface? 0 i1))
-(err/rt-test (ivar-in-interface? 'a o1))
-(err/rt-test (ivar-in-interface? 'a c1))
-(err/rt-test (ivar-in-interface? 'a o1))
-
-(define (test/list l1 l2)
-  (test #t 'ivar-list (and (= (length l1)
-			      (length l2))
-			   (andmap (lambda (i) (member i l2))
-				   l1)
-			   #t)))
-
-(test/list '(hi there)
-	   (interface->ivar-names 
-	    (interface () hi there)))
-(test/list '(hi too mee there)
-	   (interface->ivar-names 
-	    (interface ((interface () hi there)) mee too)))
-(test/list '(hi too mee z y there) 
-	   (interface->ivar-names 
-	    (interface ((interface ((class->interface 
-				     (class object% () 
-				       (public y z)
-				       (private nono)))) 
-			  hi there)) 
-	      mee too)))
-
-
-(test 0 class-initialization-arity object%)
-(test #t arity-at-least? (class-initialization-arity c1))
-(test 1 arity-at-least-value (class-initialization-arity c1))
-(test 0 class-initialization-arity c2)
-
-(test '(1 2) class-initialization-arity (class object% (a [b 2])))
-
-(arity-test object? 1 1)
-(arity-test class? 1 1)
-(arity-test interface? 1 1)
-(arity-test is-a? 2 2)
-(arity-test subclass? 2 2)
-(arity-test interface-extension? 2 2)
-(arity-test ivar-in-interface? 2 2)
-(arity-test class-initialization-arity 1 1)
-
-(arity-test ivar/proc 2 2)
-(arity-test make-generic/proc 2 2)
-
-(err/rt-test (ivar o1 a) ivar?)
-(test 4 ivar/proc o2 'a)
-
-(define (ivar-tests -ivar xtra-ok?)
-  (stx-test  `(,-ivar))
-  (stx-test  `(,-ivar 7))
-  (stx-test  `(,-ivar 7 8))
-  (stx-test  `(,-ivar 7 (x)))
-  (stx-test  `(,-ivar 7 8 9))
-  (unless xtra-ok?
-    (stx-test  `(,-ivar 7 x 9))))
-(ivar-tests 'ivar #f)
-(ivar-tests 'send #t)
-(ivar-tests 'make-generic #f)
-
-(test 0 'send (send o1 f-1-a))
-(test 1 'send (send o2 f-1-a))
-(test 4 'send (send o2 f-2-a))
-
-(test 'apple 'send (send o1 f-1-in-2))
-(test 'banana 'send (send o2 f-1-in-2))
-(test '("first" "last") 'send (send o1 f-1-in-rest))
-(test '() 'send (send o2 f-1-in-rest))
-
-(err/rt-test (send o1 f-1-top-a) ivar?)
-(test 4 'send (send o2 f-1-top-a))
-
-(test 5 ivar/proc o2 'b1)
-
-(test 2 'send (send o1 f-1-b1))
-(test 2 'send (send o1 f-1-b2))
-(test 5 'send (send o2 f-1-b1))
-(test 2 'send (send o2 f-1-b2))
-(test 5 'send (send o2 f-2-b1))
-(test 2 'send (send o2 f-2-b2))
-(test 2 'send (send o2 f-2-also-b2))
-
-(test 3 ivar/proc o1 'c)
-(test 6 ivar/proc o2 'c)
-
-(test 3 'send (send o1 f-1-c))
-(test 6 'send (send o2 f-1-c))
-(test 6 'send (send o2 f-2-c))
-
-(test 7 ivar/proc o1 'd)
-(test 7 ivar/proc o2 'd)
-
-(test 10 'send (send o1 f-1-v))
-(test 10 'send (send o2 f-1-v))
-(test 20 'send (send o2 f-2-v))
-(test 20 'send (send o2 f-2-v-copy))
-
-(err/rt-test (ivar o2 i-f-2-v) ivar?)
-
-(test 0 'send (send o1 f-1-other-e o1))
-(test 1 'send (send o1 f-1-other-e o2))
-
-(test 2 ivar/proc o2 'y)
-
-(test 3 'send (send o2 f-2-set-b2 3))
-(test 3 'send (send o2 f-2-also-b2))
-
-(test 'i-a 'send (send o6 i-a))
-(test 'x-a 'send (send o6 x-a))
-(test 'i-a 'send (send o6 i-a-copy))
-(test 'x-a 'send (send o6 x-a-copy))
-(test 'x-x 'send (send o6 x-x))
-
-(test #t eq? o7 (send o7 get-self))
-
-(define g1 (make-generic c1 x))
-(test 1 g1 o1)
-(test 1 g1 o2)
-(arity-test g1 1 1)
-
-(err/rt-test (make-generic c1 www)  exn:object?)
-
-(define g2 (make-generic c2 x))
-(test 1 g2 o2)
-
-(define g0 (make-generic i0.1 x))
-(test 1 g0 o1)
-(test 1 g0 o2)
-(arity-test g0 1 1)
-(test 'hi g0 (make-object (class* object% (i0.1) () 
-				  (public [x 'hi][y 'bye])
-				  (sequence (super-init)))))
-
-(err/rt-test (make-generic i0.1 www) exn:object?)
-
-(err/rt-test (g2 o1) exn:object?)
-(err/rt-test (g0 o3) exn:object?)
-
-(err/rt-test (class* 7 () ()) exn:object?)
-(err/rt-test (class* null () ()) exn:object?)
-(err/rt-test (let ([c (class* 7 () ())]) c) exn:object?)
-(err/rt-test (class* object% (i1 7) ()) exn:object?)
-(err/rt-test (let ([c (class* object% (i1 7) ())]) c) exn:object?)
-(err/rt-test (interface (8) x) exn:object?)
-(err/rt-test (let ([i (interface (8) x)]) i) exn:object?)
-(err/rt-test (interface (i1 8) x) exn:object?)
-(err/rt-test (make-generic c2 not-there) exn:object?)
-
-(err/rt-test (make-object (class* c1 () ())) exn:object?)
-(err/rt-test (make-object (let ([c (class* c1 () ())]) c)) exn:object?)
-
-(err/rt-test (make-object 
-	      (class* c2 () () (sequence (super-init) (super-init)))) 
-	    exn:object?)
-(err/rt-test (make-object 
-	      (let ([c (class* c2 () () (sequence (super-init) (super-init)))]) c))
-	    exn:object?)
-
-(err/rt-test (make-object (class object% (x))) exn:application:arity?)
-(err/rt-test (make-object (let ([c (class object% (x))]) c)) exn:application:arity?)
-	      
-
-(define c100
-  (let loop ([n 99][c (class c1 args (public [z -1]) (sequence (apply super-init args)))])
-    (if (zero? n)
-	c
-	(loop (sub1 n) (class c args 
-			      (override (z n))
-			      (sequence
-				(apply super-init args)))))))
-
-(define o100 (make-object c100 100))
-(test 100 'send (send o100 f-1-a))
-(test 1 'ivar (ivar o100 z))
-
-(test 5 'init (let ([g-x 8]) (make-object (class* object% () ([x (set! g-x 5)]) (sequence (super-init)))) g-x))
-(test 8 'init (let ([g-x 8]) (make-object (class* object% () ([x (set! g-x 5)]) (sequence (super-init))) 0) g-x))
-
-(test (letrec ([x x]) x) 'init (send (make-object 
-				      (class* object% () ([x y] [y x]) 
-					      (public (f (lambda () x)))
-					      (sequence (super-init))))
-				     f))
-
-(define inh-test-expr
- (lambda (super derive-pre? rename? override? override-pre?)
-   (let* ([order
-	   (lambda (pre? a b)
-	     (if pre?
-		 (list a b)
-		 (list b a)))]
-	  [base-class
-	   `(class ,(if super
-			super
-			'(class object% (n) 
-				(public [name (lambda () n)])
-				(sequence (super-init))))
-		   ()
-		   ,(if (not rename?)
-			'(inherit name)
-			'(rename [super-name name]))
-		   ,@(order
-		      derive-pre?
-		      `(public [w ,(if rename? 'super-name 'name)])
-		      '(sequence (super-init 'tester))))])
-     `(ivar
-       (make-object
-	,(if override?
-	     `(class ,base-class ()
-		     ,@(order
-			override-pre?
-			'(sequence (super-init))
-			'(override [name (lambda () 'o-tester)])))
-	     base-class))
-       w))))
-
-(define (do-override-tests super)
-  (define (eval-test v e)
-    (teval `(test ,v (quote, e)
-		  (let ([v ,e]) 
-		    (if (procedure? v)
-			(v)
-			v)))))
-
-  (eval-test '(letrec ([x x]) x) (inh-test-expr super #t #f  #f #f))
-  (eval-test '(letrec ([x x]) x) (inh-test-expr super #t #f  #t #t))
-  (eval-test '(letrec ([x x]) x) (inh-test-expr super #f #f  #t #t))
-
-  (eval-test '(letrec ([x x]) x) (inh-test-expr super #t #t  #f #f))
-  (eval-test '(letrec ([x x]) x) (inh-test-expr super #t #t  #t #f))
-  (eval-test '(letrec ([x x]) x) (inh-test-expr super #t #t  #t #t))
-  
-  (eval-test ''tester (inh-test-expr super #f #f  #f #f))
-  (eval-test ''o-tester (inh-test-expr super #t #f  #t #f))
-  (eval-test ''o-tester (inh-test-expr super #f #f  #t #f))
-
-  (eval-test ''tester (inh-test-expr super #f #t  #f #f))  
-  (eval-test ''tester (inh-test-expr super #f #t  #t #t))
-  (eval-test ''tester (inh-test-expr super #f #t  #t #f)))
-
-(do-override-tests #f)
-
-'(when (defined? 'primclass%)
-  (err/rt-test (make-object primclass%) exn:application:arity?)
-  (err/rt-test (make-object primsubclass%) exn:application:arity?)
-
-  (let ()
-    (define o (make-object primclass% 'tester))
-    (arity-test (ivar o name) 0 0)
-    (test 'tester (ivar o name))
-    (test "primclass%" (ivar o class-name))
-    
-    (let ()
-      (define o2 (make-object primsubclass% 'tester))
-      (arity-test (ivar o2 name) 0 0)
-      (arity-test (ivar o2 detail) 0 0)
-      (test 'tester (ivar o2 name))
-      (test #f (ivar o2 detail))
-      (test "primsubclass%" (ivar o2 class-name))
-      
-      (do-override-tests 'primclass%)
-      (do-override-tests 'primsubclass%)
-
-      (let ()
-	(define name-g (make-generic primclass% name))
-	(define class-name-g (make-generic primclass% class-name))
-	
-	(define sub-name-g (make-generic primsubclass% name))
-	(define sub-class-name-g (make-generic primsubclass% class-name))
-	(define sub-detail-g (make-generic primsubclass% detail))
-	
-	(test 'tester (name-g o))
-	(test "primclass%" (class-name-g o))
-	
-	(test 'tester (name-g o2))
-	(test "primsubclass%" (class-name-g o2))
-	(test 'tester (sub-name-g o2))
-	(test "primsubclass%" (sub-class-name-g o2))
-	(test #f (sub-detail-g o2))
-
-	(let ()
-	  (define c%
-	    (class primsubclass% ()
-	      (inherit name detail class-name)
-	      (sequence (super-init 'example))
-	      (public
-		[n name]
-		[d detail]
-		[c class-name])))
-
-	  (define o3 (make-object c%))
-	  (test 'example (ivar o3 n))
-	  (test #f (ivar o3 d))
-	  (test "primsubclass%" (ivar o3 c))
-	  (test 'example (ivar o3 name))
-	  (test #f (ivar o3 detail))
-	  (test "primsubclass%" (ivar o3 class-name))
-
-	  (test 'example (name-g o3))
-	  (test "primsubclass%" (class-name-g o3))
-	  (test 'example (sub-name-g o3))
-	  (test "primsubclass%" (sub-class-name-g o3))
-	  (test #f (sub-detail-g o3)))))))
-
-
-; Test for override/rename order
-(define bsc (class object% ()
-		   (public [x (lambda () 10)])
-		   (sequence (super-init))))
-(define orc (class bsc ()
-	      (public [y (lambda () (super-x))])
-	      (override [x (lambda () 20)])
-	      (rename [super-x x])
-	      (sequence (super-init))))
-(test 10 (ivar (make-object orc) y))
-
-(report-errs)
-

pkgs/racket-pkgs/racket-test/tests/racket/object.rktl

@@ -1,7 +1,7 @@
 
 (load-relative "loadtest.rktl")
 
-(require scheme/class)
+(require racket/class)
 
 (Section 'object)
      
@@ -1361,8 +1361,9 @@
   (define class-taint-%%-init (gensym 'class-taint-%%-init))
   (define class-taint-%%-client (gensym 'class-taint-%%-client))
   (teval
-   `(module ,class-taint-%%-init mzscheme
+   `(module ,class-taint-%%-init racket/base
-      (require mzlib/class)
+      (require racket/class
+               (for-syntax racket/base))
       (define-syntax (init-private stx)
 	(syntax-case stx ()
 	  [(_ name value)
@@ -1372,11 +1373,11 @@
 		 (,form (,(if rename? '(internal-name name) 'internal-name)
 			 value))
 		 (define name internal-name)))]))
-      (provide (all-defined))))
+      (provide (all-defined-out))))
   ;; Shouldn't fail with a taint erorr:
   (teval
-   `(module ,class-taint-%%-client mzscheme
+   `(module ,class-taint-%%-client racket/base
-      (require mzlib/class
+      (require racket/class
 	       ',class-taint-%%-init)
       (define taint-error%
 	(class object%
@@ -1639,6 +1640,10 @@
                    (if d-cycle?
                        (display this p)
                        (display "HI" p)))
+                 (define/public (custom-print p) 
+                   (if d-cycle?
+                       (print this p)
+                       (display "HI" p)))
                  (super-new)))
 
     (let ([p (open-output-bytes)])

pkgs/racket-pkgs/racket-test/tests/racket/oe.rktl

@@ -1,42 +0,0 @@
-(define-values (odd) (lambda (x) (if (zero? x) #f (even (- x 1)))))
-(define-values (even) (lambda (x) (if (zero? x) #t (odd (- x 1)))))
-
-(define-values (odd2)
-  (letrec ([even (lambda (x) (if (zero? x) #t (odd (- x 1))))]
-	   [odd (lambda (x) (if (zero? x) #f (even (- x 1))))])
-    odd))
-
-(define-values (odd3)
-  (let ([test (lambda (base other)
-		(lambda (x) (if (zero? x) base ((other) (- x 1)))))])
-    (letrec ([odd (test #f (lambda () even))]
-	     [even (test #t (lambda () odd))])
-      odd)))
-
-(define-values (fib)
-  (lambda (n)
-    (if (<= n 1)
-	1
-	(+ (fib (- n 1)) (fib (- n 2))))))
-
-(define-values (mutate)
-  (lambda (n)
-    (let loop ()
-      (unless (zero? n)
-	      (set! n (sub1 n))
-	      (loop)))))
-
-(define-values (mutate-evil)
-  (lambda (n)
-    (let loop ([n n])
-      (unless (zero? n)
-	      (set! n (sub1 n))
-	      (loop n)))))
-
-(define-values (c-loop)
-  (let-values ([(a b c d e f g) (values 1 2 3 4 5 6 7)])
-    (lambda (n)
-      (let loop ([n n])
-	(if (zero? n)
-	    (+ a b c d e f g)
-	    (loop (sub1 n)))))))

pkgs/racket-pkgs/racket-test/tests/racket/pack.rktl

@@ -8,9 +8,9 @@
 
 (require setup/pack
 	 setup/unpack
-	 mzlib/process
+	 racket/system
 	 setup/dirs
-	 mzlib/file)
+	 racket/file)
 
 ;; Test via mzc interface
 

pkgs/racket-pkgs/racket-test/tests/racket/package-gen.rktl

@@ -1,130 +0,0 @@
-
-(require scheme/package
-	 mzlib/pretty
-	 syntax/toplevel)
-
-(define (check x)
-  (unless (equal? x 'this-is-right)
-    (error "check" "nopde: ~e" x)))
-
-(define open-context-forms
-  (list (lambda (l) `(begin ,@l))
-	(lambda (l) `(let () ,@l))
-	(lambda (l) `(define-package other () ,@l))))
-
-(define open-forms
-  (apply
-   append
-   (map
-    (lambda (open-form)
-      (map (lambda (ctx)
-	     (ctx `((,open-form pk-to-open) (check var-to-use))))
-	   open-context-forms))
-    (list 'open-package 'open*-package))))
-
-(define (mk-package-shell-forms name)
-  (list (lambda (body) `(define-package ,name #:all-defined ,@body))
-	(lambda (body) `(define-package ,name (var-to-use) ,@body))))
-
-(define package-shell-forms
-  (mk-package-shell-forms 'pk-to-open))
-
-(define defn-forms
-  (list '(define var-to-use 'this-is-right)
-	'(define* var-to-use 'this-is-right)
-	'(begin
-	    (define* var-to-use 'this-is-wrong)
-	    (define* var-to-use 'this-is-right))))
-
-(define body-forms
-  (apply
-   append
-   (map (lambda (body-ctx)
-	  (map body-ctx defn-forms))
-	(list
-	 (lambda (d) `(,d))
-	 (lambda (d) `((begin ,d)))
-	 (lambda (d) `((define y 'no-this-one) ,d))
-	 (lambda (d) `(,d (define y 'no-this-one)))))))
-
-
-(define package-forms
-  (apply 
-   append
-   (map
-    (lambda (ps)
-      (map ps body-forms))
-    package-shell-forms)))
-
-(define combo-context-forms
-  (list (lambda (p o) `(begin ,p ,o))
-	(lambda (p o) `(let () ,p ,o 10))
-	(lambda (p o) `(define-package out1 #:all-defined ,p ,o))
-	(lambda (p o) `(define-package out2 #:all-defined (define-package out1 #:all-defined ,p ,o)))))
-
-(define all-forms
-  (apply
-   append
-   (map (lambda (cc)
-	  (apply
-	   append
-	   (map (lambda (p)
-		  (map (lambda (o)
-			 (cc p o))
-		       open-forms))
-		package-forms)))
-	combo-context-forms)))
-
-(define do-threshold 3)
-
-(let ([ns (current-namespace)]
-      [total (length all-forms)]
-      [cnt 0])
-  (for-each (lambda (form)
-	      (set! cnt (add1 cnt))
-	      (when (zero? (modulo cnt 100))
-		(printf "~a/~a\n" cnt total))
-	      (when ((add1 (random 10)) . >= . do-threshold)
-                ;; (pretty-print form)
-		(parameterize ([current-namespace (make-base-namespace)])
-		  (namespace-attach-module ns 'scheme/package)
-		  (let ([done? #f]
-			[mode "top-level"])
-		    (with-handlers ([exn:fail?
-				     (lambda (x)
-				       (printf "At ~a:\n" mode)
-				       (pretty-print form)
-				       (raise x))])
-		      (eval `(require scheme/package))
-		      (eval `(define check ,(lambda (x)
-					      (check x)
-					      (set! done? #t))))
-		      (eval form)
-		      (unless done?
-			(error "check" "didn't execute"))
-		      (set! done? #f)
-		      (set! mode "top-level expand")
-		      (eval-syntax (expand-top-level-with-compile-time-evals 
-				    (datum->syntax #f form)))
-		      (unless done?
-			(error "check" "didn't execute after expand"))
-		      (let ([mod (lambda (name)
-				   `(module ,name scheme/base
-				      (require scheme/package)
-				      (define check ,(lambda (x)
-						       (check x)
-						       (set! done? #t)))
-				      ,form))])
-			(set! done? #f)
-			(set! mode "module")
-			(eval (mod 'm))
-			(eval `(require 'm))
-			(unless done?
-			  (error "check" "module didn't execute"))
-			(set! done? #f)
-			(set! mode "module expand")
-			(eval-syntax (expand (mod 'n)))
-			(eval `(require 'n))
-			(unless done?
-			  (error "check" "module didn't execute after expand"))))))))
-	    all-forms))

pkgs/racket-pkgs/racket-test/tests/racket/runflats.rktl

@@ -1,12 +0,0 @@
-(for-each (lambda (f)
-	    (when (regexp-match "^flat-[0-9]+[.]ss$" (path->string f))
-              (let ([ns (current-namespace)])
-                (parameterize ([current-namespace (make-base-namespace)]
-                               [exit-handler void])
-                  (namespace-attach-module ns 'scheme)
-                  (namespace-require 'scheme)
-                  (eval
-                   `(begin
-                      (define quiet-load ,(path->string f))
-                      (load-relative "quiet.rktl")))))))
-	  (directory-list))

pkgs/racket-pkgs/racket-test/tests/racket/serialize.rktl

@@ -298,7 +298,7 @@
 ;; ----------------------------------------
 
 (module ser-mod mzscheme
-   (require mzlib/serialize)
+   (require racket/serialize)
    (provide ser-mod-test)
 
    (define-serializable-struct foo (a b))
@@ -312,7 +312,7 @@
 ;; ----------------------------------------
 ;; Classes
 
-(require mzlib/class)
+(require racket/class)
 
 (define-serializable-class s:c% object%
   (init-field [one 0])

pkgs/racket-pkgs/racket-test/tests/racket/sp.rktl

@@ -1,44 +0,0 @@
-
-(load-relative "testing.rktl")
-
-(require mzlib/process)
-
-(Section 'subprocess)
-
-(define self
-  (parameterize ([current-directory (find-system-path 'orig-dir)])
-    (find-executable-path (find-system-path 'exec-file) #f)))
-
-(unless (eq? 'windows (system-type))
-  (let ([try
-         (lambda (post-shutdown?)
-           (let ([l (parameterize ([subprocess-group-enabled (not post-shutdown?)])
-                      (process* self
-                                "-e"
-                                (format "(define l (process* \"~a\" \"-e\" \"(let loop () (loop))\"))" self)
-                                "-e"
-                                "(displayln (list-ref l 2))"
-                                "-e"
-                                "(flush-output)"
-                                "-e"
-                                "(let loop () (loop))"))]
-                 [running? (lambda (sub-pid)
-                             (regexp-match?
-                              (format "(?m:^ *~a(?=[^0-9]))" sub-pid)
-                              (let ([s (open-output-string)])
-                                (parameterize ([current-output-port s]
-                                               [current-input-port (open-input-string "")])
-                                  (system (format "ps x")))
-                                (get-output-string s))))])
-             (let ([sub-pid (read (car l))])
-               (test 'running (list-ref l 4) 'status)
-               (test #t running? sub-pid)
-               ((list-ref l 4) 'kill)
-               ((list-ref l 4) 'wait)
-               (test 'done-error (list-ref l 4) 'status)
-               (test post-shutdown? running? sub-pid)
-               (when post-shutdown?
-                 (parameterize ([current-input-port (open-input-string "")])
-                   (system (format "kill ~a" sub-pid)))))))])
-    (try #t)
-    (try #f)))

pkgs/racket-pkgs/racket-test/tests/racket/srfi.rktl

@@ -1,61 +0,0 @@
-;; SRFI Tests
-
-(load-relative "loadtest.rktl")
-
-;; Test that all SRFIs load.  Run this in both DrRacket and
-;; Racket for maximum coverage.
-
-;; We just require all the SRFIs and hope nothing bombs.
-;; Keep an eye out for error messages!
-
-(require srfi/1)
-(require srfi/1/list)
-(require srfi/2/and-let)
-(require srfi/4)
-(require srfi/5/let)
-(require srfi/6)
-(require srfi/7/program)
-(require srfi/8/receive)
-(require srfi/9/record)
-(require srfi/11)
-(require srfi/13/string)
-(require srfi/14/char-set)
-(require srfi/16)
-(require srfi/17/set)
-(require srfi/18)
-(require srfi/19/time)
-(require srfi/23)
-(require srfi/25/array)
-(require srfi/26/cut)
-(require srfi/27/random-bits)
-(require srfi/28)
-(require srfi/29/localization)
-(require srfi/30)
-(require srfi/31/rec)
-(require srfi/32/sort)
-(require srfi/34/exception)
-(require srfi/35)
-(require srfi/35/condition)
-(require srfi/38)
-(require srfi/39)
-(require srfi/40/stream)
-(require (lib "srfi/42/comprehensions.scm"))
-(require srfi/43/vector-lib)
-(require srfi/45/lazy)
-(require srfi/48/format)
-(require srfi/54/cat)
-(require srfi/57/records)
-(require srfi/59/vicinity)
-(require srfi/60/60)
-(require srfi/61)
-(require srfi/63)
-(require srfi/64)
-(require srfi/64/testing)
-(require srfi/66)
-(require srfi/67/compare)
-(require srfi/69/hash)
-(require srfi/71/letvalues)
-(require srfi/74/74)
-(require srfi/78/check)
-(require srfi/86)
-(require srfi/87/case)

pkgs/racket-pkgs/racket-test/tests/racket/stx.rktl

@@ -483,11 +483,13 @@
                (cdddr b))
         b)))
 
-(test '('#%kernel case-lambda (lib "racket/init") case-lambda 0 0 0)
+(define base-lib (caddr (identifier-binding* #'lambda)))
+
+(test `('#%kernel case-lambda ,base-lib case-lambda 0 0 0)
       identifier-binding* #'case-lambda)
-(test '("private/promise.rkt" delay* (lib "racket/init") delay 0 0 0)
+(test `("private/promise.rkt" delay* ,base-lib delay 0 0 0)
       identifier-binding* #'delay)
-(test '('#%kernel #%module-begin (lib "racket/init") #%plain-module-begin 0 0 0)
+(test `('#%kernel #%module-begin ,base-lib #%plain-module-begin 0 0 0)
       identifier-binding* #'#%plain-module-begin)
 (require (only-in racket/base [#%plain-module-begin #%pmb]))
 (test '('#%kernel #%module-begin racket/base #%plain-module-begin 0 0 0)

pkgs/racket-pkgs/racket-test/tests/racket/syntax-tests.rktl

@@ -1,9 +0,0 @@
-(load-relative "loadtest.rktl")
-
-(load-in-sandbox "moddep.rktl")
-(load-in-sandbox "boundmap-test.rktl")
-(load-in-sandbox "id-table-test.rktl")
-(load-in-sandbox "cm.rktl")
-(load-in-sandbox "module-reader.rktl")
-
-(report-errs)

pkgs/racket-pkgs/racket-test/tests/racket/test.rkt

@@ -0,0 +1,3 @@
+#lang racket/load
+
+(load "quiet.rktl")

pkgs/racket-pkgs/racket-test/tests/racket/trace.rktl

@@ -2,7 +2,7 @@
 
 (Section 'trace)
 
-(require scheme/trace)
+(require racket/trace)
 
 (define-syntax-rule (trace-output expr ...)
   (let ([out '()])
@@ -68,3 +68,5 @@
         'trace-quotes
         (list ">(f (1 2 3) #:q #&18)"
               "<((1 2 3) 1)")))
+
+(report-errs)

pkgs/racket-pkgs/racket-test/tests/racket/trait.rktl

@@ -1,8 +1,8 @@
 
 (load-relative "loadtest.rktl")
 
-(require mzlib/class
+(require racket/class
-         mzlib/trait)
+         racket/trait)
 
 (Section 'trait)
 

pkgs/racket-pkgs/racket-test/tests/racket/ttt/listlib.rktl

@@ -1,42 +0,0 @@
-;; --------------------------------------------------------------------------
-;; list-library.rkt
-;; export: 
-;; collect: 
-;;   (A ((cons B (listof B)) (listof B) (union A C) -> (union A C))
-;;    -> 
-;;    ((listof B) -> (union A C)))
-
-; #|
-; (unit/sig
-;   (collect filter set-minus subset?)
-;   (import plt:userspace^)
-; |#
-
-  (define collect
-    (lambda (base combine)
-      (letrec ([C 
-		(lambda (l)
-		  (cond
-		   ((null? l) base)
-		   (else (combine l (car l) (C (cdr l))))))])
-	C)))
-
-  (define filter
-    (lambda (p? l)
-      [(collect null (lambda (_ x rest) (if (p? x) (cons x rest) rest))) l]))
-
-  ;; set library
-  (define set-minus
-    (lambda (set1 set2)
-      [(collect null (lambda (_ e1 rest) (if (member e1 set2) rest (cons e1 rest))))
-       set1]))
-
-  (define subset?
-    (lambda (state1 state2)
-      (cond
-	((null? state1) #t)
-	(else (and (member (car state1) state2)
-		(subset? (cdr state1) state2))))))
-; #|
-;   )
-; |#

pkgs/racket-pkgs/racket-test/tests/racket/ttt/tic-bang.rktl

@@ -1,125 +0,0 @@
-;; --------------------------------------------------------------------------
-;; tic-bang.rkt
-;; This is an imperative version.
-
-;; This program plays through all possibilities of a tic-tac-toe
-;; game, given the first move of a player. It only prints how many
-;; states are being processed and how many states are terminal at
-;; each stage of the game.
-
-;; This program lacks the capability to print how a situation arose. 
-
-;; It relies on list-library.rkt.
-
-(load-relative "listlib.rktl")
-
-;; representations of fields, states, and collections of states
-(define BLANK 0)
-
-(define new-state
-  (lambda ()
-    (make-2vec 3 BLANK)))
-
-(define update-state
-  (lambda (state x y token)
-    (2vec-set! state x y token)
-    state))
-
-(define blank?
-  (lambda (astate i j)
-    (eq? (2vec-ref astate i j) BLANK)))
-
-(define clone-state
-  (lambda (state)
-    (let ((s (new-state)))
-      (let loop ((i 0) (j 0))
-	(cond
-	  ((and (= i 3) (= j 0)) (void))
-	  ((< j 3) (update-state s i j (2vec-ref state i j)) (loop i (+ j 1)))
-	  ((< i 3) (loop (+ i 1) 0))
-	  (else 'bad)))
-      s)))
-
-;(define-type state (2vector (union 'x 'o '_)))
-;(define-type states (listof state))
-
-(define PLAYER 1)
-(define OPPONENT 2)
-
-(define tic-tac-toe
-  (lambda (x y)
-    (tic (list (update-state (new-state) (- x 1) (- y 1) PLAYER)))))
-
-(define make-move
-  (lambda (other-move p/o tag)
-    (lambda (states)
-      (printf "~s: processing ~s states \n" tag (length states))
-      (let ((t (print&remove-terminals states)))
-	(printf "terminal states removed: ~s\n" 
-		(- (length states) (length t)))
-	(if (null? t) 
-	    (void)
-	    (other-move (apply append (map p/o t))))))))
-
-(define tic (make-move (lambda (x) (tac x)) (lambda (x) (opponent x)) 'tic))
-
-(define tac (make-move (lambda (x) (tic x)) (lambda (x) (player x)) 'tac))
-
-(define make-players
-  (lambda (p/o)
-    (lambda (astate)
-      (let loop ((i 0) (j 0))
-	(cond
-	  ((and (= i 3) (= j 0)) null)
-	  ((< j 3) (if (blank? astate i j)
-		       (cons (update-state (clone-state astate) i j p/o)
-			     (loop i (+ j 1)))
-		       (loop i (+ j 1))))
-	  ((< i 3) (loop (+ i 1) 0))
-	  (else (error 'make-player "ouch")))))))
-
-(define player (make-players PLAYER))
-
-(define opponent (make-players OPPONENT))
-
-(define print&remove-terminals
-  (local ((define print-state
-	    (lambda (x)
-	      ;(display ".")
-	      (void))))
-
-    (collect null (lambda (_ astate rest)
-		    (if (terminal? astate)
-			(begin (print-state astate) rest)
-			(cons astate rest))))))
-
-(define terminal?
-  (lambda (astate)
-    (or (terminal-row 0 astate)
-	(terminal-row 1 astate)
-	(terminal-row 2 astate)
-	(terminal-col 0 astate)
-	(terminal-col 1 astate)
-	(terminal-col 2 astate)
-	(terminal-posdg astate)
-	(terminal-negdg astate))))
-
-(define terminal-row 
-  (lambda (n state)
-    (and (not (blank? state n 0))
-	 (= (2vec-ref state n 0) (2vec-ref state n 1) (2vec-ref state n 2)))))
-
-(define terminal-col
-  (lambda (n state)
-    (and (not (blank? state 0 n))
-	 (= (2vec-ref state 0 n) (2vec-ref state 1 n) (2vec-ref state 2 n)))))
-
-(define terminal-posdg
-  (lambda (state)
-    (and (not (blank? state 0 0))
-	 (= (2vec-ref state 0 0) (2vec-ref state 1 1) (2vec-ref state 2 2)))))
-
-(define terminal-negdg
-  (lambda (state)
-    (and (not (blank? state 0 2))
-	 (= (2vec-ref state 0 2) (2vec-ref state 1 1) (2vec-ref state 2 0)))))

pkgs/racket-pkgs/racket-test/tests/racket/ttt/tic-func.rktl

@@ -1,122 +0,0 @@
-;; --------------------------------------------------------------------------
-;; tic-func.rkt
-;; This program plays through all possibilities of a tic-tac-toe
-;; game, given the first move of a player. It only prints how many
-;; states are being processed and how many states are terminal at
-;; each stage of the game. But it is constructed so that it can
-;; print how to get to a winning terminal state. 
-
-;; It relies on list-library.rkt. 
-
-(load-relative "listlib.rktl")
-
-;; representations of fields, states, and collections of states
-(define null '())
-(define-struct entry ( x y who))
-(define entry-field
-  (lambda (an-entry)
-    (list (entry-x an-entry) (entry-y an-entry))))
-;(define-type state  (listof (structure:entry num num (union 'x 'o)))
-;(define-type states (listof state))
-
-(define PLAYER 'x)
-(define OPPONENT 'o)
-
-(define tic-tac-toe
-  (lambda (x y)
-    (tic (list (list (make-entry x y PLAYER))))))
-
-(define make-move
-  (lambda (other-move p/o tag)
-    (lambda (states)
-      (printf "~s: processing ~s states of length ~s \n"
-	tag (length states) (length (car states)))
-      (let ((t (print&remove-terminals states)))
-	(printf "terminal states removed: ~s\n"
-	  (- (length states) (length t)))
-	(if (null? t) 
-	    (void)
-	    (other-move (apply append (map p/o t))))))))
-
-(define tic (make-move (lambda (x) (tac x)) (lambda (x) (opponent x)) 'tic))
-
-(define tac (make-move (lambda (x) (tic x)) (lambda (x) (player x)) 'tac))
-
-(define make-players
-  (let ()
-    (define rest-of-fields
-      (lambda (used-fields)
-	(set-minus ALL-FIELDS used-fields)))
-    (lambda (player/opponent)
-      (lambda (astate)
-	(map (lambda (counter-move)
-	       (let ((counter-x (car counter-move))
-		     (counter-y (cadr counter-move)))
-		 (cons (make-entry counter-x counter-y player/opponent)
-		       astate)))
-	     (rest-of-fields (map entry-field astate)))))))
-
-(define player (make-players PLAYER))
-
-(define opponent (make-players OPPONENT))
-
-(define terminal?
-  (let () (define filter-p/o
-	    (lambda (p/o astate)
-	      (map entry-field
-		(filter (lambda (x) (eq? (entry-who x) p/o)) astate))))
-    (lambda (astate)
-      (and (>= (length astate) 5)
-	(let ((PLAYERf (filter-p/o PLAYER astate))
-	      (OPPONENTf (filter-p/o OPPONENT astate)))
-	  (or 
-	    (= (length astate) 9)
-	    (ormap (lambda (ts) (subset? ts PLAYERf)) TERMINAL-STATES)
-	    (ormap (lambda (ts) (subset? ts OPPONENTf)) TERMINAL-STATES)))))))
-
-(define print&remove-terminals
-  (let ()
-
-	  (define print-state1
-	    (lambda (x)
-	      (display x)
-	      (newline)))
-
-	  (define print-state2
-	    (lambda (astate)
-	      (cond
-		((null? astate) (printf "------------\n"))
-		(else (print-state (cdr astate))
-		  (let ((x (car astate)))
-		    (printf " ~s @ (~s,~s) \n"
-		      (entry-who x) (entry-x x) (entry-y x)))))))
-
-	  (define print-state
-	    (lambda (x)
-	      ;(display ".")
-	      (void)))
-
-    (collect null (lambda (_ astate rest)
-		    (if (terminal? astate)
-			(begin (print-state astate) rest)
-			(cons astate rest))))))
-;; fields
-(define T
-  (lambda (alof)
-    (cond
-      ((null? alof) null)
-      (else (cons (list (cadr (car alof)) (car (car alof)))
-		  (T (cdr alof)))))))
-
-(define row1 (list (list 1 1) (list 1 2) (list 1 3)))
-(define row2 (list (list 2 1) (list 2 2) (list 2 3)))
-(define row3 (list (list 3 1) (list 3 2) (list 3 3)))
-(define col1 (list (list 1 1) (list 2 1) (list 3 1)))
-(define col2 (list (list 1 2) (list 2 2) (list 3 2)))
-(define col3 (list (list 1 3) (list 2 3) (list 3 3)))
-(define posd (list (list 1 1) (list 2 2) (list 3 3)))
-(define negd (list (list 1 3) (list 2 2) (list 3 1)))
-
-(define TERMINAL-STATES (list row1 row2 row3 col1 col2 col3 posd negd))
-
-(define ALL-FIELDS (append row1 row2 row3))

pkgs/racket-pkgs/racket-test/tests/racket/ttt/ttt.rktl

@@ -1,13 +0,0 @@
-
-(require mzlib/etc mzlib/compat)
-(load-relative "listlib.rktl")
-(load-relative "veclib.rktl")
-(load-relative "tic-func.rktl")
-
-(let loop ()
-  (collect-garbage)
-  (collect-garbage)
-  (collect-garbage)
-  ; (dump-memory-stats)
-  (time (tic-tac-toe 1 1))
-  '(loop))

pkgs/racket-pkgs/racket-test/tests/racket/ttt/veclib.rktl

@@ -1,57 +0,0 @@
-;; --------------------------------------------------------------------------
-;; 2vec-library.rkt
-
-; #|
-; (unit/sig
-;   (make-2vec 2vec-ref 2vec-set! collect)
-;   (import plt:userspace^)
-; |#
-  
-  ;; 2 dimensional, square vectors
-
-    (define collect
-      (lambda (base combine)
-	(define C 
-	  (lambda (l)
-	    (cond
-	     ((null? l) base)
-	     (else (combine l (car l) (C (cdr l)))))))
-	C))
-    
-  (define (make-2vec N element)
-    (make-vector (* N N) element))
-  
-  (define (2vec-ref 2vec i j)
-    (let ((L (sqrt (vector-length 2vec))))
-      (vector-ref 2vec (+ (* i L) j))))
-  
-  (define (2vec-set! 2vec i j element)
-    (let ((L (sqrt (vector-length 2vec))))
-      (if (and (< i L) (< j L))
-	  (vector-set! 2vec (+ (* i L) j) element)
-	  (error '2vec-set! "~s ~s" i j))))
-  
-  (define (I N)
-    (let ((2vec (make-2vec N 0)))
-      (let loop ((i 0) (j 0))
-	(if (= i N)
-	    (void)
-	    (begin
-	      (2vec-set! 2vec i j 1)
-	      (loop (add1 i) (add1 j)))))
-      2vec))
-  
-  (define (P N)
-    (let ((2vec (make-2vec N 0)))
-      (let loop ((i 0) (j 0))
-	(cond
-	  [(and (= i N) (= j 0)) (void)]
-	  [(< j N) (2vec-set! 2vec i j (list i j)) (loop i (add1 j))]
-	  [(< i N) (loop (add1 i) 0)]
-	  [else (error 'P "impossible ~s ~s" i j)]))
-      2vec))
-
-; #|
-;   )
-; |#
-

pkgs/racket-pkgs/racket-test/tests/racket/uni-norm.rktl

@@ -1,7 +1,7 @@
 
-(require mzlib/string
+(require racket/string
          (only-in net/url get-pure-port string->url)
-         (only-in mzlib/port copy-port))
+         (only-in racket/port copy-port))
 
 (load-relative "loadtest.rktl")
 

pkgs/racket-pkgs/racket-test/tests/racket/zo-marshal.rktl

@@ -1,407 +0,0 @@
-
-(load-relative "loadtest.rktl")
-
-(Section 'zo-marshal)
-
-(require compiler/zo-parse
-         compiler/zo-marshal)
-
-(define-struct mpi (n b) #:transparent)
-
-;; Exposes content of module-path indices, strip away
-;; closure ids, and normalize `indirects' so we can compare them
-;; with `equal?':
-(define mpx
-  (case-lambda
-   [(v) (let ([it (make-hash)])
-          (let loop ([v v])
-            (cond
-             [(pair? v) (cons (loop (car v)) (loop (cdr v)))]
-             [(indirect? v)
-              (or (hash-ref it v #f)
-                  (let ([i (make-indirect #f)])
-                    (hash-set! it v i)
-                    (set-indirect-v! i
-                                     (make-closure
-                                      (loop (closure-code (indirect-v v)))
-                                      'closure))
-                    i))]
-             [(closure? v) (make-indirect
-                            (make-closure (loop (closure-code v)) 'closure))]
-             [(struct? v) (let-values ([(st ?) (struct-info v)])
-                            (if st
-                                (let ([c (struct-type-make-constructor st)])
-                                  (apply c
-                                         (map loop
-                                              (cdr 
-                                               (vector->list
-                                                (struct->vector v))))))
-                                v))]
-             [(module-path-index? v)
-              (let-values ([(name base) (module-path-index-split v)])
-                (make-mpi name base))]
-             [else v])))]
-   [(f v) (mpx (f v))]))
-
-(define (check expr val #:wrap [wrap values])
-  (let ([s (zo-marshal expr)])
-    (test (mpx expr) mpx zo-parse (open-input-bytes s))
-    (test val wrap (eval (parameterize ([read-accept-compiled #t])
-                           (read (open-input-bytes s)))))))
-
-(define (get-id id)
-  (primval-id
-   (compilation-top-code
-    (zo-parse (let ([s (open-output-bytes)])
-                (write (compile id) s)
-                (open-input-bytes (get-output-bytes s)))))))
-
-(define values-id (get-id #'values))
-(define list-id (get-id #'list))
-(define object-name-id (get-id #'object-name))
-
-(define GLOBALV 78)
-(module zo-m scheme/base
-  (provide x)
-  (define x 88))
-(require 'zo-m)
-
-;; ----------------------------------------
-
-(define (make-simple e)
-  (make-compilation-top
-   10
-   (make-prefix 0 null null)
-   e))
-
-(define (make-global e)
-  (make-compilation-top
-   10
-   (make-prefix 0 (list (make-global-bucket 'GLOBALV)
-                        (make-module-variable (module-path-index-join ''zo-m #f)
-                                              'x
-                                              -1
-                                              0))
-                null)
-   e))
-
-;; ----------------------------------------
-
-(check (make-simple 5)
-       5)
-
-(let ([ck (lambda (cl? o-cls?)
-            (check (make-simple (make-let-one 
-                                 51
-                                 (make-localref #f 0 cl? o-cls?)))
-                   51))])
-  (ck #f #f)
-  (ck #t #f)
-  (ck #f #t))
-
-
-(check (make-simple (make-let-one 
-                     15
-                     (make-boxenv
-                      0
-                      (make-localref #t 0 #f #f))))
-       15)
-
-(check (make-simple (make-let-void
-                     3
-                     #f
-                     (make-install-value
-                      1
-                      0
-                      #f
-                      503
-                      (make-boxenv
-                       0
-                       (make-localref #t 0 #f #f)))))
-       503)
-
-(check (make-simple (make-let-void
-                     3
-                     #f
-                     (make-install-value
-                      2
-                      1
-                      #f
-                      (make-application
-                       (make-primval values-id)
-                       (list 503
-                             507))
-                      (make-localref #f 2 #f #f))))
-       507)
-
-(check (make-simple (make-branch
-                     #t
-                     50
-                     -50))
-       50)
-
-(check (make-simple (make-branch
-                     #f
-                     50
-                     -50))
-       -50)
-
-;; ----------------------------------------
-
-(define (make-ab body)
-  (make-simple (make-let-void
-                2
-                #f
-                (make-let-rec
-                 (list
-                  (make-lam 'a
-                            null
-                            1
-                            '(val)
-                            #f
-                            #(1)
-                            10
-                            (make-branch
-                             (make-localref #f 1 #f #f)
-                             (make-localref #f 0 #f #f)
-                             59))
-                  (make-lam 'b
-                            null
-                            1
-                            '(val)
-                            #f
-                            #(0)
-                            10
-                            (make-localref #f 0 #f #f)))
-                 body))))
-
-(check (make-ab 517)
-       517)
-
-(check (make-ab (make-application
-                 (make-primval object-name-id)
-                 (list (make-localref #f 1 #f #f))))
-       'a)
-(check (make-ab (make-application
-                 (make-primval object-name-id)
-                 (list (make-localref #f 2 #f #f))))
-       'b)
-
-(check (make-ab (make-application
-                 (make-localref #f 1 #f #f)
-                 (list #f)))
-       59)
-(check (make-ab (make-application
-                 (make-primval object-name-id)
-                 (list
-                  (make-application
-                   (make-localref #f 2 #f #f)
-                   (list #t)))))
-       'b)
-(check (make-ab (make-application
-                 (make-primval object-name-id)
-                 (list
-                  (make-application
-                   (make-application
-                    (make-localref #f 3 #f #f)
-                    (list #t))
-                   (list -5)))))
-       'a)
-
-;; ----------------------------------------
-
-(check (make-simple 
-        (make-let-one
-         'v1
-         (make-let-one
-          'v0
-          (make-let-one
-           (make-lam 'proc
-                     null
-                     1
-                     '(val)
-                     #f
-                     #(1 2)
-                     20
-                     (make-application
-                      (make-primval list-id)
-                      (list
-                       (make-localref #f 2 #f #f)
-                       (make-localref #f 3 #f #f))))
-           (make-application
-            (make-localref #f 1 #f #f)
-            (list 5))))))
-       '(v0 v1))
-
-;; ----------------------------------------
-
-(check (make-global
-        (make-toplevel 0 0 #f #f))
-       78)
-(check (make-global
-        (make-toplevel 0 1 #f #f))
-       88)
-
-;; ----------------------------------------
-
-(check (make-simple
-        (make-seq (list 1 56)))
-       56)
-(check (make-simple
-        (make-splice (list 1 57)))
-       57)
-(check (make-global
-        (make-splice (list (make-toplevel 0 0 #f #f) 57)))
-       57)
-(check (make-simple
-        (make-beg0 (list 1 56)))
-       1)
-(check (make-global
-        (make-beg0 (list 57 (make-toplevel 0 0 #f #f))))
-       57)
-
-;; ----------------------------------------
-
-(check (make-simple
-        (make-closure
-         (make-lam 'proc
-                   null
-                   1
-                   '(val)
-                   #f
-                   #()
-                   10
-                   (make-localref #f 0 #f #f))
-         'proc))
-       8
-       #:wrap (lambda (f) (f 8)))
-
-(define rec-proc
-  (let ([self (make-indirect #f)])
-    (set-indirect-v! self
-                     (make-closure
-                      (make-lam 'proc
-                                null
-                                1
-                                '(val)
-                                #f
-                                #()
-                                10
-                                (make-branch
-                                 (make-localref #f 0 #f #f)
-                                 self
-                                 17))
-                      'proc))
-    self))
-
-(check (make-simple
-        rec-proc)
-       17
-       #:wrap (lambda (f) (f #f)))
-(check (make-simple
-        rec-proc)
-       'proc
-       #:wrap (lambda (f) (object-name (f #t))))
-
-;; ----------------------------------------
-
-(define cl-proc
-  (make-case-lam
-   'cl-proc
-   (list
-    (make-lam 'proc
-              null
-              1
-              '(val)
-              #f
-              #()
-              10
-              (make-localref #f 0 #f #f))
-    (make-lam 'proc
-              null
-              2
-              '(val val)
-              #f
-              #()
-              10
-              (make-application
-               (make-primval list-id)
-               (list
-                (make-localref #f 2 #f #f)
-                (make-localref #f 3 #f #f)))))))
-
-(check (make-simple cl-proc)
-       #:wrap (lambda (f) (f 3))
-       3)
-(check (make-simple cl-proc)
-       #:wrap (lambda (f) (f 1 2))
-       '(1 2))
-(check (make-simple cl-proc)
-       #:wrap object-name
-       'cl-proc)
-
-(define cl-proc2
-  (make-let-one
-   'cl1
-   (make-let-one
-    'cl2
-    (make-case-lam
-     'cl-proc
-     (list
-      (make-lam 'proc
-                null
-                0
-                '()
-                #f
-                #(0)
-                10
-                (make-localref #f 0 #f #f))
-      (make-lam 'proc
-                null
-                1
-                '(val)
-                #f
-                #(1)
-                10
-                (make-application
-                 (make-primval list-id)
-                 (list
-                  (make-localref #f 2 #f #f)
-                  (make-localref #f 3 #f #f)))))))))
-(check (make-simple cl-proc2)
-       #:wrap (lambda (f) (f))
-       'cl2)
-(check (make-simple cl-proc2)
-       #:wrap (lambda (f) (f 2))
-       '(cl1 2))
-
-;; ----------------------------------------
-
-(check (make-global
-        (make-varref (make-toplevel 0 0 #f #f)))
-       #:wrap variable-reference?
-       #t)
-
-;; ----------------------------------------
-
-(check (make-global
-        (make-assign (make-toplevel 0 0 #f #f)
-                     99
-                     #f))
-       (void))
-(test 99 values GLOBALV)
-
-;; ----------------------------------------
-
-(check (make-global
-        (make-apply-values
-         (make-primval list-id)
-         (make-application
-          (make-primval values-id)
-          (list 503
-                507))))
-       '(503 507))
-
-;; ----------------------------------------
-
-(report-errs)

pkgs/racket-pkgs/racket-test/tests/racket/ztest.rktl

@@ -1,20 +0,0 @@
-;; rudimentary test harness for complex math routines in
-;; zmath.rkt
-
-(require mzlib/zmath)
-
-(define ztest
-  (lambda (z)
-    (printf "z = ~a\n" z)
-    (printf " zabs(z) = ~a\n" (zabs z))
-    (printf " zlog(z) = ~a\n" (zlog z))
-    (printf " zexp(z) = ~a\n" (zexp z))
-    (printf " zsqrt(z) = ~a\n" (zsqrt z))
-    (printf " zsin(z) = ~a\n" (zsin z))
-    (printf " zcos(z) = ~a\n" (zcos z))
-    (printf " ztan(z) = ~a\n" (ztan z))
-    (printf " zasin(z) = ~a\n" (zasin z))
-    (printf " zacos(z) = ~a\n" (zacos z))
-    (printf " zatan(z) = ~a\n" (zatan z))))
-
-(ztest 0.5)