├── COPYING ├── COPYING.LESSER ├── README.md ├── forpy_mod.F90 ├── forpy_mod.fypp ├── forpy_project.md ├── fypp.py └── tests ├── Makefile ├── forpy_tests_common_mod.F90 ├── test_basics.F90 ├── test_basics.py ├── test_basics_mod.F90 ├── test_cast.F90 ├── test_cast.py ├── test_cast_mod.F90 ├── test_datastructures.F90 ├── test_datastructures_mod.F90 ├── test_ndarray.fypp ├── test_ndarray.py ├── test_ndarray_mod.fypp ├── unittest_mod.F90 └── unittest_mod.inc /COPYING: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | 635 | Copyright (C) 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | Copyright (C) 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /COPYING.LESSER: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | 9 | This version of the GNU Lesser General Public License incorporates 10 | the terms and conditions of version 3 of the GNU General Public 11 | License, supplemented by the additional permissions listed below. 12 | 13 | 0. Additional Definitions. 14 | 15 | As used herein, "this License" refers to version 3 of the GNU Lesser 16 | General Public License, and the "GNU GPL" refers to version 3 of the GNU 17 | General Public License. 18 | 19 | "The Library" refers to a covered work governed by this License, 20 | other than an Application or a Combined Work as defined below. 21 | 22 | An "Application" is any work that makes use of an interface provided 23 | by the Library, but which is not otherwise based on the Library. 24 | Defining a subclass of a class defined by the Library is deemed a mode 25 | of using an interface provided by the Library. 26 | 27 | A "Combined Work" is a work produced by combining or linking an 28 | Application with the Library. The particular version of the Library 29 | with which the Combined Work was made is also called the "Linked 30 | Version". 31 | 32 | The "Minimal Corresponding Source" for a Combined Work means the 33 | Corresponding Source for the Combined Work, excluding any source code 34 | for portions of the Combined Work that, considered in isolation, are 35 | based on the Application, and not on the Linked Version. 36 | 37 | The "Corresponding Application Code" for a Combined Work means the 38 | object code and/or source code for the Application, including any data 39 | and utility programs needed for reproducing the Combined Work from the 40 | Application, but excluding the System Libraries of the Combined Work. 41 | 42 | 1. Exception to Section 3 of the GNU GPL. 43 | 44 | You may convey a covered work under sections 3 and 4 of this License 45 | without being bound by section 3 of the GNU GPL. 46 | 47 | 2. Conveying Modified Versions. 48 | 49 | If you modify a copy of the Library, and, in your modifications, a 50 | facility refers to a function or data to be supplied by an Application 51 | that uses the facility (other than as an argument passed when the 52 | facility is invoked), then you may convey a copy of the modified 53 | version: 54 | 55 | a) under this License, provided that you make a good faith effort to 56 | ensure that, in the event an Application does not supply the 57 | function or data, the facility still operates, and performs 58 | whatever part of its purpose remains meaningful, or 59 | 60 | b) under the GNU GPL, with none of the additional permissions of 61 | this License applicable to that copy. 62 | 63 | 3. Object Code Incorporating Material from Library Header Files. 64 | 65 | The object code form of an Application may incorporate material from 66 | a header file that is part of the Library. You may convey such object 67 | code under terms of your choice, provided that, if the incorporated 68 | material is not limited to numerical parameters, data structure 69 | layouts and accessors, or small macros, inline functions and templates 70 | (ten or fewer lines in length), you do both of the following: 71 | 72 | a) Give prominent notice with each copy of the object code that the 73 | Library is used in it and that the Library and its use are 74 | covered by this License. 75 | 76 | b) Accompany the object code with a copy of the GNU GPL and this license 77 | document. 78 | 79 | 4. Combined Works. 80 | 81 | You may convey a Combined Work under terms of your choice that, 82 | taken together, effectively do not restrict modification of the 83 | portions of the Library contained in the Combined Work and reverse 84 | engineering for debugging such modifications, if you also do each of 85 | the following: 86 | 87 | a) Give prominent notice with each copy of the Combined Work that 88 | the Library is used in it and that the Library and its use are 89 | covered by this License. 90 | 91 | b) Accompany the Combined Work with a copy of the GNU GPL and this license 92 | document. 93 | 94 | c) For a Combined Work that displays copyright notices during 95 | execution, include the copyright notice for the Library among 96 | these notices, as well as a reference directing the user to the 97 | copies of the GNU GPL and this license document. 98 | 99 | d) Do one of the following: 100 | 101 | 0) Convey the Minimal Corresponding Source under the terms of this 102 | License, and the Corresponding Application Code in a form 103 | suitable for, and under terms that permit, the user to 104 | recombine or relink the Application with a modified version of 105 | the Linked Version to produce a modified Combined Work, in the 106 | manner specified by section 6 of the GNU GPL for conveying 107 | Corresponding Source. 108 | 109 | 1) Use a suitable shared library mechanism for linking with the 110 | Library. A suitable mechanism is one that (a) uses at run time 111 | a copy of the Library already present on the user's computer 112 | system, and (b) will operate properly with a modified version 113 | of the Library that is interface-compatible with the Linked 114 | Version. 115 | 116 | e) Provide Installation Information, but only if you would otherwise 117 | be required to provide such information under section 6 of the 118 | GNU GPL, and only to the extent that such information is 119 | necessary to install and execute a modified version of the 120 | Combined Work produced by recombining or relinking the 121 | Application with a modified version of the Linked Version. (If 122 | you use option 4d0, the Installation Information must accompany 123 | the Minimal Corresponding Source and Corresponding Application 124 | Code. If you use option 4d1, you must provide the Installation 125 | Information in the manner specified by section 6 of the GNU GPL 126 | for conveying Corresponding Source.) 127 | 128 | 5. Combined Libraries. 129 | 130 | You may place library facilities that are a work based on the 131 | Library side by side in a single library together with other library 132 | facilities that are not Applications and are not covered by this 133 | License, and convey such a combined library under terms of your 134 | choice, if you do both of the following: 135 | 136 | a) Accompany the combined library with a copy of the same work based 137 | on the Library, uncombined with any other library facilities, 138 | conveyed under the terms of this License. 139 | 140 | b) Give prominent notice with the combined library that part of it 141 | is a work based on the Library, and explaining where to find the 142 | accompanying uncombined form of the same work. 143 | 144 | 6. Revised Versions of the GNU Lesser General Public License. 145 | 146 | The Free Software Foundation may publish revised and/or new versions 147 | of the GNU Lesser General Public License from time to time. Such new 148 | versions will be similar in spirit to the present version, but may 149 | differ in detail to address new problems or concerns. 150 | 151 | Each version is given a distinguishing version number. If the 152 | Library as you received it specifies that a certain numbered version 153 | of the GNU Lesser General Public License "or any later version" 154 | applies to it, you have the option of following the terms and 155 | conditions either of that published version or of any later version 156 | published by the Free Software Foundation. If the Library as you 157 | received it does not specify a version number of the GNU Lesser 158 | General Public License, you may choose any version of the GNU Lesser 159 | General Public License ever published by the Free Software Foundation. 160 | 161 | If the Library as you received it specifies that a proxy can decide 162 | whether future versions of the GNU Lesser General Public License shall 163 | apply, that proxy's public statement of acceptance of any version is 164 | permanent authorization for you to choose that version for the 165 | Library. 166 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Forpy: A library for Fortran-Python interoperability. 2 | 3 | Forpy allows you to use Python features in Fortran ("embedding Python in Fortran") 4 | 5 | It provides datastructures such as list, dict, tuple and interoperability 6 | of arrays using numpy. 7 | With forpy you can even import Python modules in Fortran. Simply use your own or third-party Python modules 8 | for tasks that you can easily do in Python. For example: plot with matplotlib or use scientific 9 | functions from scipy or numpy. 10 | 11 | Forpy also works to other way around: You can write Python modules entirely in Fortran (extending Python with Fortran - "Fortran in Python"). 12 | 13 | ## Documentation 14 | 15 | - This readme (start with that) 16 | - [Wiki](https://github.com/ylikx/forpy/wiki) 17 | - [API reference](https://ylikx.github.io/forpy/index.html) 18 | 19 | ## Contact 20 | 21 | Elias Rabel (*ylikx.0 AT gmail.com*) 22 | 23 | ## Getting started 24 | 25 | A simple example using a Python list: 26 | 27 | ```Fortran 28 | program intro_to_forpy 29 | use forpy_mod 30 | implicit none 31 | 32 | integer :: ierror 33 | type(list) :: my_list 34 | 35 | ierror = forpy_initialize() 36 | ierror = list_create(my_list) 37 | 38 | ierror = my_list%append(19) 39 | ierror = my_list%append("Hello world!") 40 | ierror = my_list%append(3.14d0) 41 | ierror = print_py(my_list) 42 | 43 | call my_list%destroy 44 | call forpy_finalize 45 | 46 | end program 47 | ``` 48 | 49 | Building the example: 50 | 51 | To try the examples, copy the file [`forpy_mod.F90`](forpy_mod.F90) to your working directory. 52 | Here I assume that you are using Python 3 (version >= 3.3) and 53 | gfortran (ifort also supported). 54 | 55 | If you are using *Anaconda* and have problems when building read 56 | [Using forpy with Anaconda](#using-forpy-with-anaconda). 57 | 58 | If you are using *Windows*, read [Forpy on Windows](https://github.com/ylikx/forpy/wiki/Forpy-on-Windows). 59 | 60 | For use with Python 2 read [Python 2 support](#python-2-support). 61 | 62 | Save the example as `intro_to_forpy.F90` and type, depending on your Python version: 63 | 64 | ```bash 65 | # Python 3.7 and earlier 66 | gfortran -c forpy_mod.F90 67 | gfortran intro_to_forpy.F90 forpy_mod.o `python3-config --ldflags` 68 | ``` 69 | 70 | ```bash 71 | # Python 3.8 and higher 72 | gfortran -c forpy_mod.F90 73 | gfortran intro_to_forpy.F90 forpy_mod.o `python3-config --ldflags --embed` 74 | ``` 75 | 76 | Then run the example with 77 | 78 | ``` 79 | ./a.out 80 | ``` 81 | 82 | You should get the output: 83 | 84 | ``` 85 | [19, 'Hello world!', 3.14] 86 | ``` 87 | 88 | If `python3-config` is not found, you might have to install the package `python3-dev` (on Ubuntu, Debian). 89 | 90 | For simplicity this example and most following examples do not contain error handling code. 91 | 92 | ## Tuples, objects 93 | 94 | This example introduces tuples and shows how to check for basic Python types. 95 | It demonstrates the methods `getitem` and `setitem`, which also work 96 | with `list`. These methods are generic for important Fortran types. 97 | 98 | 99 | The type `object` can be used for any Python object. Use `cast` to transform an 100 | `object` into a Fortran type or to transform into 101 | a more specific Python object, such as `list` or `tuple`. 102 | 103 | ```Fortran 104 | program tuple_example 105 | use forpy_mod 106 | implicit none 107 | 108 | integer :: ierror 109 | type(tuple) :: tu 110 | type(object) :: item 111 | integer :: int_value 112 | character(len=:), allocatable :: str_value 113 | integer :: ii 114 | integer :: tu_len 115 | 116 | ierror = forpy_initialize() 117 | 118 | ! Python: tu = (17, "hello", 23, "world") 119 | ierror = tuple_create(tu, 4) ! create tuple with 4 elements 120 | ! Must set all tuple elements before using tuple 121 | ierror = tu%setitem(0, 17) 122 | ierror = tu%setitem(1, "hello") 123 | ierror = tu%setitem(2, 23) 124 | ierror = tu%setitem(3, "world") 125 | 126 | ierror = tu%len(tu_len) 127 | 128 | do ii = 0, tu_len-1 ! Python indices start at 0 129 | ierror = tu%getitem(item, ii) 130 | 131 | ! Use is_int, is_str, is_float, is_none ... 132 | ! to check if an object is of a certain Python type 133 | if (is_int(item)) then 134 | ! Use cast to transform 'item' into Fortran type 135 | ierror = cast(int_value, item) 136 | write(*,*) int_value 137 | else if(is_str(item)) then 138 | ierror = cast(str_value, item) 139 | write(*,*) str_value 140 | endif 141 | 142 | call item%destroy 143 | enddo 144 | 145 | call tu%destroy 146 | call forpy_finalize 147 | 148 | end program 149 | ``` 150 | 151 | ## Dictionaries, Error handling 152 | The following example shows how to use a Python `dict` and shows some 153 | error and exception handling. 154 | 155 | ```Fortran 156 | program dict_example 157 | use forpy_mod 158 | implicit none 159 | 160 | integer :: ierror 161 | type(dict) :: di 162 | real :: a_value 163 | 164 | ierror = forpy_initialize() 165 | ierror = dict_create(di) ! Python: di = {} 166 | 167 | ierror = di%setitem("temperature", 273.0) 168 | ierror = di%setitem("pressure", 1013.0) 169 | ierror = di%getitem(a_value, "pressure") 170 | write(*,*) "pressure = ", a_value 171 | 172 | ! Show some error handling 173 | ierror = di%getitem(a_value, "does not exist") 174 | if (ierror /= 0) then 175 | if (exception_matches(KeyError)) then 176 | write(*,*) "Key not found..." 177 | ! Must clear error after handling exception, 178 | ! if we want to continue with program! 179 | call err_clear 180 | else 181 | write(*,*) "Unknown error..." 182 | stop 183 | endif 184 | endif 185 | 186 | ! alternative to getitem: get - returns given default value if key 187 | ! not found, no KeyError exception raised 188 | ierror = di%get(a_value, "volume", 1.0) 189 | write(*,*) "volume = ", a_value 190 | 191 | call di%destroy 192 | call forpy_finalize 193 | 194 | end program 195 | ``` 196 | 197 | ## Import a Python module in Fortran 198 | 199 | The following demo, shows how to use a module from Python's standard 200 | library and introduces `call_py`, which is used to call Python methods and 201 | to instantiate Python objects. 202 | 203 | ```Fortran 204 | program date_demo 205 | use forpy_mod 206 | implicit none 207 | 208 | integer :: ierror 209 | type(module_py) :: datetime 210 | type(object) :: date, today, today_str 211 | character(len=:), allocatable :: today_fortran 212 | 213 | ! Python: 214 | ! import datetime 215 | ! date = datetime.date 216 | ! today = date.today() 217 | ! today_str = today.isoformat() 218 | ! print("Today is ", today_str) 219 | 220 | ierror = forpy_initialize() 221 | ierror = import_py(datetime, "datetime") 222 | ierror = datetime%getattribute(date, "date") 223 | 224 | ierror = call_py(today, date, "today") 225 | ierror = call_py(today_str, today, "isoformat") 226 | ierror = cast(today_fortran, today_str) 227 | 228 | write(*,*) "Today is ", today_fortran 229 | 230 | call datetime%destroy 231 | call date%destroy 232 | call today%destroy 233 | call today_str%destroy 234 | 235 | call forpy_finalize 236 | 237 | end program 238 | ``` 239 | 240 | For Python to import a module that is not in one of the standard search 241 | directories, you can set the environment variable `PYTHONPATH`: 242 | 243 | ``` 244 | export PYTHONPATH=$PYTHONPATH:path_to_my_python_module 245 | ``` 246 | 247 | Alternatively, you can use forpy's `get_sys_path` function to retrieve and modify the list 248 | of Python module search paths, as shown in the following example. 249 | 250 | We want to import the following small Python module: 251 | 252 | ```Python 253 | # File: mymodule.py 254 | 255 | def print_args(*args, **kwargs): 256 | print("Arguments: ", args) 257 | print("Keyword arguments: ", kwargs) 258 | 259 | return "Returned from mymodule.print_args" 260 | ``` 261 | 262 | Now we use the module in Fortran, assuming that `mymodule.py` is in the current 263 | working directory: 264 | 265 | ```Fortran 266 | program mymodule_example 267 | use forpy_mod 268 | implicit none 269 | 270 | integer :: ierror 271 | type(tuple) :: args 272 | type(dict) :: kwargs 273 | type(module_py) :: mymodule 274 | type(object) :: return_value 275 | type(list) :: paths 276 | character(len=:), allocatable :: return_string 277 | 278 | ierror = forpy_initialize() 279 | 280 | ! Instead of setting the environment variable PYTHONPATH, 281 | ! we can add the current directory "." to sys.path 282 | ierror = get_sys_path(paths) 283 | ierror = paths%append(".") 284 | 285 | ierror = import_py(mymodule, "mymodule") 286 | 287 | ! Python: 288 | ! return_value = mymodule.print_args(12, "Hi", True, message="Hello world!") 289 | ierror = tuple_create(args, 3) 290 | ierror = args%setitem(0, 12) 291 | ierror = args%setitem(1, "Hi") 292 | ierror = args%setitem(2, .true.) 293 | 294 | ierror = dict_create(kwargs) 295 | ierror = kwargs%setitem("message", "Hello world!") 296 | 297 | ierror = call_py(return_value, mymodule, "print_args", args, kwargs) 298 | 299 | ierror = cast(return_string, return_value) 300 | write(*,*) return_string 301 | 302 | ! For call_py, args and kwargs are optional 303 | ! use call_py_noret to ignore the return value 304 | ! E. g.: 305 | ! ierror = call_py_noret(mymodule, "print_args") 306 | 307 | call args%destroy 308 | call kwargs%destroy 309 | call mymodule%destroy 310 | call return_value%destroy 311 | call paths%destroy 312 | 313 | call forpy_finalize 314 | 315 | end program 316 | ``` 317 | 318 | ## Working with arrays 319 | 320 | Forpy offers interoperability of Fortran arrays and numpy arrays through 321 | the type `ndarray`. In the 322 | following examples, you will see various ways to create a numpy array. 323 | 324 | ### Creating a numpy array from a Fortran array 325 | 326 | The simplest way to create a numpy array is with `ndarray_create`. This 327 | function creates a numpy array with the same content as a Fortran array that is 328 | passed to the function. For example: 329 | 330 | ```Fortran 331 | program ndarray01 332 | use forpy_mod 333 | implicit none 334 | 335 | integer, parameter :: NROWS = 2 336 | integer, parameter :: NCOLS = 3 337 | integer :: ierror, ii, jj 338 | 339 | real :: matrix(NROWS, NCOLS) 340 | 341 | type(ndarray) :: arr 342 | 343 | ierror = forpy_initialize() 344 | 345 | do jj = 1, NCOLS 346 | do ii = 1, NROWS 347 | matrix(ii, jj) = real(ii) * jj 348 | enddo 349 | enddo 350 | 351 | ! creates a numpy array with the same content as 'matrix' 352 | ierror = ndarray_create(arr, matrix) 353 | 354 | ierror = print_py(arr) 355 | 356 | call arr%destroy 357 | call forpy_finalize 358 | 359 | end program 360 | ``` 361 | 362 | When arrays get very large, creating a copy might not be what you want. The next section 363 | describes how to wrap a Fortran array with forpy without making a copy. 364 | 365 | ### Creating a numpy wrapper for a Fortran array 366 | 367 | When creating a numpy array with `ndarray_create_nocopy`, no copy of the Fortran 368 | array is made. This is more efficient than `ndarray_create`, but there are 369 | some things to consider: Changes to the Fortran array affect the numpy array 370 | and vice versa. You have to make sure that the Fortran array is valid 371 | as long as the numpy array is in use. 372 | 373 | Since the Fortran array can now be modified not 374 | only directly but also indirectly by the `ndarray`, it is necessary to 375 | add the `asynchronous` attribute to the Fortran array declaration, since 376 | without it compiler optimization related bugs 377 | can occur (depending on code, compiler and compiler options). 378 | Alternatively you could also use the `volatile` attribute. 379 | 380 | ```Fortran 381 | program ndarray02 382 | use forpy_mod 383 | implicit none 384 | 385 | integer, parameter :: NROWS = 2 386 | integer, parameter :: NCOLS = 3 387 | integer :: ierror, ii, jj 388 | 389 | ! add the asynchronous attribute to the Fortran array that is wrapped 390 | ! as ndarray to avoid bugs caused by compiler optimizations 391 | real, asynchronous :: matrix(NROWS, NCOLS) 392 | 393 | type(ndarray) :: arr 394 | 395 | ierror = forpy_initialize() 396 | 397 | do jj = 1, NCOLS 398 | do ii = 1, NROWS 399 | matrix(ii, jj) = real(ii) * jj 400 | enddo 401 | enddo 402 | 403 | ! creates a numpy array that refers to 'matrix' 404 | ierror = ndarray_create_nocopy(arr, matrix) 405 | ierror = print_py(arr) 406 | 407 | matrix(1,1) = 1234.0 ! Change also affects 'arr' 408 | 409 | ierror = print_py(arr) 410 | 411 | call arr%destroy 412 | call forpy_finalize 413 | 414 | end program 415 | ``` 416 | 417 | ### Accessing array elements 418 | 419 | The following example shows how to access the data of a ndarray with 420 | the method `ndarray%get_data`. It also shows how to return a ndarray 421 | from a subroutine without using a copy of a Fortran array. 422 | 423 | We create a new `ndarray` with the function `ndarray_create_empty`, 424 | specifying the shape of the array. 425 | In this case storage is allocated and managed by Python. Memory is freed, when 426 | there is no reference to the ndarray anymore (don't forget to call the `destroy` method). 427 | 428 | You can also create an array of zeros with `ndarray_create_zeros` and an array 429 | of ones with `ndarray_create_ones`. 430 | 431 | To edit the values of the array, use the Fortran 432 | pointer returned from `ndarray%get_data`. 433 | 434 | ```Fortran 435 | ! Example of how to return a ndarray from a subroutine 436 | program ndarray03 437 | use forpy_mod 438 | use iso_fortran_env, only: real64 439 | implicit none 440 | 441 | integer :: ierror 442 | type(ndarray) :: arr 443 | 444 | ierror = forpy_initialize() 445 | 446 | call create_matrix(arr) 447 | ierror = print_py(arr) 448 | 449 | call arr%destroy 450 | call forpy_finalize 451 | 452 | CONTAINS 453 | 454 | subroutine create_matrix(arr) 455 | type(ndarray), intent(out) :: arr 456 | integer :: ierror, ii, jj 457 | integer, parameter :: NROWS = 2 458 | integer, parameter :: NCOLS = 3 459 | real(kind=real64), dimension(:,:), pointer :: matrix 460 | 461 | ierror = ndarray_create_empty(arr, [NROWS, NCOLS], dtype="float64") 462 | 463 | !Use ndarray%getdata to access the content of a numpy array 464 | !from Fortran 465 | 466 | !type of matrix must be compatible with dtype of ndarray 467 | !(here: real(kind=real64) and dtype="float64") 468 | ierror = arr%get_data(matrix) 469 | 470 | do jj = 1, NCOLS 471 | do ii = 1, NROWS 472 | matrix(ii, jj) = real(ii, kind=real64) * jj 473 | enddo 474 | enddo 475 | 476 | end subroutine 477 | 478 | end program 479 | ``` 480 | 481 | ## Matplotlib example 482 | This example puts together, what you have learnt so far and demonstrates 483 | a simple way to do complete error handling and some exception handling. 484 | Save the file with an uppercase .F90 extension, since it uses a 485 | C preprocessor macro for error handling. 486 | 487 | ```Fortran 488 | #define errcheck if(ierror/=0) then;call err_print;stop;endif 489 | program matplotlib_example 490 | use forpy_mod 491 | implicit none 492 | 493 | integer :: ierror, ii 494 | real, parameter :: PI = 3.1415927 495 | integer, parameter :: NPOINTS = 200 496 | real :: x(NPOINTS) 497 | real :: y(NPOINTS) 498 | 499 | do ii = 1, NPOINTS 500 | x(ii) = ((ii-1) * 2. * PI)/(NPOINTS-1) 501 | y(ii) = sin(x(ii)) 502 | enddo 503 | 504 | ierror = forpy_initialize() 505 | ! forpy_initialize returns NO_NUMPY_ERROR if numpy could not be imported 506 | ! You could still use forpy without the array features, but here we need them. 507 | if (ierror == NO_NUMPY_ERROR) then 508 | write(*,*) "This example needs numpy..." 509 | stop 510 | endif 511 | 512 | errcheck 513 | 514 | call simple_plot(x, y) 515 | 516 | call forpy_finalize 517 | 518 | CONTAINS 519 | 520 | subroutine simple_plot(x, y) 521 | real, asynchronous, intent(in) :: x(:) 522 | real, asynchronous, intent(in) :: y(:) 523 | 524 | integer :: ierror 525 | type(module_py) :: plt 526 | type(tuple) :: args 527 | type(ndarray) :: x_arr, y_arr 528 | 529 | ierror = import_py(plt, "matplotlib.pyplot") 530 | 531 | ! You can also test for certain exceptions 532 | if (ierror /= 0) then 533 | if (exception_matches(ImportError)) then 534 | write(*,*) "This example needs matplotlib..." 535 | stop 536 | else 537 | call err_print 538 | stop 539 | endif 540 | endif 541 | 542 | ierror = ndarray_create_nocopy(x_arr, x) 543 | errcheck 544 | 545 | ierror = ndarray_create_nocopy(y_arr, y) 546 | errcheck 547 | 548 | ierror = tuple_create(args, 2) 549 | errcheck 550 | 551 | ierror = args%setitem(0, x_arr) 552 | errcheck 553 | ierror = args%setitem(1, y_arr) 554 | errcheck 555 | 556 | ierror = call_py_noret(plt, "plot", args) 557 | errcheck 558 | ierror = call_py_noret(plt, "show") 559 | errcheck 560 | 561 | call x_arr%destroy 562 | call y_arr%destroy 563 | call args%destroy 564 | call plt%destroy 565 | end subroutine 566 | 567 | end program 568 | ``` 569 | 570 | ## Converting between types: `cast` and `cast_nonstrict` 571 | 572 | As we have seen in previous sections you can convert between types with 573 | the `cast` interface. 574 | The `cast` function has a rather strict behaviour, when casting between 575 | types: For example it gives an error, when you try to convert a 576 | Python float to an integer or a list to a tuple. 577 | Use `cast_nonstrict` if you need more flexibility: it does these type 578 | conversion when possible. For example: 579 | 580 | ```Fortran 581 | program cast_nonstrict_demo 582 | use forpy_mod 583 | implicit none 584 | 585 | type(object) :: obj 586 | character(len=:), allocatable :: fstr 587 | integer :: an_int 588 | integer :: ierror 589 | 590 | ierror = forpy_initialize() 591 | ierror = cast(obj, 3.14d0) !creates a Python float 592 | 593 | ierror = cast(an_int, obj) !FAIL: strict cast float->integer 594 | call err_print !show and clear error 595 | ierror = cast(fstr, obj) !FAIL: obj is a number, not a string 596 | call err_print !show and clear error 597 | 598 | ierror = cast_nonstrict(an_int, obj) !OK, truncates float (an_int = 3) 599 | ierror = cast_nonstrict(fstr, obj) !OK, result is string "3.14" 600 | 601 | write(*,*) an_int 602 | write(*,*) fstr 603 | 604 | call obj%destroy 605 | call forpy_finalize 606 | end program 607 | ``` 608 | 609 | ## Python 2 support 610 | Requirements: Python version >= 2.7 611 | 612 | For Python 2 support, you have to define the preprocessor macro PYTHON2 (compiler option -DPYTHON2). 613 | 614 | ``` 615 | gfortran -c -DPYTHON2 forpy_mod.F90 616 | gfortran intro_to_forpy.F90 forpy_mod.o `python2-config --ldflags` 617 | ``` 618 | 619 | Note that here, you use python2-config. 620 | 621 | If `python2-config` is not present on your system, install the package 622 | `python-dev` (Ubuntu, Debian). 623 | 624 | On a 32-bit system use the macro PYTHON2_32 625 | 626 | ``` 627 | gfortran -c -DPYTHON2_32 forpy_mod.F90 628 | gfortran intro_to_forpy.F90 forpy_mod.o `python2-config --ldflags` 629 | ``` 630 | 631 | On a narrow Python 2 build (**Windows**, Mac?), add PYTHON_NARROW: 632 | 633 | ``` 634 | gfortran -c -DPYTHON2 -DPYTHON_NARROW forpy_mod.F90 635 | gfortran intro_to_forpy.F90 forpy_mod.o `python2-config --ldflags` 636 | ``` 637 | 638 | "Narrow" Python builds use 2 bytes for Unicode characters, wereas 639 | "wide" builds use 4 bytes. This distinction is not relevant 640 | when using forpy with Python 3. 641 | 642 | ## Developing Python modules in Fortran 643 | 644 | With forpy, you can not only use Python from Fortran, but also write 645 | Python modules in Fortran, using all the Python datatypes you like. 646 | 647 | Note that now we have to build a shared library and the commands for 648 | building are different. 649 | Save the example below as `extexample01.F90` and build with: 650 | 651 | ``` 652 | gfortran -c -fPIC forpy_mod.F90 653 | gfortran -shared -fPIC -o extexample01.so extexample01.F90 forpy_mod.o 654 | ``` 655 | 656 | The following module `extexample01` will have one method `print_args` and a 657 | numerical constant `pi` as members: 658 | 659 | ```Fortran 660 | module extexample01 661 | use forpy_mod 662 | use iso_c_binding 663 | implicit none 664 | 665 | ! You need to declare exactly one PythonModule and PythonMethodTable 666 | ! at Fortran module level 667 | type(PythonModule), save :: mod_def 668 | type(PythonMethodTable), save :: method_table 669 | 670 | CONTAINS 671 | 672 | ! Initialisation function for Python 3 673 | ! called when importing module 674 | ! must use bind(c, name="PyInit_") 675 | ! return value must be type(c_ptr), use the return value of PythonModule%init 676 | function PyInit_extexample01() bind(c, name="PyInit_extexample01") result(m) 677 | type(c_ptr) :: m 678 | m = init() 679 | end function 680 | 681 | ! Initialisation function for Python 2 682 | ! called when importing module 683 | ! must use bind(c, name="init") 684 | ! Initialisation function for Python 2 685 | ! called when importing module 686 | ! must be called init 687 | subroutine initextexample01() bind(c, name="initextexample01") 688 | type(c_ptr) :: m 689 | m = init() 690 | end subroutine 691 | 692 | function init() result(m) 693 | type(c_ptr) :: m 694 | integer :: ierror 695 | type(object) :: pi 696 | 697 | ierror = forpy_initialize() 698 | 699 | call method_table%init(1) ! module shall have 1 method 700 | 701 | ! must add function print_args to method table to be able to use it in Python 702 | 703 | call method_table%add_method("print_args", & ! method name 704 | "Prints arguments and keyword arguments", & !doc-string 705 | METH_VARARGS + METH_KEYWORDS, & ! this method takes arguments AND keyword arguments 706 | c_funloc(print_args)) ! address of Fortran function to add 707 | 708 | m = mod_def%init("extexample01", "A Python extension with a method and a member.", method_table) 709 | 710 | ! Example: Numerical constant as member of module 711 | ierror = cast(pi, 3.141592653589793d0) 712 | ierror = mod_def%add_object("pi", pi) 713 | call pi%destroy 714 | end function 715 | 716 | ! Implementation of our Python method 717 | ! 718 | ! Corresponding Python method shall allow arguments and keyword arguments 719 | ! -> We need 3 "type(c_ptr), value" arguments 720 | ! First arg is c_ptr to module, second is c_ptr to argument tuple 721 | ! third is c_ptr to keyword argument dict 722 | ! Return value must be type(c_ptr) 723 | ! bind(c) attribute to make sure that C calling conventions are used 724 | function print_args(self_ptr, args_ptr, kwargs_ptr) result(r) bind(c) 725 | type(c_ptr), value :: self_ptr 726 | type(c_ptr), value :: args_ptr 727 | type(c_ptr), value :: kwargs_ptr 728 | type(c_ptr) :: r 729 | 730 | type(tuple) :: args 731 | type(dict) :: kwargs 732 | type(NoneType) :: retval 733 | integer :: ierror 734 | 735 | ! use unsafe_cast_from_c_ptr to cast from c_ptr to tuple/dict 736 | call unsafe_cast_from_c_ptr(args, args_ptr) 737 | call unsafe_cast_from_c_ptr(kwargs, kwargs_ptr) 738 | 739 | r = C_NULL_PTR ! in case of exception return C_NULL_PTR 740 | 741 | if (is_null(kwargs)) then 742 | ! This is a check if keyword arguments were passed to this function. 743 | ! If is_null(kwargs), kwargs is not a valid Python object, therefore 744 | ! we initialise it as an empty dict 745 | ierror = dict_create(kwargs) 746 | endif 747 | 748 | ierror = print_py(args) 749 | ierror = print_py(kwargs) 750 | 751 | ! You always need to return a Python object (as c_ptr) in the error free case. 752 | ! If you do not need a return value, return a Python None 753 | ! In case of an exception return C_NULL_PTR 754 | 755 | ierror = NoneType_create(retval) 756 | r = retval%get_c_ptr() ! need return value as c_ptr 757 | 758 | call args%destroy 759 | call kwargs%destroy 760 | 761 | end function 762 | 763 | end module 764 | ``` 765 | 766 | Python code to test the module: 767 | 768 | ```Python 769 | import extexample01 770 | extexample01.print_args("hello", 42, key="abc") 771 | print(extexample01.pi) 772 | ``` 773 | 774 | # Developer info 775 | 776 | ## Running tests 777 | 778 | ``` 779 | cd tests 780 | make clean 781 | make runtests 782 | ``` 783 | 784 | For ifort use `make FC=ifort` and for testing with Python 2 use `make PY_VERSION=2`, e. g. 785 | for ifort and Python 2: 786 | 787 | ``` 788 | make PY_VERSION=2 FC=ifort 789 | ``` 790 | 791 | ## Developing forpy 792 | 793 | Forpy is created from a template file. Therefore *do not* edit 794 | forpy_mod.F90, but only `forpy_mod.fypp`. This template file has to be preprocessed using 795 | Balint Aradi's [fypp](https://github.com/aradi/fypp). 796 | 797 | Assuming that you have fypp in your current directory, type 798 | 799 | ``` 800 | python fypp.py forpy_mod.fypp forpy_mod.F90 801 | ``` 802 | 803 | ## Building documentation 804 | 805 | You can create documentation from the source code with Chris MacMackin's 806 | [FORD](https://github.com/Fortran-FOSS-Programmers/ford) documentation generator: 807 | 808 | ``` 809 | ford forpy_project.md 810 | ``` 811 | 812 | ## Support for debug builds of Python 813 | 814 | When using a debug build of Python, one has to define the preprocessor macro `Py_DEBUG` when compiling forpy. 815 | 816 | ## Running tests with reference count checks 817 | 818 | You can run the forpy test suites such that the difference of the total reference count of Python objects 819 | before and after each test is printed. This helps with detecting reference counting bugs. To do this you need 820 | a debug build of Python *and* a debug build of numpy. Then build the tests with: 821 | 822 | ``` 823 | cd tests 824 | make clean 825 | make PY_DEBUG=1 826 | ``` 827 | 828 | If the difference in total reference count is non-zero, the difference is printed before the test status. A 829 | non-zero difference in total reference count does not necessarily mean that there is an error, for example due to 830 | internal caching or deleted objects. On the other hand, a difference of zero does not guarantee absence of reference 831 | count errors. 832 | 833 | # Notes 834 | 835 | ## Using forpy with Anaconda 836 | 837 | When using forpy with Anaconda and gfortran, you might encounter the following error: 838 | 839 | ``` 840 | /usr/bin/x86_64-linux-gnu-ld: error: lto-wrapper failed 841 | collect2: error: ld returned 1 exit status 842 | ``` 843 | 844 | 1) A solution to this problem is to add the `-fno-lto` (disable link-time optimisation) compiler flag in the linking step: 845 | 846 | ``` 847 | gfortran -c forpy_mod.F90 848 | gfortran intro_to_forpy.F90 forpy_mod.o -fno-lto `python3-config --ldflags` 849 | ``` 850 | 851 | 2) OR: Another solution is to use the `gfortran` compiler provided by the Anaconda distribution. 852 | (Install on Linux with `conda install gfortran_linux-64`) 853 | 854 | See [Anaconda compiler tools](https://docs.conda.io/projects/conda-build/en/latest/resources/compiler-tools.html) 855 | -------------------------------------------------------------------------------- /forpy_project.md: -------------------------------------------------------------------------------- 1 | project: Forpy 2 | src_dir: ./ 3 | exclude_dir: ./tests 4 | ./doc 5 | ./doc/src 6 | output_dir: ./doc 7 | project_github: https://github.com/ylikx/forpy 8 | summary: Forpy - use Python in Fortran. A library for Fortran-Python interoperability 9 | author: Elias Rabel 10 | author_description: Graz, Austria 11 | github: https://github.com/ylikx 12 | predocmark: > 13 | media_dir: ./media 14 | docmark_alt: # 15 | predocmark_alt: < 16 | display: public 17 | protected 18 | source: false 19 | graph: false 20 | search: true 21 | 22 | Forpy allows you to use Python features in Fortran ("Python in Fortran") 23 | 24 | For example: datastructures such as list, dict, tuple and interoperability 25 | of arrays using numpy. 26 | It allows you to use your own and third-party Python modules. 27 | 28 | Furthermore you can write Python (extension) modules in Fortran ("Fortran in Python") 29 | 30 | # Starting points 31 | 32 | ## Basics 33 | 34 | - Start here: [README](https://www.github.com/ylikx/forpy/README.md) 35 | - Initializing forpy: [[forpy_initialize]] 36 | - Lists: [[list]], [[list_create]] 37 | - Tuples: [[tuple]], [[tuple_create]] 38 | - Dictionaries: [[dict]], [[dict_create]] 39 | - Generic Python object: [[object]] 40 | - Converting between Fortran and Python types: [[cast]], [[cast_nonstrict]] 41 | - Calling Python functions: [[call_py]], [[call_py_noret]] 42 | - Importing Python modules: [[import_py]] 43 | - Error handling, debugging: [[err_print]], [[exception_matches]], [[err_clear]], [[print_py]] 44 | - Assignment between Python objects: [[assign_py]] 45 | 46 | ## Arrays 47 | 48 | - [[ndarray]], [[ndarray_create]] 49 | - [[ndarray_create_empty]], [[ndarray_create_zeros]], [[ndarray_create_ones]] 50 | 51 | ## Python module development 52 | 53 | - [[PythonModule]] 54 | - [[PythonMethodTable]] 55 | 56 | ## License 57 | 58 | LGPL v3 59 | -------------------------------------------------------------------------------- /tests/Makefile: -------------------------------------------------------------------------------- 1 | # Copyright (C) 2017-2018 Elias Rabel 2 | # 3 | # This program is free software: you can redistribute it and/or modify 4 | # it under the terms of the GNU Lesser General Public License as published by 5 | # the Free Software Foundation, either version 3 of the License, or 6 | # (at your option) any later version. 7 | # 8 | # This program is distributed in the hope that it will be useful, 9 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | # GNU Lesser General Public License for more details. 12 | # 13 | # You should have received a copy of the GNU Lesser General Public License 14 | # along with this program. If not, see . 15 | 16 | FC=gfortran 17 | FFLAGS=-Wall -g -O2 18 | PY_VERSION=3 19 | 20 | ifeq ($(FC),ifort) 21 | FFLAGS=-warn all -g -O2 22 | endif 23 | 24 | PYTHON=python3 25 | 26 | ifeq ($(PY_VERSION),2) 27 | PYTHON=python2 28 | FFLAGS+=-DPYTHON2 29 | endif 30 | 31 | PYTHON_CONFIG=$(PYTHON)-config 32 | 33 | ifeq ($(PY_DEBUG), 1) 34 | PYTHON_CONFIG=$(PYTHON)-dbg-config 35 | FFLAGS+= -DPy_DEBUG 36 | endif 37 | 38 | LDFLAGS=`$(PYTHON_CONFIG) --ldflags` 39 | 40 | .PHONY: tests 41 | tests: test_basics test_cast test_datastructures test_ndarray 42 | 43 | .PHONY: runtests 44 | runtests: tests 45 | ./test_basics 46 | ./test_cast 47 | ./test_datastructures 48 | ./test_ndarray 49 | 50 | test_basics: test_basics.o test_basics_mod.o forpy_mod.o unittest_mod.o forpy_tests_common_mod.o 51 | $(FC) $(FFLAGS) -o $@ $^ $(LDFLAGS) 52 | 53 | test_cast: test_cast.o test_cast_mod.o forpy_mod.o unittest_mod.o forpy_tests_common_mod.o 54 | $(FC) $(FFLAGS) -o $@ $^ $(LDFLAGS) 55 | 56 | test_datastructures: test_datastructures.o test_datastructures_mod.o forpy_mod.o unittest_mod.o forpy_tests_common_mod.o 57 | $(FC) $(FFLAGS) -o $@ $^ $(LDFLAGS) 58 | 59 | test_ndarray: test_ndarray.o test_ndarray_mod.o forpy_mod.o unittest_mod.o forpy_tests_common_mod.o 60 | $(FC) $(FFLAGS) -o $@ $^ $(LDFLAGS) 61 | 62 | unittest_mod.o: unittest_mod.F90 unittest_mod.inc 63 | $(FC) $(FFLAGS) -c -o $@ $< 64 | 65 | forpy_mod.o: ../forpy_mod.F90 66 | $(FC) $(FFLAGS) -c -o $@ $< 67 | 68 | %.o: %.F90 69 | $(FC) $(FFLAGS) -c -o $@ $< 70 | 71 | ../forpy_mod.F90: ../forpy_mod.fypp 72 | $(PYTHON) ../fypp.py ../forpy_mod.fypp ../forpy_mod.F90 73 | 74 | %.F90: %.fypp 75 | $(PYTHON) ../fypp.py $< $@ 76 | 77 | .PHONY: clean 78 | clean: 79 | rm -f *.o 80 | rm -f *.mod 81 | rm -f forpy_mod.F90 82 | rm -f test_ndarray_mod.F90 83 | rm -f test_ndarray.F90 84 | rm -f test_basics 85 | rm -f test_cast 86 | rm -f test_datastructures 87 | rm -f test_ndarray 88 | rm -f *.pyc 89 | 90 | # files generated by fypp 91 | test_ndarray_mod.F90: test_ndarray_mod.fypp 92 | test_ndarray.F90: test_ndarray.fypp 93 | 94 | # Fortran module dependencies 95 | forpy_tests_common_mod.o: forpy_mod.o unittest_mod.o 96 | test_basics.o: test_basics_mod.o 97 | test_basics_mod.o: unittest_mod.o forpy_mod.o forpy_tests_common_mod.o 98 | test_cast.o: test_cast_mod.o 99 | test_cast_mod.o: unittest_mod.o forpy_mod.o forpy_tests_common_mod.o 100 | test_datastructures.o: test_datastructures_mod.o 101 | test_datastructures_mod.o: unittest_mod.o forpy_mod.o forpy_tests_common_mod.o 102 | test_ndarray.o: test_ndarray_mod.o 103 | test_ndarray_mod.o: unittest_mod.o forpy_mod.o forpy_tests_common_mod.o 104 | 105 | -------------------------------------------------------------------------------- /tests/forpy_tests_common_mod.F90: -------------------------------------------------------------------------------- 1 | ! Copyright (C) 2017-2018 Elias Rabel 2 | ! 3 | ! This program is free software: you can redistribute it and/or modify 4 | ! it under the terms of the GNU Lesser General Public License as published by 5 | ! the Free Software Foundation, either version 3 of the License, or 6 | ! (at your option) any later version. 7 | ! 8 | ! This program is distributed in the hope that it will be useful, 9 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ! GNU Lesser General Public License for more details. 12 | ! 13 | ! You should have received a copy of the GNU Lesser General Public License 14 | ! along with this program. If not, see . 15 | 16 | !> This module contains common code that all forpy test suites use 17 | !> to help with testing. 18 | module forpy_tests_common_mod 19 | use unittest_mod, only: fail_test, get_fail_flag 20 | use forpy_mod, only: PY_SSIZE_T_KIND, have_exception, err_print 21 | use iso_c_binding 22 | implicit none 23 | 24 | public :: save_total_refcount, check_total_refcount, gettotalrefcount, & 25 | setUp_forpy_test, tearDown_forpy_test 26 | 27 | PRIVATE 28 | 29 | integer(kind=PY_SSIZE_T_KIND), save :: saved_total_refcount = 0 30 | 31 | interface 32 | !PyObject *PySys_GetObject(const char *name) 33 | function PySys_GetObject(a_name) bind(c, name="PySys_GetObject") result(r) 34 | import c_ptr, C_CHAR 35 | character(kind=C_CHAR), dimension(*) :: a_name 36 | type(c_ptr) :: r 37 | end function 38 | 39 | function PyObject_CallObject(callable_object, args) bind(c, name="PyObject_CallObject") result(r) 40 | import c_ptr 41 | type(c_ptr), value :: callable_object, args 42 | type(c_ptr) :: r 43 | end function 44 | 45 | !Py_ssize_t PyNumber_AsSsize_t(PyObject *o, PyObject *exc) 46 | function PyNumber_AsSsize_t(o, exc) bind(c, name="PyNumber_AsSsize_t") result(r) 47 | import c_ptr, PY_SSIZE_T_KIND 48 | type(c_ptr), value :: o 49 | type(c_ptr), value :: exc 50 | integer(kind=PY_SSIZE_T_KIND) :: r 51 | end function 52 | 53 | !void Py_DecRef(PyObject *o) 54 | subroutine Py_DecRef(o) bind(c, name="Py_DecRef") 55 | import c_ptr 56 | type(c_ptr), value :: o 57 | end subroutine 58 | 59 | end interface 60 | 61 | CONTAINS 62 | 63 | !> Get total reference count. Only works with debug builds of cpython. 64 | !> Implemented using Python C-API calls, since it would not be good 65 | !> to implement it using the functions that we want to test. 66 | !> Returns -1 on error, no exceptions set 67 | function gettotalrefcount() result(cnt) 68 | integer(kind=C_LONG) :: cnt 69 | 70 | type(c_ptr) :: gettotalrefcount_method 71 | type(c_ptr) :: cnt_py 72 | 73 | cnt = -1 74 | gettotalrefcount_method = PySys_GetObject("gettotalrefcount" // C_NULL_CHAR) ! borrowed ref 75 | if (.not. c_associated(gettotalrefcount_method)) then 76 | return 77 | endif 78 | 79 | cnt_py = PyObject_CallObject(gettotalrefcount_method, C_NULL_PTR) 80 | if (.not. c_associated(gettotalrefcount_method)) then 81 | return 82 | endif 83 | 84 | cnt = PyNumber_AsSsize_t(cnt_py, C_NULL_PTR) 85 | call Py_DecRef(cnt_py) 86 | 87 | end function 88 | 89 | subroutine save_total_refcount() 90 | saved_total_refcount = gettotalrefcount() 91 | end subroutine 92 | 93 | subroutine check_total_refcount() 94 | integer(kind=PY_SSIZE_T_KIND) :: current_total_refcount 95 | 96 | current_total_refcount = gettotalrefcount() 97 | 98 | if (current_total_refcount /= saved_total_refcount) then 99 | !call fail_test 100 | write(*,*) 101 | write(*,fmt="(' Following test: Refcount before/after not the same: ',I7,'/',I7,' diff=',I7)") & 102 | saved_total_refcount, current_total_refcount, (current_total_refcount - saved_total_refcount) 103 | write(*,*) "This does not necessarily mean that there is an error." 104 | write(*,*) "The total refcount might change due to internal caching, deleted objects, garbage collector behaviour..." 105 | write(*,*) "Try running the test several times to see if the problem persists." 106 | endif 107 | end subroutine 108 | 109 | !> To be called before every forpy test. 110 | subroutine setUp_forpy_test() 111 | #ifdef Py_DEBUG 112 | call save_total_refcount 113 | #endif 114 | end subroutine 115 | 116 | !> To be called after every forpy test. 117 | !> Checks if there is an uncleared exception. 118 | !> Only for Python debug builds: Checks if total reference has changed. 119 | subroutine tearDown_forpy_test() 120 | !check if there is an uncleared exception - if yes, fail the test and clear 121 | if (have_exception()) then 122 | call fail_test 123 | write(*,*) "The test did not clear the following exception:" 124 | call err_print 125 | return 126 | endif 127 | 128 | #ifdef Py_DEBUG 129 | ! test refcounts only when test has passed so far 130 | if (get_fail_flag() == 0) then 131 | call check_total_refcount 132 | endif 133 | #endif 134 | end subroutine 135 | 136 | end module 137 | -------------------------------------------------------------------------------- /tests/test_basics.F90: -------------------------------------------------------------------------------- 1 | ! Copyright (C) 2017-2018 Elias Rabel 2 | ! 3 | ! This program is free software: you can redistribute it and/or modify 4 | ! it under the terms of the GNU Lesser General Public License as published by 5 | ! the Free Software Foundation, either version 3 of the License, or 6 | ! (at your option) any later version. 7 | ! 8 | ! This program is distributed in the hope that it will be useful, 9 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ! GNU Lesser General Public License for more details. 12 | ! 13 | ! You should have received a copy of the GNU Lesser General Public License 14 | ! along with this program. If not, see . 15 | 16 | #ifdef __GFORTRAN__ 17 | #define TEST(X) call setN("X");call preT;call X;call postT 18 | #else 19 | #define TEST(X) call setN(#X);call preT;call X;call postT 20 | #endif 21 | 22 | program test_basics 23 | use test_basics_mod 24 | implicit none 25 | 26 | call setUpClass 27 | 28 | TEST(test_multiple_inits) 29 | TEST(test_getattribute) 30 | TEST(test_getattribute_does_not_exist) 31 | TEST(test_setattr) 32 | TEST(test_delattr) 33 | TEST(test_simple_call) 34 | TEST(test_call_py_noret_kwargs) 35 | TEST(test_check_args01) 36 | TEST(test_check_args02) 37 | TEST(test_check_args03) 38 | TEST(test_check_args04) 39 | TEST(test_does_not_exist) 40 | TEST(test_raise_exc) 41 | TEST(test_raise_exc2) 42 | TEST(test_check_arg) 43 | TEST(test_check_kwarg) 44 | TEST(test_instantiate) 45 | TEST(test_getitem_char_1d_bad) 46 | TEST(test_bad_utf8) 47 | TEST(test_is_int) 48 | TEST(test_return_small) 49 | TEST(test_return_large) 50 | TEST(test_int_overflow) 51 | TEST(test_int64) 52 | TEST(test_int32_bounds) 53 | TEST(test_int_expected) 54 | TEST(test_print_py) 55 | TEST(test_print_py_kwargs) 56 | TEST(test_get_zero_length_str) 57 | TEST(test_get_zero_length_str2) 58 | TEST(test_exception_before_return) 59 | TEST(test_minus_ones64) 60 | TEST(test_minus_ones32) 61 | TEST(test_return_unicode) 62 | TEST(test_return_bytes) 63 | TEST(test_check_sys_argv) 64 | 65 | call tearDownClass 66 | 67 | end program 68 | -------------------------------------------------------------------------------- /tests/test_basics.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | # -*- coding: UTF-8 -*- 3 | 4 | # Copyright (C) 2017-2018 Elias Rabel 5 | # 6 | # This program is free software: you can redistribute it and/or modify 7 | # it under the terms of the GNU Lesser General Public License as published by 8 | # the Free Software Foundation, either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU Lesser General Public License for more details. 15 | # 16 | # You should have received a copy of the GNU Lesser General Public License 17 | # along with this program. If not, see . 18 | 19 | import sys 20 | 21 | test_attribute = 123 22 | attribute_to_delete = 321 23 | 24 | def do_nothing(): 25 | pass 26 | 27 | def check_args_kwargs(*args, **kwargs): 28 | """Tests if there are args or kwargs 29 | returns: 0 - no args, no kwargs 30 | 1 - args, no kwargs 31 | 2 - no args, kwargs 32 | 3 args and kwargs present""" 33 | res = 0 34 | if len(args) > 0: 35 | res += 1 36 | if len(kwargs) > 0: 37 | res += 2 38 | 39 | return res 40 | 41 | def raise_exc(): 42 | raise StopIteration 43 | 44 | def check_arg(v): 45 | return (v == 42) 46 | 47 | def check_kwarg(hello=99): 48 | return (hello == 42) 49 | 50 | 51 | class MyClass(object): 52 | def __init__(self): 53 | self.x = 42 54 | 55 | def return_small(): 56 | return 5 57 | 58 | def return_medium(): 59 | return 2**48 60 | 61 | def return_large(): 62 | return 2**100 63 | 64 | def return_int32_bounds(): 65 | return (-2**31 - 1, -2**31, 2**31-1, 2**31) 66 | 67 | def int_expected(n): 68 | if not isinstance(n, int): 69 | raise TypeError 70 | 71 | def get_zero_length_str(): 72 | return "" 73 | 74 | def exception_before_return(): 75 | raise RuntimeError 76 | return 3.14 77 | 78 | def return_unicode(): 79 | return u"埃利亚斯" 80 | 81 | def return_bytes(): 82 | return b"saile" 83 | 84 | def check_sys_argv(): 85 | if sys.argv != ['']: 86 | raise RuntimeError("sys.argv != [''], argv = {0}".format(sys.argv)) 87 | 88 | -------------------------------------------------------------------------------- /tests/test_basics_mod.F90: -------------------------------------------------------------------------------- 1 | ! Copyright (C) 2017-2018 Elias Rabel 2 | ! 3 | ! This program is free software: you can redistribute it and/or modify 4 | ! it under the terms of the GNU Lesser General Public License as published by 5 | ! the Free Software Foundation, either version 3 of the License, or 6 | ! (at your option) any later version. 7 | ! 8 | ! This program is distributed in the hope that it will be useful, 9 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ! GNU Lesser General Public License for more details. 12 | ! 13 | ! You should have received a copy of the GNU Lesser General Public License 14 | ! along with this program. If not, see . 15 | 16 | module test_basics_mod 17 | use unittest_mod 18 | use forpy_mod 19 | use forpy_tests_common_mod, only: setUp_forpy_test, tearDown_forpy_test, gettotalrefcount 20 | use iso_fortran_env 21 | use iso_c_binding 22 | implicit none 23 | 24 | type(module_py), save :: test_mod 25 | 26 | CONTAINS 27 | 28 | #include "unittest_mod.inc" 29 | 30 | subroutine test_multiple_inits 31 | integer ierror, ierror2 32 | logical ok 33 | ! it must be safe to call forpy_initialize multiple times 34 | ierror = forpy_initialize() 35 | ok = (ierror == 0 .or. ierror == NO_NUMPY_ERROR) 36 | ASSERT(ok) 37 | ierror2 = forpy_initialize() 38 | ASSERT(ierror==ierror2) 39 | ierror2 = forpy_initialize() 40 | ASSERT(ierror==ierror2) 41 | end subroutine 42 | 43 | subroutine test_getattribute 44 | integer :: ierror 45 | type(object) :: attr 46 | ierror = test_mod%getattribute(attr, "do_nothing") 47 | ASSERT(ierror==0) 48 | call attr%destroy 49 | end subroutine 50 | 51 | subroutine test_getattribute_does_not_exist 52 | integer :: ierror 53 | type(object) :: attr 54 | ierror = test_mod%getattribute(attr, "does_not_exist") 55 | ASSERT(ierror/=0) 56 | ASSERT(have_exception()) 57 | call err_clear 58 | call attr%destroy 59 | end subroutine 60 | 61 | subroutine test_setattr 62 | integer :: ierror 63 | type(object) :: attr 64 | ierror = cast(attr, 123) 65 | ASSERT(ierror==0) 66 | ierror = test_mod%setattr("test_attribute33", attr) 67 | ASSERT(ierror==0) 68 | call attr%destroy 69 | end subroutine 70 | 71 | subroutine test_delattr 72 | integer :: ierror 73 | ierror = test_mod%delattr("attribute_to_delete") 74 | ASSERT(ierror==0) 75 | end subroutine 76 | 77 | subroutine test_simple_call 78 | integer ierror 79 | type(object) :: retval 80 | type(tuple) :: args 81 | type(dict) :: kwargs 82 | ierror = tuple_create(args, 0) 83 | ASSERT(ierror==0) 84 | ierror = dict_create(kwargs) 85 | ASSERT(ierror==0) 86 | ierror = call_py(retval, test_mod, "do_nothing", args, kwargs) 87 | ASSERT(ierror==0) 88 | ASSERT(is_none(retval)) 89 | call retval%destroy 90 | call args%destroy 91 | call kwargs%destroy 92 | end subroutine 93 | 94 | subroutine test_call_py_noret_kwargs 95 | integer ierror 96 | type(tuple) :: args 97 | type(dict) :: kwargs 98 | ierror = tuple_create(args, 0) 99 | ASSERT(ierror==0) 100 | ierror = dict_create(kwargs) 101 | ASSERT(ierror==0) 102 | ierror = call_py_noret(test_mod, "check_args_kwargs", args, kwargs) 103 | ASSERT(ierror==0) 104 | call args%destroy 105 | call kwargs%destroy 106 | end subroutine 107 | 108 | subroutine test_check_args01 109 | integer ierror 110 | type(object) :: retval 111 | integer res 112 | type(tuple) :: args 113 | type(dict) :: kwargs 114 | ierror = tuple_create(args, 1) 115 | ierror = args%setitem(0, 101) 116 | ierror = dict_create(kwargs) 117 | ierror = kwargs%setitem("greeting", "hi") 118 | ierror = call_py(retval, test_mod, "check_args_kwargs", args, kwargs) 119 | ASSERT(ierror==0) 120 | ierror = cast(res, retval) 121 | ASSERT(res == 3) 122 | call retval%destroy 123 | call args%destroy 124 | call kwargs%destroy 125 | end subroutine 126 | 127 | subroutine test_check_args02 128 | integer ierror 129 | type(object) :: retval 130 | integer res 131 | type(tuple) :: args 132 | ierror = tuple_create(args, 1) 133 | ierror = args%setitem(0, 101) 134 | ierror = call_py(retval, test_mod, "check_args_kwargs", args) 135 | ASSERT(ierror==0) 136 | ierror = cast(res, retval) 137 | ASSERT(res == 1) 138 | call retval%destroy 139 | call args%destroy 140 | end subroutine 141 | 142 | subroutine test_check_args03 143 | integer ierror 144 | type(object) :: retval 145 | integer res 146 | type(dict) :: kwargs 147 | ierror = dict_create(kwargs) 148 | ierror = kwargs%setitem("greeting", "hi") 149 | ierror = call_py(retval, test_mod, "check_args_kwargs", kwargs=kwargs) 150 | ASSERT(ierror==0) 151 | ierror = cast(res, retval) 152 | ASSERT(res == 2) 153 | call retval%destroy 154 | call kwargs%destroy 155 | end subroutine 156 | 157 | subroutine test_check_args04 158 | integer ierror 159 | type(object) :: retval 160 | integer res 161 | ierror = call_py(retval, test_mod, "check_args_kwargs") 162 | ASSERT(ierror==0) 163 | ierror = cast(res, retval) 164 | ASSERT(res == 0) 165 | call retval%destroy 166 | end subroutine 167 | 168 | subroutine test_does_not_exist 169 | integer ierror 170 | type(object) :: retval 171 | type(tuple) :: args 172 | type(dict) :: kwargs 173 | logical :: exc_correct 174 | ierror = tuple_create(args, 0) 175 | ierror = dict_create(kwargs) 176 | ierror = call_py(retval, test_mod, "does_not_exist", args, kwargs) 177 | ASSERT(ierror==EXCEPTION_ERROR) 178 | exc_correct = exception_matches(AttributeError) 179 | ASSERT(exc_correct) 180 | call err_clear 181 | call args%destroy 182 | call kwargs%destroy 183 | end subroutine 184 | 185 | subroutine test_raise_exc 186 | integer ierror 187 | type(object) :: retval 188 | type(tuple) :: args 189 | type(dict) :: kwargs 190 | logical :: exc_correct 191 | ierror = tuple_create(args, 0) 192 | ierror = dict_create(kwargs) 193 | ierror = call_py(retval, test_mod, "raise_exc", args, kwargs) 194 | ASSERT(ierror==EXCEPTION_ERROR) 195 | exc_correct = exception_matches(StopIteration) 196 | ASSERT(exc_correct) 197 | call err_clear 198 | call retval%destroy 199 | call args%destroy 200 | call kwargs%destroy 201 | end subroutine 202 | 203 | subroutine test_raise_exc2 204 | logical exc_correct 205 | call raise_exception(RuntimeError, "test") 206 | ASSERT(have_exception()) 207 | exc_correct = exception_matches(RuntimeError) 208 | ASSERT(exc_correct) 209 | call err_clear 210 | end subroutine 211 | 212 | subroutine test_check_arg 213 | integer ierror 214 | type(object) :: retval 215 | type(tuple) :: args 216 | type(dict) :: kwargs 217 | logical :: flag 218 | flag = .false. 219 | ierror = tuple_create(args, 1) 220 | ierror = args%setitem(0, 42) 221 | ierror = dict_create(kwargs) 222 | ierror = call_py(retval, test_mod, "check_arg", args, kwargs) 223 | ASSERT(ierror==0) 224 | ierror = cast(flag, retval) 225 | ASSERT(ierror==0) 226 | ASSERT(flag) 227 | call retval%destroy 228 | call args%destroy 229 | call kwargs%destroy 230 | end subroutine 231 | 232 | subroutine test_check_kwarg 233 | integer ierror 234 | type(object) :: retval 235 | type(tuple) :: args 236 | type(dict) :: kwargs 237 | logical :: flag 238 | flag = .false. 239 | ierror = tuple_create(args, 0) 240 | ierror = dict_create(kwargs) 241 | ierror = kwargs%setitem("hello", 42) 242 | ierror = call_py(retval, test_mod, "check_kwarg", args, kwargs) 243 | ASSERT(ierror==0) 244 | ierror = cast(flag, retval) 245 | ASSERT(ierror==0) 246 | ASSERT(flag) 247 | call retval%destroy 248 | call args%destroy 249 | call kwargs%destroy 250 | end subroutine 251 | 252 | subroutine test_instantiate 253 | integer ierror 254 | type(object) :: instance, property 255 | type(tuple) :: args 256 | type(dict) :: kwargs 257 | ierror = tuple_create(args, 0) 258 | ierror = dict_create(kwargs) 259 | ierror = call_py(instance, test_mod, "MyClass", args, kwargs) 260 | ASSERT(ierror==0) 261 | ierror = instance%getattribute(property, "x") 262 | ASSERT(ierror==0) 263 | call instance%destroy 264 | call property%destroy 265 | call args%destroy 266 | call kwargs%destroy 267 | end subroutine 268 | 269 | subroutine test_getitem_char_1d_bad 270 | integer ierror 271 | type(list) :: li 272 | logical :: exc_correct 273 | character(kind=C_CHAR), dimension(:), pointer :: ptr 274 | ierror = list_create(li) 275 | ASSERT(ierror==0) 276 | ierror = li%append(101) 277 | ASSERT(ierror==0) 278 | ierror = li%getitem(ptr, 0) 279 | ASSERT(ierror==EXCEPTION_ERROR) 280 | exc_correct = exception_matches(TypeError) 281 | ASSERT(exc_correct) 282 | call err_clear 283 | call li%destroy 284 | end subroutine 285 | 286 | subroutine test_bad_utf8 287 | integer ierror 288 | character(kind=C_CHAR, len=2) :: s 289 | type(unicode) :: uni 290 | logical :: exc_correct 291 | s(1:1) = char(128) 292 | s(2:2) = '@' 293 | ierror = unicode_create(uni, s) 294 | ASSERT(ierror==EXCEPTION_ERROR) 295 | exc_correct = exception_matches(UnicodeDecodeError) 296 | ASSERT(exc_correct) 297 | call err_clear 298 | ASSERT(is_null(uni)) 299 | end subroutine 300 | 301 | subroutine test_is_int 302 | integer ierror 303 | type(object) :: ii 304 | ierror = cast(ii, 101) 305 | ASSERT(is_int(ii)) 306 | call ii%destroy 307 | end subroutine 308 | 309 | subroutine test_return_small 310 | integer ierror 311 | type(object) :: retval 312 | type(tuple) :: args 313 | type(dict) :: kwargs 314 | integer :: element 315 | ierror = tuple_create(args, 0) 316 | ierror = dict_create(kwargs) 317 | ierror = call_py(retval, test_mod, "return_small", args, kwargs) 318 | ASSERT(ierror==0) 319 | ierror = cast(element, retval) 320 | ASSERT(is_int(retval)) 321 | ASSERT(ierror==0) 322 | ASSERT(element==5) 323 | call retval%destroy 324 | call args%destroy 325 | call kwargs%destroy 326 | end subroutine 327 | 328 | subroutine test_return_large 329 | integer ierror 330 | type(object) :: retval 331 | type(tuple) :: args 332 | type(dict) :: kwargs 333 | logical :: exc_correct 334 | integer :: element 335 | ierror = tuple_create(args, 0) 336 | ierror = dict_create(kwargs) 337 | ierror = call_py(retval, test_mod, "return_large", args, kwargs) 338 | ASSERT(ierror==0) 339 | ierror = cast(element, retval) 340 | ASSERT(is_int(retval)) 341 | ASSERT(ierror==EXCEPTION_ERROR) 342 | exc_correct = exception_matches(OverflowError) 343 | ASSERT(exc_correct) 344 | ASSERT(element==-1) 345 | call err_clear 346 | call retval%destroy 347 | call args%destroy 348 | call kwargs%destroy 349 | end subroutine 350 | 351 | subroutine test_int_overflow 352 | integer ierror 353 | type(object) :: retval 354 | type(tuple) :: args 355 | type(dict) :: kwargs 356 | logical :: exc_correct 357 | integer(kind=int32) :: element 358 | ierror = tuple_create(args, 0) 359 | ierror = dict_create(kwargs) 360 | ierror = call_py(retval, test_mod, "return_medium", args, kwargs) 361 | ASSERT(ierror==0) 362 | ierror = cast(element, retval) 363 | ASSERT(is_int(retval)) 364 | ASSERT(ierror==EXCEPTION_ERROR) 365 | exc_correct = exception_matches(OverflowError) 366 | ASSERT(exc_correct) 367 | call err_clear 368 | call retval%destroy 369 | call args%destroy 370 | call kwargs%destroy 371 | end subroutine 372 | 373 | subroutine test_int64 374 | integer ierror 375 | type(object) :: retval 376 | type(tuple) :: args 377 | type(dict) :: kwargs 378 | integer(kind=int64) :: element 379 | ierror = tuple_create(args, 0) 380 | ierror = dict_create(kwargs) 381 | ierror = call_py(retval, test_mod, "return_medium", args, kwargs) 382 | ASSERT(ierror==0) 383 | ierror = cast(element, retval) 384 | ASSERT(is_int(retval)) 385 | ASSERT(ierror==0) 386 | ASSERT(.not. have_exception()) 387 | ASSERT(element==281474976710656_int64) 388 | call retval%destroy 389 | call args%destroy 390 | call kwargs%destroy 391 | end subroutine 392 | 393 | subroutine test_int32_bounds 394 | integer ierror 395 | type(object) :: retval 396 | type(tuple) :: bounds 397 | type(tuple) :: args 398 | type(dict) :: kwargs 399 | integer(kind=int32) :: element 400 | ierror = tuple_create(args, 0) 401 | ierror = dict_create(kwargs) 402 | ierror = call_py(retval, test_mod, "return_int32_bounds", args, kwargs) 403 | ASSERT(ierror==0) 404 | ierror = cast(bounds, retval) 405 | ASSERT(ierror==0) 406 | 407 | ! -2**31-1 out of bounds 408 | ierror = bounds%getitem(element, 0) 409 | ASSERT(ierror == EXCEPTION_ERROR) 410 | ASSERT(have_exception()) 411 | call err_clear 412 | 413 | ! -2**31 in bounds 414 | ierror = bounds%getitem(element, 1) 415 | ASSERT(ierror == 0) 416 | ASSERT(.not. have_exception()) 417 | call err_clear 418 | 419 | ! 2**31 - 1 in bounds 420 | ierror = bounds%getitem(element, 2) 421 | ASSERT(ierror == 0) 422 | ASSERT(.not. have_exception()) 423 | call err_clear 424 | 425 | ! 2**31 out of bounds 426 | ierror = bounds%getitem(element, 3) 427 | ASSERT(ierror /= 0) 428 | ASSERT(have_exception()) 429 | call err_clear 430 | 431 | call bounds%destroy 432 | call retval%destroy 433 | call args%destroy 434 | call kwargs%destroy 435 | end subroutine 436 | 437 | subroutine test_int_expected 438 | integer ierror 439 | type(tuple) :: args 440 | ierror = tuple_create(args, 1) 441 | ierror = args%setitem(0, 555) 442 | ierror = call_py_noret(test_mod, "int_expected", args) 443 | ASSERT(ierror==0) 444 | ASSERT(.not. have_exception()) 445 | call args%destroy 446 | end subroutine 447 | 448 | subroutine test_print_py 449 | integer ierror 450 | type(str) :: message 451 | ierror = str_create(message, "Testing the print function.") 452 | ASSERT(ierror==0) 453 | ierror = print_py(message) 454 | ASSERT(ierror==0) 455 | call message%destroy 456 | end subroutine 457 | 458 | subroutine test_print_py_kwargs 459 | integer ierror 460 | type(str) :: message 461 | type(dict) :: kwargs 462 | ierror = str_create(message, "Testing the print function with kwargs") 463 | ASSERT(ierror==0) 464 | ierror = dict_create(kwargs) 465 | ASSERT(ierror==0) 466 | ierror = kwargs%setitem("end", "!" // C_NEW_LINE) 467 | ASSERT(ierror==0) 468 | ierror = print_py(message, kwargs) 469 | ASSERT(ierror==0) 470 | call kwargs%destroy 471 | call message%destroy 472 | end subroutine 473 | 474 | subroutine test_get_zero_length_str 475 | integer ierror 476 | character(kind=C_CHAR), dimension(:), pointer :: ptr 477 | type(object) :: retval 478 | ierror = call_py(retval, test_mod, "get_zero_length_str") 479 | ASSERT(ierror==0) 480 | ASSERT(is_str(retval)) 481 | ierror = cast(ptr, retval) 482 | ASSERT(ierror==0) 483 | ASSERT(size(ptr)==0) 484 | call retval%destroy 485 | end subroutine 486 | 487 | subroutine test_get_zero_length_str2 488 | integer ierror 489 | character(kind=C_CHAR, len=:), allocatable :: a_str 490 | type(object) :: retval 491 | ierror = call_py(retval, test_mod, "get_zero_length_str") 492 | ASSERT(ierror==0) 493 | ASSERT(is_str(retval)) 494 | ierror = cast(a_str, retval) 495 | ASSERT(ierror==0) 496 | ASSERT(len(a_str)==0) 497 | ASSERT(allocated(a_str)) 498 | call retval%destroy 499 | end subroutine 500 | 501 | subroutine test_exception_before_return 502 | integer ierror 503 | type(object) :: retval 504 | ierror = call_py(retval, test_mod, "exception_before_return") 505 | ASSERT(ierror/=0) 506 | ASSERT(have_exception()) 507 | ASSERT(is_null(retval)) 508 | call err_clear 509 | call retval%destroy 510 | end subroutine 511 | 512 | subroutine test_minus_ones64 513 | ! Testing values of -1, because C-api sometimes uses this value as error 514 | ! indicator 515 | integer ierror 516 | type(list) :: a_list 517 | integer(kind=int64) :: f_int 518 | complex(kind=real64) :: f_complex 519 | real(kind=real64) :: f_real 520 | integer(kind=int64), parameter :: minus_one = -1_int64 521 | complex(kind=real64), parameter :: c_minus_one = (-1.0_real64, 0.0_real64) 522 | real(kind=real64), parameter :: r_minus_one = -1.0_real64 523 | ierror = list_create(a_list) 524 | ASSERT(ierror==0) 525 | ierror = a_list%append(minus_one) 526 | ierror = a_list%append(r_minus_one) 527 | ierror = a_list%append(c_minus_one) 528 | ASSERT(.not. have_exception()) 529 | ierror = a_list%getitem(f_int, 0) 530 | ASSERT(ierror==0) 531 | ASSERT(f_int==minus_one) 532 | ierror = a_list%getitem(f_real, 1) 533 | ASSERT(ierror==0) 534 | ASSERT(f_real==r_minus_one) 535 | ierror = a_list%getitem(f_complex, 2) 536 | ASSERT(ierror==0) 537 | ASSERT(f_complex==c_minus_one) 538 | call a_list%destroy 539 | end subroutine 540 | 541 | subroutine test_minus_ones32 542 | ! Testing values of -1, because C-api sometimes uses this value as error 543 | ! indicator 544 | integer ierror 545 | type(list) :: a_list 546 | integer(kind=int32) :: f_int 547 | complex(kind=real32) :: f_complex 548 | real(kind=real32) :: f_real 549 | integer(kind=int32), parameter :: minus_one = -1_int32 550 | complex(kind=real32), parameter :: c_minus_one = (-1.0_real32, 0.0_real32) 551 | real(kind=real32), parameter :: r_minus_one = -1.0_real32 552 | ierror = list_create(a_list) 553 | ASSERT(ierror==0) 554 | ierror = a_list%append(minus_one) 555 | ierror = a_list%append(r_minus_one) 556 | ierror = a_list%append(c_minus_one) 557 | ASSERT(.not. have_exception()) 558 | ierror = a_list%getitem(f_int, 0) 559 | ASSERT(ierror==0) 560 | ASSERT(f_int==minus_one) 561 | ierror = a_list%getitem(f_real, 1) 562 | ASSERT(ierror==0) 563 | ASSERT(f_real==r_minus_one) 564 | ierror = a_list%getitem(f_complex, 2) 565 | ASSERT(ierror==0) 566 | ASSERT(f_complex==c_minus_one) 567 | call a_list%destroy 568 | end subroutine 569 | 570 | subroutine test_return_unicode 571 | integer ierror 572 | character(kind=C_CHAR, len=:), allocatable :: uni 573 | type(object) :: retval 574 | character(kind=C_CHAR, len=12) :: solution 575 | 576 | solution(1:1) = char(229, kind=C_CHAR) 577 | solution(2:2) = char(159, kind=C_CHAR) 578 | solution(3:3) = char(131, kind=C_CHAR) 579 | solution(4:4) = char(229, kind=C_CHAR) 580 | solution(5:5) = char(136, kind=C_CHAR) 581 | solution(6:6) = char(169, kind=C_CHAR) 582 | solution(7:7) = char(228, kind=C_CHAR) 583 | solution(8:8) = char(186, kind=C_CHAR) 584 | solution(9:9) = char(154, kind=C_CHAR) 585 | solution(10:10) = char(230, kind=C_CHAR) 586 | solution(11:11) = char(150, kind=C_CHAR) 587 | solution(12:12) = char(175, kind=C_CHAR) 588 | 589 | ierror = call_py(retval, test_mod, "return_unicode") 590 | ASSERT(ierror==0) 591 | ASSERT(is_unicode(retval)) 592 | ierror = cast(uni, retval) 593 | ASSERT(ierror==0) 594 | 595 | ASSERT(uni==solution) 596 | ASSERT(len(uni)==12) 597 | 598 | call retval%destroy 599 | end subroutine 600 | 601 | subroutine test_return_bytes 602 | integer ierror 603 | type(object) :: retval 604 | 605 | ierror = call_py(retval, test_mod, "return_bytes") 606 | ASSERT(ierror==0) 607 | ASSERT(is_bytes(retval)) 608 | ASSERT(.not. is_unicode(retval)) 609 | #ifdef PYTHON2 610 | ASSERT(is_str(retval)) 611 | #else 612 | ASSERT(.not. is_str(retval)) 613 | #endif 614 | 615 | call retval%destroy 616 | end subroutine 617 | 618 | ! Test if sys.argv exists and was set to [''], since some Python 619 | ! packages need it 620 | subroutine test_check_sys_argv() 621 | integer :: ierror 622 | ierror = call_py_noret(test_mod, "check_sys_argv") 623 | ASSERT(ierror==0) 624 | end subroutine 625 | 626 | subroutine setUp() 627 | call setUp_forpy_test 628 | end subroutine 629 | 630 | subroutine tearDown() 631 | call tearDown_forpy_test 632 | end subroutine 633 | 634 | subroutine setUpClass() 635 | integer ierror 636 | ierror = forpy_initialize() 637 | 638 | if (ierror < 0) then 639 | write (*,*) "Initialisation of forpy failed!!! Tests might fail. Errorcode: ", ierror 640 | endif 641 | 642 | ! add current dir to search path 643 | ierror = run_string(C_CHAR_"import sys" // C_NEW_LINE // C_CHAR_"sys.path.append('.')"//C_NEW_LINE // C_NULL_CHAR) 644 | if (ierror /= 0) then 645 | write(*,*) "Error setting PYTHONPATH. Cannot test...", ierror 646 | call err_print 647 | STOP 648 | endif 649 | 650 | ierror = import_py(test_mod, "test_basics") 651 | if (ierror /= 0) then 652 | write(*,*) "Could not import test module 'test_basics'. Cannot test..." 653 | STOP 654 | endif 655 | end subroutine 656 | 657 | subroutine tearDownClass() 658 | call test_mod%destroy 659 | call forpy_finalize() 660 | 661 | call print_test_count 662 | end subroutine 663 | 664 | end module 665 | -------------------------------------------------------------------------------- /tests/test_cast.F90: -------------------------------------------------------------------------------- 1 | ! Copyright (C) 2017-2018 Elias Rabel 2 | ! 3 | ! This program is free software: you can redistribute it and/or modify 4 | ! it under the terms of the GNU Lesser General Public License as published by 5 | ! the Free Software Foundation, either version 3 of the License, or 6 | ! (at your option) any later version. 7 | ! 8 | ! This program is distributed in the hope that it will be useful, 9 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ! GNU Lesser General Public License for more details. 12 | ! 13 | ! You should have received a copy of the GNU Lesser General Public License 14 | ! along with this program. If not, see . 15 | 16 | #ifdef __GFORTRAN__ 17 | #define TEST(X) call setN("X");call preT;call X;call postT 18 | #else 19 | #define TEST(X) call setN(#X);call preT;call X;call postT 20 | #endif 21 | 22 | program test_cast 23 | use test_cast_mod 24 | implicit none 25 | 26 | call setUpClass 27 | 28 | TEST(test_cast_tuple_to_list) 29 | TEST(test_cast_float_to_int) 30 | TEST(test_cast_float_to_logical) 31 | TEST(test_cast_int_to_float) 32 | TEST(test_cast_bool_to_int) 33 | TEST(test_cast_int_to_logical) 34 | TEST(test_cast_nonstrict_real) 35 | TEST(test_cast_nonstrict_complex) 36 | TEST(test_cast_nonstrict_int) 37 | TEST(test_cast_nonstrict_list) 38 | TEST(test_cast_nonstrict_numeric) 39 | 40 | TEST(test_cast_nonstrict_list_to_list) 41 | TEST(test_cast_nonstrict_tuple_to_list) 42 | TEST(test_cast_nonstrict_int_to_list) 43 | 44 | TEST(test_cast_nonstrict_list_to_tuple) 45 | TEST(test_cast_nonstrict_tuple_to_tuple) 46 | TEST(test_cast_nonstrict_int_to_tuple) 47 | 48 | TEST(test_cast_nonstrict_list_to_chars) 49 | TEST(test_cast_nonstrict_tuple_to_chars) 50 | TEST(test_cast_nonstrict_int_to_chars) 51 | TEST(test_cast_nonstrict_bytes_to_chars) 52 | TEST(test_cast_nonstrict_none_to_str) 53 | TEST(test_cast_bytes_to_chars) 54 | TEST(test_cast_chars_to_object) 55 | 56 | TEST(test_cast_to_str) 57 | TEST(test_cast_to_bytes) 58 | TEST(test_cast_to_unicode) 59 | call tearDownClass 60 | 61 | end program 62 | -------------------------------------------------------------------------------- /tests/test_cast.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | # -*- coding: UTF-8 -*- 3 | 4 | # Copyright (C) 2017-2018 Elias Rabel 5 | # 6 | # This program is free software: you can redistribute it and/or modify 7 | # it under the terms of the GNU Lesser General Public License as published by 8 | # the Free Software Foundation, either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU Lesser General Public License for more details. 15 | # 16 | # You should have received a copy of the GNU Lesser General Public License 17 | # along with this program. If not, see . 18 | 19 | class ConvertibleNumber: 20 | """Type that can be converted to different (numeric) types""" 21 | def __complex__(self): 22 | return -12.3+4.56j 23 | def __float__(self): 24 | return -12.3 25 | def __int__(self): 26 | return -12 27 | -------------------------------------------------------------------------------- /tests/test_cast_mod.F90: -------------------------------------------------------------------------------- 1 | ! Copyright (C) 2017-2018 Elias Rabel 2 | ! 3 | ! This program is free software: you can redistribute it and/or modify 4 | ! it under the terms of the GNU Lesser General Public License as published by 5 | ! the Free Software Foundation, either version 3 of the License, or 6 | ! (at your option) any later version. 7 | ! 8 | ! This program is distributed in the hope that it will be useful, 9 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ! GNU Lesser General Public License for more details. 12 | ! 13 | ! You should have received a copy of the GNU Lesser General Public License 14 | ! along with this program. If not, see . 15 | 16 | module test_cast_mod 17 | use unittest_mod 18 | use forpy_mod 19 | use forpy_tests_common_mod, only: setUp_forpy_test, tearDown_forpy_test, gettotalrefcount 20 | use iso_fortran_env 21 | use iso_c_binding 22 | implicit none 23 | 24 | type(module_py), save :: test_mod 25 | 26 | CONTAINS 27 | 28 | #include "unittest_mod.inc" 29 | 30 | subroutine test_cast_tuple_to_list 31 | integer ierror 32 | type(tuple) :: tu 33 | type(list) :: li 34 | logical :: exc_correct 35 | ierror = tuple_create(tu, 0) 36 | ASSERT(ierror==0) 37 | ierror = cast(li, tu) 38 | ASSERT(ierror==EXCEPTION_ERROR) 39 | exc_correct = exception_matches(TypeError) 40 | ASSERT(exc_correct) 41 | call err_clear 42 | call tu%destroy 43 | call li%destroy 44 | end subroutine 45 | 46 | subroutine test_cast_float_to_int 47 | integer ierror 48 | type(object) :: fl 49 | integer :: num 50 | logical :: exc_correct 51 | ierror = cast(fl, 3.14) 52 | ASSERT(ierror==0) 53 | ierror = cast(num, fl) 54 | ASSERT(ierror==EXCEPTION_ERROR) 55 | exc_correct = exception_matches(TypeError) 56 | ASSERT(exc_correct) 57 | call err_clear 58 | call fl%destroy 59 | end subroutine 60 | 61 | subroutine test_cast_float_to_logical 62 | integer ierror 63 | type(object) :: fl 64 | logical :: flag 65 | logical :: exc_correct 66 | ierror = cast(fl, 3.14) 67 | ASSERT(ierror==0) 68 | ierror = cast(flag, fl) 69 | ASSERT(ierror==EXCEPTION_ERROR) 70 | exc_correct = exception_matches(TypeError) 71 | ASSERT(exc_correct) 72 | call err_clear 73 | call fl%destroy 74 | end subroutine 75 | 76 | subroutine test_cast_int_to_float 77 | integer ierror 78 | type(object) :: ii 79 | real :: num 80 | logical :: exc_correct 81 | ierror = cast(ii, 101) 82 | ASSERT(ierror==0) 83 | ierror = cast(num, ii) 84 | ASSERT(ierror==EXCEPTION_ERROR) 85 | exc_correct = exception_matches(TypeError) 86 | ASSERT(exc_correct) 87 | call err_clear 88 | call ii%destroy 89 | end subroutine 90 | 91 | subroutine test_cast_bool_to_int 92 | integer ierror 93 | type(object) :: ii 94 | integer :: num 95 | ierror = cast(ii, .true.) 96 | ASSERT(ierror==0) 97 | ierror = cast(num, ii) 98 | ! This works, because in Python bool is a subtype of int 99 | ASSERT(ierror==0) 100 | call ii%destroy 101 | end subroutine 102 | 103 | subroutine test_cast_int_to_logical 104 | integer ierror 105 | type(object) :: ii 106 | logical :: flag 107 | logical :: exc_correct 108 | ierror = cast(ii, 101) 109 | ASSERT(ierror==0) 110 | ierror = cast(flag, ii) 111 | ASSERT(ierror==EXCEPTION_ERROR) 112 | exc_correct = exception_matches(TypeError) 113 | ASSERT(exc_correct) 114 | call err_clear 115 | call ii%destroy 116 | end subroutine 117 | 118 | subroutine test_cast_nonstrict_real 119 | integer ierror 120 | type(object) :: a_float 121 | integer :: f_int 122 | complex(kind=real64) :: f_complex 123 | logical :: f_logical 124 | real(kind=real64), parameter :: test_real = 3.14159_real64 125 | ierror = cast(a_float, test_real) 126 | ASSERT(ierror==0) 127 | ierror = cast_nonstrict(f_int, a_float) 128 | ASSERT(ierror==0) 129 | ASSERT(f_int==3) 130 | ierror = cast_nonstrict(f_complex, a_float) 131 | ASSERT(ierror==0) 132 | ASSERT(f_complex==test_real) 133 | ierror = cast_nonstrict(f_logical, a_float) 134 | ASSERT(ierror==0) 135 | ASSERT(f_logical) 136 | call a_float%destroy 137 | end subroutine 138 | 139 | subroutine test_cast_nonstrict_complex 140 | integer ierror 141 | type(object) :: a_number 142 | integer(kind=int64) :: f_int 143 | real(kind=real64) :: f_real 144 | logical :: f_logical 145 | complex(kind=real64), parameter :: test_complex = (3.14159_real64, -6.28_real64) 146 | ierror = cast(a_number, test_complex) 147 | ASSERT(ierror==0) 148 | ierror = cast_nonstrict(f_int, a_number) 149 | ASSERT(ierror==EXCEPTION_ERROR) 150 | call err_clear 151 | ierror = cast_nonstrict(f_real, a_number) 152 | ASSERT(ierror==EXCEPTION_ERROR) 153 | call err_clear 154 | ierror = cast_nonstrict(f_logical, a_number) 155 | ASSERT(ierror==0) 156 | ASSERT(f_logical) 157 | call a_number%destroy 158 | end subroutine 159 | 160 | subroutine test_cast_nonstrict_int 161 | integer ierror 162 | type(object) :: a_number 163 | complex(kind=real32) :: f_complex 164 | real(kind=real64) :: f_real 165 | logical :: f_logical 166 | integer(kind=int64), parameter :: test_int = 1234 167 | real(kind=real64) :: test_real 168 | complex(kind=real32) :: test_complex 169 | test_real = real(test_int, kind=real64) 170 | test_complex = cmplx(test_int, kind=real32) 171 | ierror = cast(a_number, test_int) 172 | ASSERT(ierror==0) 173 | ierror = cast_nonstrict(f_complex, a_number) 174 | ASSERT(ierror==0) 175 | ASSERT(f_complex==test_complex) 176 | ierror = cast_nonstrict(f_real, a_number) 177 | ASSERT(ierror==0) 178 | ASSERT(f_real==test_real) 179 | ierror = cast_nonstrict(f_logical, a_number) 180 | ASSERT(ierror==0) 181 | ASSERT(f_logical) 182 | call a_number%destroy 183 | end subroutine 184 | 185 | subroutine test_cast_nonstrict_list 186 | integer ierror 187 | type(list) :: a_list 188 | integer :: f_int 189 | complex(kind=real64) :: f_complex 190 | real(kind=real64) :: f_real 191 | logical :: f_logical 192 | ierror = list_create(a_list) 193 | ASSERT(ierror==0) 194 | ierror = cast_nonstrict(f_int, a_list) 195 | ASSERT(ierror==EXCEPTION_ERROR) 196 | call err_clear 197 | ierror = cast_nonstrict(f_complex, a_list) 198 | ASSERT(ierror==EXCEPTION_ERROR) 199 | call err_clear 200 | ierror = cast_nonstrict(f_real, a_list) 201 | ASSERT(ierror==EXCEPTION_ERROR) 202 | call err_clear 203 | ierror = cast_nonstrict(f_logical, a_list) 204 | ASSERT(ierror==0) 205 | ! [] has truth value 'False' 206 | ASSERT(.not. f_logical) 207 | call a_list%destroy 208 | end subroutine 209 | 210 | subroutine test_cast_nonstrict_numeric() 211 | ! Testing objects that can be converted to numbers 212 | ! because they have magic methods, such as __complex__ 213 | integer :: ierror 214 | type(object) :: obj 215 | complex(kind=C_DOUBLE), parameter :: SOLUTION_COMPLEX = (-12.3_C_DOUBLE, 4.56_C_DOUBLE) 216 | complex(kind=C_DOUBLE) :: a_complex 217 | real(kind=C_DOUBLE) :: a_real 218 | integer(kind=int64) :: a_int 219 | 220 | a_complex = 0.0 221 | ierror = call_py(obj, test_mod, "ConvertibleNumber") 222 | ASSERT(ierror==0) 223 | 224 | ierror = cast_nonstrict(a_complex, obj) 225 | ASSERT(ierror==0) 226 | ASSERT(a_complex==SOLUTION_COMPLEX) 227 | 228 | ierror = cast_nonstrict(a_real, obj) 229 | ASSERT(ierror==0) 230 | ASSERT(a_real==-12.3_C_DOUBLE) 231 | 232 | ierror = cast_nonstrict(a_int, obj) 233 | ASSERT(ierror==0) 234 | ASSERT(a_int==-12_int64) 235 | 236 | call obj%destroy 237 | end subroutine 238 | 239 | subroutine test_cast_nonstrict_list_to_list 240 | integer ierror 241 | type(list) :: some_list 242 | type(list) :: li 243 | ierror = list_create(some_list) 244 | ASSERT(ierror==0) 245 | ierror = cast_nonstrict(li, some_list) 246 | ASSERT(ierror==0) 247 | call some_list%destroy 248 | call li%destroy 249 | end subroutine 250 | 251 | subroutine test_cast_nonstrict_tuple_to_list 252 | integer ierror 253 | type(tuple) :: tu 254 | type(list) :: li 255 | ierror = tuple_create(tu, 0) 256 | ASSERT(ierror==0) 257 | ierror = cast_nonstrict(li, tu) 258 | ASSERT(ierror==0) 259 | ASSERT(is_list(li)) 260 | call tu%destroy 261 | call li%destroy 262 | end subroutine 263 | 264 | subroutine test_cast_nonstrict_int_to_list 265 | integer ierror 266 | type(object) :: an_int 267 | type(list) :: li 268 | logical :: exc_correct 269 | ierror = cast(an_int, 345) 270 | ASSERT(ierror==0) 271 | ierror = cast_nonstrict(li, an_int) 272 | ASSERT(ierror==EXCEPTION_ERROR) 273 | exc_correct = exception_matches(TypeError) 274 | ASSERT(exc_correct) 275 | call err_clear 276 | call an_int%destroy 277 | call li%destroy 278 | end subroutine 279 | 280 | subroutine test_cast_nonstrict_list_to_tuple 281 | integer ierror 282 | type(list) :: some_list 283 | type(tuple) :: tu 284 | ierror = list_create(some_list) 285 | ASSERT(ierror==0) 286 | ierror = cast_nonstrict(tu, some_list) 287 | ASSERT(ierror==0) 288 | ASSERT(is_tuple(tu)) 289 | call some_list%destroy 290 | call tu%destroy 291 | end subroutine 292 | 293 | subroutine test_cast_nonstrict_tuple_to_tuple 294 | integer ierror 295 | type(tuple) :: some_tuple 296 | type(tuple) :: tu 297 | ierror = tuple_create(some_tuple, 0) 298 | ASSERT(ierror==0) 299 | ierror = cast_nonstrict(tu, some_tuple) 300 | ASSERT(ierror==0) 301 | ASSERT(is_tuple(tu)) 302 | call tu%destroy 303 | call some_tuple%destroy 304 | end subroutine 305 | 306 | subroutine test_cast_nonstrict_int_to_tuple 307 | integer ierror 308 | type(object) :: an_int 309 | type(tuple) :: tu 310 | logical :: exc_correct 311 | ierror = cast(an_int, 345) 312 | ASSERT(ierror==0) 313 | ierror = cast_nonstrict(tu, an_int) 314 | ASSERT(ierror==EXCEPTION_ERROR) 315 | exc_correct = exception_matches(TypeError) 316 | ASSERT(exc_correct) 317 | call err_clear 318 | call an_int%destroy 319 | call tu%destroy 320 | end subroutine 321 | 322 | subroutine test_cast_nonstrict_list_to_chars 323 | integer ierror 324 | type(list) :: some_list 325 | character(kind=C_CHAR, len=:), allocatable :: string 326 | ierror = list_create(some_list) 327 | ASSERT(ierror==0) 328 | ierror = cast_nonstrict(string, some_list) 329 | ASSERT(ierror==0) 330 | ASSERT(string=='[]') 331 | call some_list%destroy 332 | end subroutine 333 | 334 | subroutine test_cast_nonstrict_tuple_to_chars 335 | integer ierror 336 | type(tuple) :: some_tuple 337 | character(kind=C_CHAR, len=:), allocatable :: string 338 | ierror = tuple_create(some_tuple, 0) 339 | ASSERT(ierror==0) 340 | ierror = cast_nonstrict(string, some_tuple) 341 | ASSERT(ierror==0) 342 | ASSERT(string=='()') 343 | call some_tuple%destroy 344 | end subroutine 345 | 346 | subroutine test_cast_nonstrict_int_to_chars 347 | integer ierror 348 | type(object) :: an_int 349 | character(kind=C_CHAR, len=:), allocatable :: string 350 | ierror = cast(an_int, 345) 351 | ASSERT(ierror==0) 352 | ierror = cast_nonstrict(string, an_int) 353 | ASSERT(ierror==0) 354 | ASSERT(string=='345') 355 | call an_int%destroy 356 | end subroutine 357 | 358 | subroutine test_cast_nonstrict_bytes_to_chars 359 | integer ierror 360 | type(bytes) :: some_bytes 361 | character(kind=C_CHAR, len=:), allocatable :: string 362 | ierror = bytes_create(some_bytes, "abcdefgh") 363 | ASSERT(ierror==0) 364 | ierror = cast_nonstrict(string, some_bytes) 365 | ASSERT(ierror==0) 366 | ! check that we do not get "b'abcdefgh'" instead 367 | ASSERT(string=='abcdefgh') 368 | call some_bytes%destroy 369 | end subroutine 370 | 371 | subroutine test_cast_nonstrict_none_to_str 372 | integer :: ierror 373 | type(NoneType) :: the_none 374 | type(str) :: a_str 375 | character(kind=C_CHAR,len=:), allocatable :: res 376 | 377 | ierror = NoneType_create(the_none) 378 | ASSERT(ierror==0) 379 | ierror = cast_nonstrict(a_str, the_none) 380 | ASSERT(ierror==0) 381 | ierror = cast(res, a_str) 382 | ASSERT(ierror==0) 383 | ASSERT(res=='None') 384 | call the_none%destroy 385 | call a_str%destroy 386 | end subroutine 387 | 388 | subroutine test_cast_bytes_to_chars 389 | integer ierror 390 | type(bytes) :: some_bytes 391 | character(kind=C_CHAR, len=:), allocatable :: string 392 | ierror = bytes_create(some_bytes, "abcdefgh") 393 | ASSERT(ierror==0) 394 | ierror = cast(string, some_bytes) 395 | ASSERT(ierror==0) 396 | ASSERT(string=='abcdefgh') 397 | call some_bytes%destroy 398 | end subroutine 399 | 400 | subroutine test_cast_chars_to_object 401 | integer ierror 402 | type(object) :: a_string 403 | character(kind=C_CHAR, len=8), parameter :: fstring = "abcdefgh" 404 | character(kind=C_CHAR, len=:), allocatable :: res 405 | 406 | ierror = cast(a_string, fstring) 407 | ASSERT(ierror==0) 408 | ierror = cast(res, a_string) 409 | ASSERT(ierror==0) 410 | ASSERT(res==fstring) 411 | call a_string%destroy 412 | end subroutine 413 | 414 | subroutine test_cast_to_str 415 | integer ierror 416 | type(object) :: a_string 417 | type(str) :: str_specific 418 | character(kind=C_CHAR, len=8), parameter :: fstring = "abcdefgh" 419 | character(kind=C_CHAR, len=:), allocatable :: res 420 | 421 | ierror = cast(a_string, fstring) 422 | ASSERT(ierror==0) 423 | ierror = cast(str_specific, a_string) 424 | ASSERT(ierror==0) 425 | ierror = cast(res, str_specific) 426 | ASSERT(ierror==0) 427 | ASSERT(res==fstring) 428 | call a_string%destroy 429 | call str_specific%destroy 430 | end subroutine 431 | 432 | subroutine test_cast_to_bytes 433 | integer ierror 434 | type(bytes) :: some_bytes 435 | type(object) :: some_object 436 | type(bytes) :: bytes_specific 437 | character(kind=C_CHAR, len=8), parameter :: fstring = "abcdefgh" 438 | character(kind=C_CHAR, len=:), allocatable :: res 439 | 440 | ierror = bytes_create(some_bytes, fstring) 441 | ASSERT(ierror==0) 442 | ierror = cast(some_object, some_bytes) 443 | ASSERT(ierror==0) 444 | ierror = cast(bytes_specific, some_object) 445 | ASSERT(ierror==0) 446 | ierror = cast(res, bytes_specific) 447 | ASSERT(ierror==0) 448 | ASSERT(res==fstring) 449 | call some_bytes%destroy 450 | call some_object%destroy 451 | call bytes_specific%destroy 452 | end subroutine 453 | 454 | subroutine test_cast_to_unicode 455 | integer ierror 456 | type(unicode) :: some_unicode 457 | type(object) :: some_object 458 | type(unicode) :: unicode_specific 459 | character(kind=C_CHAR, len=5) :: fstring 460 | character(kind=C_CHAR, len=:), allocatable :: res 461 | 462 | fstring = "s" // char(195) // char(188) // char(195) // char(159) 463 | 464 | ierror = unicode_create(some_unicode, fstring) 465 | ASSERT(ierror==0) 466 | ierror = cast(some_object, some_unicode) 467 | ASSERT(ierror==0) 468 | ierror = cast(unicode_specific, some_object) 469 | ASSERT(ierror==0) 470 | ierror = cast(res, unicode_specific) 471 | ASSERT(ierror==0) 472 | ASSERT(res==fstring) 473 | call some_unicode%destroy 474 | call some_object%destroy 475 | call unicode_specific%destroy 476 | end subroutine 477 | 478 | subroutine setUp() 479 | call setUp_forpy_test 480 | end subroutine 481 | 482 | subroutine tearDown() 483 | call tearDown_forpy_test 484 | end subroutine 485 | 486 | subroutine setUpClass() 487 | integer ierror 488 | ierror = forpy_initialize() 489 | 490 | if (ierror < 0) then 491 | write (*,*) "Initialisation of forpy failed!!! Tests might fail. Errorcode: ", ierror 492 | endif 493 | 494 | ! add current dir to search path 495 | ierror = run_string(C_CHAR_"import sys" // C_NEW_LINE // C_CHAR_"sys.path.append('.')"//C_NEW_LINE // C_NULL_CHAR) 496 | if (ierror /= 0) then 497 | write(*,*) "Error setting PYTHONPATH. Cannot test...", ierror 498 | call err_print 499 | STOP 500 | endif 501 | 502 | ierror = import_py(test_mod, "test_cast") 503 | if (ierror /= 0) then 504 | write(*,*) "Could not import test module 'test_cast'. Cannot test..." 505 | STOP 506 | endif 507 | end subroutine 508 | 509 | subroutine tearDownClass() 510 | call test_mod%destroy 511 | call forpy_finalize() 512 | 513 | call print_test_count 514 | end subroutine 515 | 516 | end module 517 | -------------------------------------------------------------------------------- /tests/test_datastructures.F90: -------------------------------------------------------------------------------- 1 | ! Copyright (C) 2017-2018 Elias Rabel 2 | ! 3 | ! This program is free software: you can redistribute it and/or modify 4 | ! it under the terms of the GNU Lesser General Public License as published by 5 | ! the Free Software Foundation, either version 3 of the License, or 6 | ! (at your option) any later version. 7 | ! 8 | ! This program is distributed in the hope that it will be useful, 9 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ! GNU Lesser General Public License for more details. 12 | ! 13 | ! You should have received a copy of the GNU Lesser General Public License 14 | ! along with this program. If not, see . 15 | 16 | #ifdef __GFORTRAN__ 17 | #define TEST(X) call setN("X");call preT;call X;call postT 18 | #else 19 | #define TEST(X) call setN(#X);call preT;call X;call postT 20 | #endif 21 | 22 | program test_datastructures 23 | use test_datastructures_mod 24 | implicit none 25 | 26 | call setUpClass 27 | 28 | !example for failing test 29 | !TEST(test1) 30 | TEST(test2) 31 | TEST(test_list_create) 32 | TEST(test_list_append_getitem) 33 | TEST(test_dict_setitem_getitem) 34 | TEST(test_tuple_setitem_getitem) 35 | TEST(test_list_type) 36 | TEST(test_dict_type) 37 | TEST(test_tuple_type) 38 | TEST(test_bytes_type) 39 | TEST(test_str_type) 40 | TEST(test_unicode_type) 41 | TEST(test_list_in_tuple) 42 | TEST(test_tuple_to_list) 43 | TEST(test_str_in_tuple) 44 | TEST(test_list_copy) 45 | TEST(test_dict_copy) 46 | TEST(test_str_create_object) 47 | 48 | call tearDownClass 49 | 50 | end program 51 | -------------------------------------------------------------------------------- /tests/test_datastructures_mod.F90: -------------------------------------------------------------------------------- 1 | ! Copyright (C) 2017-2018 Elias Rabel 2 | ! 3 | ! This program is free software: you can redistribute it and/or modify 4 | ! it under the terms of the GNU Lesser General Public License as published by 5 | ! the Free Software Foundation, either version 3 of the License, or 6 | ! (at your option) any later version. 7 | ! 8 | ! This program is distributed in the hope that it will be useful, 9 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ! GNU Lesser General Public License for more details. 12 | ! 13 | ! You should have received a copy of the GNU Lesser General Public License 14 | ! along with this program. If not, see . 15 | 16 | module test_datastructures_mod 17 | use unittest_mod 18 | use forpy_mod 19 | use iso_c_binding 20 | use forpy_tests_common_mod, only: setUp_forpy_test, tearDown_forpy_test, gettotalrefcount 21 | implicit none 22 | 23 | CONTAINS 24 | 25 | #include "unittest_mod.inc" 26 | 27 | subroutine test1 28 | ASSERT(.false.) 29 | end subroutine 30 | 31 | subroutine test2 32 | ASSERT(.true.) 33 | end subroutine 34 | 35 | subroutine test_list_create 36 | integer ierror 37 | type(list) :: li 38 | ierror = list_create(li) 39 | ASSERT(ierror==0) 40 | call li%destroy 41 | end subroutine 42 | 43 | subroutine test_list_append_getitem 44 | integer ierror, element 45 | type(list) :: li 46 | ierror = list_create(li) 47 | ASSERT(ierror==0) 48 | ierror = li%append(42) 49 | ASSERT(ierror==0) 50 | ierror = li%getitem(element, 0) 51 | ASSERT(ierror==0) 52 | ASSERTEQUAL(element, 42) 53 | call li%destroy 54 | end subroutine 55 | 56 | subroutine test_dict_setitem_getitem 57 | integer ierror, element 58 | type(dict) :: di 59 | ierror = dict_create(di) 60 | ASSERT(ierror==0) 61 | ierror = di%setitem("hello", 42) 62 | ASSERT(ierror==0) 63 | ierror = di%getitem(element, "hello") 64 | ASSERT(ierror==0) 65 | ASSERT(element==42) 66 | call di%destroy 67 | end subroutine 68 | 69 | subroutine test_tuple_setitem_getitem 70 | integer ierror, element 71 | type(tuple) :: tu 72 | ierror = tuple_create(tu, 1) 73 | ASSERT(ierror==0) 74 | ierror = tu%setitem(0, 42) 75 | ASSERT(ierror==0) 76 | ierror = tu%getitem(element, 0) 77 | ASSERT(ierror==0) 78 | ASSERT(element==42) 79 | call tu%destroy 80 | end subroutine 81 | 82 | subroutine test_list_in_tuple 83 | ! construct the tuple ([]) and read its element 84 | integer ierror 85 | type(tuple) :: tu 86 | type(list) :: li, li2 87 | type(object) :: obj 88 | ierror = tuple_create(tu, 1) 89 | ASSERT(ierror==0) 90 | ierror = list_create(li) 91 | ASSERT(ierror==0) 92 | ierror = tu%setitem(0, li) 93 | ASSERT(ierror==0) 94 | ierror = tu%getitem(obj, 0) 95 | ASSERT(ierror==0) 96 | ASSERT(is_list(obj)) 97 | ierror = cast(li2, obj) 98 | ASSERT(ierror==0) 99 | call tu%destroy 100 | call li%destroy 101 | call li2%destroy 102 | call obj%destroy 103 | end subroutine 104 | 105 | subroutine test_list_type 106 | integer ierror 107 | type(list) :: li 108 | ierror = list_create(li) 109 | ASSERT(ierror==0) 110 | ASSERT(is_list(li)) 111 | ASSERT(.not. is_dict(li)) 112 | ASSERT(.not. is_tuple(li)) 113 | ASSERT(.not. is_none(li)) 114 | ASSERT(.not. is_int(li)) 115 | ASSERT(.not. is_bool(li)) 116 | ASSERT(.not. is_float(li)) 117 | ASSERT(.not. is_complex(li)) 118 | ASSERT(.not. is_bytes(li)) 119 | ASSERT(.not. is_str(li)) 120 | ASSERT(.not. is_unicode(li)) 121 | call li%destroy 122 | end subroutine 123 | 124 | subroutine test_dict_type 125 | integer ierror 126 | type(dict) :: di 127 | ierror = dict_create(di) 128 | ASSERT(ierror==0) 129 | ASSERT(.not. is_list(di)) 130 | ASSERT(is_dict(di)) 131 | ASSERT(.not. is_tuple(di)) 132 | ASSERT(.not. is_none(di)) 133 | ASSERT(.not. is_int(di)) 134 | ASSERT(.not. is_bool(di)) 135 | ASSERT(.not. is_float(di)) 136 | ASSERT(.not. is_complex(di)) 137 | ASSERT(.not. is_bytes(di)) 138 | ASSERT(.not. is_str(di)) 139 | ASSERT(.not. is_unicode(di)) 140 | call di%destroy 141 | end subroutine 142 | 143 | subroutine test_tuple_type 144 | integer ierror 145 | type(tuple) :: t 146 | ierror = tuple_create(t, 0) 147 | ASSERT(ierror==0) 148 | ASSERT(.not. is_list(t)) 149 | ASSERT(.not. is_dict(t)) 150 | ASSERT(is_tuple(t)) 151 | ASSERT(.not. is_none(t)) 152 | ASSERT(.not. is_int(t)) 153 | ASSERT(.not. is_bool(t)) 154 | ASSERT(.not. is_float(t)) 155 | ASSERT(.not. is_complex(t)) 156 | ASSERT(.not. is_bytes(t)) 157 | ASSERT(.not. is_str(t)) 158 | ASSERT(.not. is_unicode(t)) 159 | call t%destroy 160 | end subroutine 161 | 162 | subroutine test_bytes_type 163 | integer ierror 164 | type(bytes) :: t 165 | ierror = bytes_create(t, "abc") 166 | ASSERT(ierror==0) 167 | ASSERT(.not. is_list(t)) 168 | ASSERT(.not. is_dict(t)) 169 | ASSERT(.not. is_tuple(t)) 170 | ASSERT(.not. is_none(t)) 171 | ASSERT(.not. is_int(t)) 172 | ASSERT(.not. is_bool(t)) 173 | ASSERT(.not. is_float(t)) 174 | ASSERT(.not. is_complex(t)) 175 | ASSERT(is_bytes(t)) 176 | ASSERT(.not. is_unicode(t)) 177 | call t%destroy 178 | end subroutine 179 | 180 | subroutine test_str_type 181 | integer ierror 182 | type(str) :: t 183 | ierror = str_create(t, "abc") 184 | ASSERT(ierror==0) 185 | ASSERT(.not. is_list(t)) 186 | ASSERT(.not. is_dict(t)) 187 | ASSERT(.not. is_tuple(t)) 188 | ASSERT(.not. is_none(t)) 189 | ASSERT(.not. is_int(t)) 190 | ASSERT(.not. is_bool(t)) 191 | ASSERT(.not. is_float(t)) 192 | ASSERT(.not. is_complex(t)) 193 | ASSERT(is_str(t)) 194 | call t%destroy 195 | end subroutine 196 | 197 | subroutine test_unicode_type 198 | integer ierror 199 | type(unicode) :: t 200 | ierror = unicode_create(t, "abc") 201 | ASSERT(ierror==0) 202 | ASSERT(.not. is_list(t)) 203 | ASSERT(.not. is_dict(t)) 204 | ASSERT(.not. is_tuple(t)) 205 | ASSERT(.not. is_none(t)) 206 | ASSERT(.not. is_int(t)) 207 | ASSERT(.not. is_bool(t)) 208 | ASSERT(.not. is_float(t)) 209 | ASSERT(.not. is_complex(t)) 210 | ASSERT(.not. is_bytes(t)) 211 | ASSERT(is_unicode(t)) 212 | call t%destroy 213 | end subroutine 214 | 215 | subroutine test_tuple_to_list 216 | integer ierror, element 217 | type(tuple) :: t 218 | type(list) :: li 219 | ierror = tuple_create(t, 1) 220 | ierror = t%setitem(0, 42) 221 | ierror = list_create(li, t) 222 | ierror = li%getitem(element, 0) 223 | ASSERT(element == 42) 224 | call t%destroy 225 | call li%destroy 226 | end subroutine 227 | 228 | subroutine test_list_copy 229 | integer ierror, element 230 | type(list) :: li, li_copy 231 | ierror = list_create(li) 232 | ierror = li%append(23) 233 | ierror = li%copy(li_copy) 234 | ierror = li_copy%getitem(element, 0) 235 | ASSERT(element==23) 236 | call li%destroy 237 | call li_copy%destroy 238 | end subroutine 239 | 240 | subroutine test_dict_copy 241 | integer ierror, element 242 | type(dict) :: di, di_copy 243 | ierror = dict_create(di) 244 | ierror = di%setitem("hi", 23) 245 | ierror = di%copy(di_copy) 246 | ierror = di_copy%getitem(element, "hi") 247 | ASSERT(element==23) 248 | call di%destroy 249 | call di_copy%destroy 250 | end subroutine 251 | 252 | subroutine test_str_in_tuple 253 | integer ierror 254 | type(tuple) :: t 255 | character(kind=C_CHAR, len=:), allocatable :: buffer 256 | character(kind=C_CHAR, len=8), parameter :: TESTSTR = "abcdefgh" 257 | ierror = tuple_create(t, 1) 258 | ASSERT(ierror==0) 259 | ierror = t%setitem(0, TESTSTR) 260 | ASSERT(ierror==0) 261 | ierror = t%getitem(buffer, 0) 262 | ASSERT(ierror==0) 263 | ASSERT(buffer==TESTSTR) 264 | call t%destroy 265 | end subroutine 266 | 267 | subroutine test_str_create_object() 268 | integer :: ierror 269 | type(NoneType) :: the_none 270 | type(str) :: a_str 271 | character(kind=C_CHAR,len=:), allocatable :: res 272 | 273 | ierror = NoneType_create(the_none) 274 | ASSERT(ierror==0) 275 | ierror = str_create(a_str, the_none) 276 | ASSERT(ierror==0) 277 | ierror = cast(res, a_str) 278 | ASSERT(ierror==0) 279 | ASSERT(res=='None') 280 | call the_none%destroy 281 | call a_str%destroy 282 | end subroutine 283 | 284 | subroutine setUp() 285 | call setUp_forpy_test 286 | end subroutine 287 | 288 | subroutine tearDown() 289 | call tearDown_forpy_test 290 | end subroutine 291 | 292 | subroutine setUpClass() 293 | integer ierror 294 | ierror = forpy_initialize(use_numpy=.false.) 295 | 296 | if (ierror /= 0) then 297 | write (*,*) "Initialisation of forpy failed!!! Most tests will fail! Errorcode: ", ierror 298 | endif 299 | end subroutine 300 | 301 | subroutine tearDownClass() 302 | call forpy_finalize() 303 | call print_test_count 304 | end subroutine 305 | 306 | end module 307 | -------------------------------------------------------------------------------- /tests/test_ndarray.fypp: -------------------------------------------------------------------------------- 1 | ! Copyright (C) 2017-2018 Elias Rabel 2 | ! 3 | ! This program is free software: you can redistribute it and/or modify 4 | ! it under the terms of the GNU Lesser General Public License as published by 5 | ! the Free Software Foundation, either version 3 of the License, or 6 | ! (at your option) any later version. 7 | ! 8 | ! This program is distributed in the hope that it will be useful, 9 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ! GNU Lesser General Public License for more details. 12 | ! 13 | ! You should have received a copy of the GNU Lesser General Public License 14 | ! along with this program. If not, see . 15 | 16 | #ifdef __GFORTRAN__ 17 | #define TEST(X) call setN("X");call preT;call X;call postT 18 | #else 19 | #define TEST(X) call setN(#X);call preT;call X;call postT 20 | #endif 21 | 22 | program test_ndarray 23 | use test_ndarray_mod 24 | implicit none 25 | 26 | call setUpClass 27 | TEST(test_ndarray_expected) 28 | TEST(test_ndarray_get_data_01) 29 | TEST(test_check_ndarray_1d) 30 | TEST(test_check_ndarray_2d) 31 | TEST(test_compare_ndarray_2d_with_get_data) 32 | TEST(test_compare_ndarray_2d_with_get_data_nocopy) 33 | TEST(test_check_ndarray_3d) 34 | TEST(test_get_ndarray_2d) 35 | TEST(test_get_ndarray_wrong_order) 36 | TEST(test_get_ndarray_bad_dim) 37 | TEST(test_get_ndarray_bad_type) 38 | TEST(test_get_ndarray_discont) 39 | TEST(test_get_ndarray_c_order) 40 | TEST(test_bad_order_param) 41 | TEST(test_order_1d_array) 42 | TEST(test_check_transpose2d) 43 | TEST(test_copy) 44 | TEST(test_copy_order) 45 | TEST(test_is_ordered_fortran) 46 | TEST(test_is_ordered_c) 47 | TEST(test_is_ordered_discont) 48 | TEST(test_is_ordered_1d) 49 | TEST(test_get_dtype_name) 50 | TEST(test_ndim) 51 | TEST(test_ndarray_create_empty01) 52 | TEST(test_ndarray_create_empty02) 53 | TEST(test_ndarray_create_empty03) 54 | TEST(test_ndarray_create_zeros01) 55 | TEST(test_ndarray_create_zeros02) 56 | TEST(test_ndarray_create_zeros03) 57 | TEST(test_ndarray_create_ones01) 58 | TEST(test_ndarray_create_ones02) 59 | TEST(test_ndarray_create_ones03) 60 | TEST(test_dtype_int32) 61 | TEST(test_dtype_int64) 62 | TEST(test_dtype_float32) 63 | TEST(test_dtype_float64) 64 | TEST(test_dtype_complex64) 65 | TEST(test_dtype_complex128) 66 | TEST(test_compiler_opt_issue) 67 | TEST(test_ndarray_create_noncontiguous) 68 | TEST(test_ndarray_create_nocopy_noncontig_fail) 69 | 70 | #:for NDIM in range(1, 5) 71 | #:for DTYPE in ("int32", "int64", "float32", "float64", "complex64", "complex128") 72 | TEST(test_ndarray_create_${DTYPE}$_${NDIM}$d) 73 | TEST(test_ndarray_create_nocopy_${DTYPE}$_${NDIM}$d) 74 | TEST(test_get_data_${DTYPE}$_${NDIM}$d) 75 | #:endfor 76 | #:endfor 77 | 78 | call tearDownClass 79 | 80 | end program 81 | -------------------------------------------------------------------------------- /tests/test_ndarray.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | # -*- coding: UTF-8 -*- 3 | 4 | # Copyright (C) 2017-2018 Elias Rabel 5 | # 6 | # This program is free software: you can redistribute it and/or modify 7 | # it under the terms of the GNU Lesser General Public License as published by 8 | # the Free Software Foundation, either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU Lesser General Public License for more details. 15 | # 16 | # You should have received a copy of the GNU Lesser General Public License 17 | # along with this program. If not, see . 18 | 19 | from __future__ import print_function 20 | 21 | import numpy as np 22 | 23 | def ndarray_expected(arr): 24 | if not isinstance(arr, np.ndarray): 25 | raise TypeError 26 | 27 | def check_ndarray_1d(arr): 28 | solution = np.arange(1,25,dtype='int') 29 | if not np.all(arr == solution): 30 | raise ValueError 31 | 32 | def check_ndarray_2d(arr): 33 | solution = np.arange(1,25,dtype='float64').reshape(4,6) 34 | if not np.all(arr == solution): 35 | print("Got: ") 36 | print(arr) 37 | print("Solution: ") 38 | print(solution) 39 | raise ValueError 40 | 41 | def check_ndarray_3d(arr): 42 | solution = np.arange(1,25,dtype='float32').reshape(2,3,4) 43 | if not np.all(arr == solution): 44 | print("Got: ") 45 | print(arr) 46 | print("Solution: ") 47 | print(solution) 48 | raise ValueError 49 | 50 | def get_ndarray_2d(): 51 | arr = np.arange(1,25,dtype='float64').reshape((4,6), order='F') 52 | return arr 53 | 54 | def get_ndarray_2d_c_order(): 55 | arr = np.arange(1,25,dtype='float64').reshape((4,6), order='C') 56 | #print(arr) 57 | return arr 58 | 59 | def get_ndarray_2d_not_contiguous(): 60 | arr = np.arange(1,25,dtype='float64').reshape((4,6), order='F') 61 | arr = arr[0::2,0::2] 62 | #print(arr) 63 | return arr 64 | 65 | def check_transpose_2d(array_to_check): 66 | solution = get_ndarray_2d().transpose() 67 | if not np.all(array_to_check == solution): 68 | raise ValueError 69 | 70 | def c_order_expected(x): 71 | if not x.flags.c_contiguous: 72 | raise TypeError 73 | 74 | def get_test_array(dimension, dtype_string): 75 | shape_4d = (7, 5, 3, 2) 76 | shape = shape_4d[0:dimension] 77 | tmp = np.array(range(1, np.prod(shape)+1), "int64") 78 | #tmp[::2] *= -1 79 | test_array = np.array(tmp, dtype_string) 80 | test_array = test_array.reshape(shape, order='F') 81 | 82 | if dtype_string in ("complex64", "complex128"): 83 | #without imaginary part it would be boring 84 | test_array += -3j * test_array 85 | 86 | return test_array 87 | 88 | def check_test_array(array_to_check, dimension, dtype_string): 89 | if np.dtype(dtype_string) != array_to_check.dtype: 90 | raise TypeError("dtypes do not match") 91 | 92 | test_array = get_test_array(dimension, dtype_string) 93 | 94 | if test_array.shape != array_to_check.shape: 95 | raise TypeError("shapes do not match") 96 | 97 | if not np.array_equal(array_to_check, test_array): 98 | #print(array_to_check) 99 | #print(test_array) 100 | raise ValueError("values do not match") 101 | 102 | -------------------------------------------------------------------------------- /tests/test_ndarray_mod.fypp: -------------------------------------------------------------------------------- 1 | ! Copyright (C) 2017-2018 Elias Rabel 2 | ! 3 | ! This program is free software: you can redistribute it and/or modify 4 | ! it under the terms of the GNU Lesser General Public License as published by 5 | ! the Free Software Foundation, either version 3 of the License, or 6 | ! (at your option) any later version. 7 | ! 8 | ! This program is distributed in the hope that it will be useful, 9 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ! GNU Lesser General Public License for more details. 12 | ! 13 | ! You should have received a copy of the GNU Lesser General Public License 14 | ! along with this program. If not, see . 15 | 16 | module test_ndarray_mod 17 | use unittest_mod 18 | use forpy_mod 19 | use forpy_tests_common_mod, only: setUp_forpy_test, tearDown_forpy_test, gettotalrefcount 20 | use iso_fortran_env 21 | use iso_c_binding 22 | implicit none 23 | 24 | type(module_py), save :: test_mod 25 | 26 | CONTAINS 27 | 28 | #include "unittest_mod.inc" 29 | 30 | subroutine test_ndarray_expected() 31 | integer ierror 32 | type(tuple) :: args 33 | type(ndarray) :: nd_arr 34 | integer arr(1) 35 | arr(1) = 42 36 | ierror = ndarray_create(nd_arr, arr) 37 | ASSERT(ierror==0) 38 | ierror = tuple_create(args, 1) 39 | ierror = args%setitem(0, nd_arr) 40 | ierror = call_py_noret(test_mod, "ndarray_expected", args) 41 | ASSERT(ierror==0) 42 | ASSERT(.not. have_exception()) 43 | call args%destroy 44 | call nd_arr%destroy 45 | end subroutine 46 | 47 | subroutine test_ndarray_get_data_01() 48 | integer ierror 49 | type(ndarray) :: nd_arr 50 | integer :: arr(1) 51 | integer, dimension(:), pointer :: arr_ptr 52 | arr(1) = 42 53 | ierror = ndarray_create(nd_arr, arr) 54 | ASSERT(ierror==0) 55 | ierror = nd_arr%get_data(arr_ptr) 56 | ASSERT(ierror==0) 57 | ASSERT(size(arr_ptr)==1) 58 | ASSERT(arr_ptr(1)==arr(1)) 59 | call nd_arr%destroy 60 | end subroutine 61 | 62 | subroutine test_check_ndarray_1d() 63 | integer ierror 64 | type(tuple) :: args 65 | type(ndarray) :: nd_arr 66 | integer arr(24) 67 | integer ii 68 | 69 | do ii = 1,24 70 | arr(ii) = ii 71 | enddo 72 | 73 | ierror = ndarray_create(nd_arr, arr) 74 | ASSERT(ierror==0) 75 | ierror = tuple_create(args, 1) 76 | ASSERT(ierror==0) 77 | ierror = args%setitem(0, nd_arr) 78 | ASSERT(ierror==0) 79 | ierror = call_py_noret(test_mod, "check_ndarray_1d", args) 80 | ASSERT(ierror==0) 81 | ASSERT(.not. have_exception()) 82 | call args%destroy 83 | call nd_arr%destroy 84 | end subroutine 85 | 86 | subroutine test_check_ndarray_2d() 87 | integer ierror 88 | type(tuple) :: args 89 | type(ndarray) :: nd_arr 90 | real(kind=real64) :: arr(4,6) 91 | integer ii, jj 92 | 93 | do ii = 1,4 94 | do jj = 1,6 95 | arr(ii, jj) = real((ii-1)*6 + jj, kind=real64) 96 | enddo 97 | enddo 98 | 99 | ierror = ndarray_create(nd_arr, arr) 100 | ASSERT(ierror==0) 101 | ierror = tuple_create(args, 1) 102 | ASSERT(ierror==0) 103 | ierror = args%setitem(0, nd_arr) 104 | ASSERT(ierror==0) 105 | ierror = call_py_noret(test_mod, "check_ndarray_2d", args) 106 | ASSERT(ierror==0) 107 | ASSERT(.not. have_exception()) 108 | call args%destroy 109 | call nd_arr%destroy 110 | end subroutine 111 | 112 | subroutine test_compare_ndarray_2d_with_get_data() 113 | integer :: ierror 114 | type(ndarray) :: nd_arr 115 | integer(kind=int64) :: arr(4,6) 116 | integer(kind=int64), pointer :: arr2(:,:) 117 | integer ii, jj 118 | 119 | do ii = 1,4 120 | do jj = 1,6 121 | arr(ii, jj) = int((ii-1)*6 + jj, kind=int64) 122 | enddo 123 | enddo 124 | 125 | ierror = ndarray_create(nd_arr, arr) 126 | ASSERT(ierror==0) 127 | 128 | ierror = nd_arr%get_data(arr2) 129 | ASSERT(ierror==0) 130 | ASSERT(all(arr==arr2)) 131 | ! ndarray_create creates copy of Fortran array (initially forpy 132 | ! would not copy data, this was changed) 133 | ! change in arr does not affect arr2 134 | arr(1,1)=98765 135 | ASSERT(arr2(1,1)==1) 136 | 137 | call nd_arr%destroy 138 | end subroutine 139 | 140 | subroutine test_compare_ndarray_2d_with_get_data_nocopy() 141 | integer :: ierror 142 | type(ndarray) :: nd_arr 143 | integer(kind=int64), asynchronous :: arr(4,6) 144 | integer(kind=int64), pointer :: arr2(:,:) 145 | integer ii, jj 146 | 147 | do ii = 1,4 148 | do jj = 1,6 149 | arr(ii, jj) = int((ii-1)*6 + jj, kind=int64) 150 | enddo 151 | enddo 152 | 153 | ierror = ndarray_create_nocopy(nd_arr, arr) 154 | ASSERT(ierror==0) 155 | 156 | ierror = nd_arr%get_data(arr2) 157 | ASSERT(ierror==0) 158 | ASSERT(all(arr==arr2)) 159 | ! ndarray_create_nocopy uses arr as buffer 160 | ! change in arr affects arr2 161 | arr(1,1)=98765 162 | ASSERT(arr2(1,1)==98765) 163 | 164 | call nd_arr%destroy 165 | end subroutine 166 | 167 | subroutine test_check_ndarray_3d() 168 | integer ierror 169 | type(tuple) :: args 170 | type(ndarray) :: nd_arr 171 | real(kind=real32) :: arr(2,3,4) 172 | integer ii, jj,kk 173 | 174 | do ii = 1,2 175 | do jj = 1,3 176 | do kk = 1,4 177 | arr(ii, jj, kk) = real((ii-1)*12 + (jj-1)*4 + kk, kind=real32) 178 | enddo 179 | enddo 180 | enddo 181 | 182 | ierror = tuple_create(args, 1) 183 | ASSERT(ierror==0) 184 | ierror = ndarray_create(nd_arr, arr) 185 | ASSERT(ierror==0) 186 | ierror = args%setitem(0, nd_arr) 187 | ASSERT(ierror==0) 188 | ierror = call_py_noret(test_mod, "check_ndarray_3d", args) 189 | ASSERT(ierror==0) 190 | ASSERT(.not. have_exception()) 191 | call args%destroy 192 | call nd_arr%destroy 193 | end subroutine 194 | 195 | subroutine test_get_ndarray_2d() 196 | integer ierror 197 | type(object) :: retval 198 | type(ndarray) :: nd_arr 199 | real(kind=real64) :: solution 200 | real(kind=real64), dimension(:,:), pointer :: arr 201 | integer ii, jj 202 | 203 | ierror = call_py(retval, test_mod, "get_ndarray_2d") 204 | ASSERT(ierror==0) 205 | ASSERT(.not. have_exception()) 206 | 207 | ierror = cast(nd_arr, retval) 208 | call retval%destroy 209 | ASSERT(ierror==0) 210 | 211 | ierror = nd_arr%get_data(arr) 212 | ASSERT(ierror==0) 213 | 214 | ASSERT(size(arr,1)==4) 215 | ASSERT(size(arr,2)==6) 216 | 217 | do jj = 1,6 218 | do ii = 1,4 219 | solution = real((jj-1)*4 + ii, kind=real64) 220 | ASSERT(arr(ii,jj)==solution) 221 | enddo 222 | enddo 223 | 224 | call nd_arr%destroy 225 | 226 | end subroutine 227 | 228 | subroutine test_get_ndarray_wrong_order() 229 | !expecting Fortran order, but getting a C-ordered array 230 | integer ierror 231 | type(object) :: retval 232 | type(ndarray) :: nd_arr 233 | real(kind=real64), dimension(:,:), pointer :: arr 234 | logical exc_correct 235 | 236 | ierror = call_py(retval, test_mod, "get_ndarray_2d_c_order") 237 | ASSERT(ierror==0) 238 | ASSERT(.not. have_exception()) 239 | 240 | ierror = cast(nd_arr, retval) 241 | call retval%destroy 242 | ASSERT(ierror==0) 243 | 244 | ierror = nd_arr%get_data(arr) 245 | ASSERT(ierror==EXCEPTION_ERROR) 246 | exc_correct=exception_matches(BufferError) 247 | ASSERT(exc_correct) 248 | call err_clear 249 | 250 | call nd_arr%destroy 251 | 252 | end subroutine 253 | 254 | subroutine test_get_ndarray_bad_dim() 255 | !expecting 1d-array, but getting 2d-array 256 | integer ierror 257 | type(object) :: retval 258 | type(ndarray) :: nd_arr 259 | real(kind=real64), dimension(:), pointer :: arr 260 | 261 | ierror = call_py(retval, test_mod, "get_ndarray_2d") 262 | ASSERT(ierror==0) 263 | ASSERT(.not. have_exception()) 264 | 265 | ierror = cast(nd_arr, retval) 266 | call retval%destroy 267 | ASSERT(ierror==0) 268 | 269 | ierror = nd_arr%get_data(arr) 270 | ASSERT(ierror==EXCEPTION_ERROR) 271 | ASSERT(exception_matches(TypeError)) 272 | call err_clear 273 | 274 | call nd_arr%destroy 275 | 276 | end subroutine 277 | 278 | subroutine test_get_ndarray_bad_type() 279 | !expecting int32-array, getting real64 280 | integer ierror 281 | type(object) :: retval 282 | type(ndarray) :: nd_arr 283 | integer(kind=int32), dimension(:,:), pointer :: arr 284 | 285 | ierror = call_py(retval, test_mod, "get_ndarray_2d") 286 | ASSERT(ierror==0) 287 | ASSERT(.not. have_exception()) 288 | 289 | ierror = cast(nd_arr, retval) 290 | call retval%destroy 291 | ASSERT(ierror==0) 292 | 293 | ierror = nd_arr%get_data(arr) 294 | ASSERT(ierror==EXCEPTION_ERROR) 295 | ASSERT(exception_matches(TypeError)) 296 | call err_clear 297 | 298 | call nd_arr%destroy 299 | 300 | end subroutine 301 | 302 | subroutine test_get_ndarray_discont() 303 | !expecting Fortran order, but getting a discontiguous-array 304 | integer ierror 305 | type(object) :: retval 306 | type(ndarray) :: nd_arr 307 | real(kind=real64), dimension(:,:), pointer :: arr 308 | logical exc_correct 309 | 310 | ierror = call_py(retval, test_mod, "get_ndarray_2d_not_contiguous") 311 | ASSERT(ierror==0) 312 | ASSERT(.not. have_exception()) 313 | 314 | ierror = cast(nd_arr, retval) 315 | call retval%destroy 316 | ASSERT(ierror==0) 317 | 318 | ierror = nd_arr%get_data(arr) 319 | ASSERT(ierror==EXCEPTION_ERROR) 320 | exc_correct = exception_matches(BufferError) 321 | ASSERT(exc_correct) 322 | call err_clear 323 | 324 | call nd_arr%destroy 325 | 326 | end subroutine 327 | 328 | subroutine test_get_ndarray_c_order() 329 | !get C-ordered array 330 | integer ierror 331 | type(object) :: retval 332 | type(ndarray) :: nd_arr 333 | real(kind=real64), dimension(:,:), pointer :: arr 334 | real(kind=real64) solution 335 | integer ii, jj 336 | 337 | ierror = call_py(retval, test_mod, "get_ndarray_2d_c_order") 338 | ASSERT(ierror==0) 339 | ASSERT(.not. have_exception()) 340 | 341 | ierror = cast(nd_arr, retval) 342 | call retval%destroy 343 | ASSERT(ierror==0) 344 | 345 | ierror = nd_arr%get_data(arr, 'A') 346 | ASSERT(ierror==0) 347 | ASSERT(.not. have_exception()) 348 | 349 | do ii = 1,6 350 | do jj = 1,4 351 | solution = real((jj-1)*6 + ii, kind=real64) 352 | ASSERT(arr(ii,jj)==solution) 353 | enddo 354 | enddo 355 | 356 | call nd_arr%destroy 357 | 358 | end subroutine 359 | 360 | subroutine test_bad_order_param() 361 | !passing a bad order parameter 362 | integer ierror 363 | type(ndarray) :: nd_arr 364 | integer, dimension(:), pointer :: arr 365 | integer :: testarr(2) = [1, 2] 366 | logical :: exc_correct 367 | 368 | ierror = ndarray_create(nd_arr, testarr) 369 | ASSERT(ierror==0) 370 | ierror = nd_arr%get_data(arr, order='Q') !'Q' is not a valid value for order 371 | ASSERT(ierror==EXCEPTION_ERROR) 372 | exc_correct = exception_matches(ValueError) 373 | ASSERT(exc_correct) 374 | call err_clear 375 | 376 | call nd_arr%destroy 377 | end subroutine 378 | 379 | subroutine test_order_1d_array() 380 | !for 1D array, the distinction between Fortran- and C-order does not matter 381 | integer ierror 382 | type(ndarray) :: nd_arr 383 | integer, dimension(:), pointer :: arr 384 | integer :: testarr(2) = [1, 2] 385 | 386 | ierror = ndarray_create(nd_arr, testarr) 387 | ASSERT(ierror==0) 388 | ! all order parameters must work 389 | ierror = nd_arr%get_data(arr, order='F') 390 | ASSERT(ierror==0) 391 | ierror = nd_arr%get_data(arr, order='C') 392 | ASSERT(ierror==0) 393 | ierror = nd_arr%get_data(arr, order='A') 394 | ASSERT(ierror==0) 395 | 396 | call nd_arr%destroy 397 | end subroutine 398 | 399 | subroutine test_check_transpose2d() 400 | integer ierror 401 | type(object) :: retval 402 | type(ndarray) :: nd_arr, nd_arr_trans 403 | type(tuple) :: args 404 | 405 | ierror = call_py(retval, test_mod, "get_ndarray_2d") 406 | ASSERT(ierror==0) 407 | ASSERT(.not. have_exception()) 408 | 409 | ierror = cast(nd_arr, retval) 410 | call retval%destroy 411 | ASSERT(ierror==0) 412 | 413 | ierror = nd_arr%transpose(nd_arr_trans) 414 | ASSERT(ierror==0) 415 | 416 | ierror = tuple_create(args, 1) 417 | ASSERT(ierror==0) 418 | ierror = args%setitem(0, nd_arr_trans) 419 | ASSERT(ierror==0) 420 | ierror = call_py_noret(test_mod, "check_transpose_2d", args) 421 | ASSERT(ierror==0) 422 | ASSERT(.not. have_exception()) 423 | 424 | call args%destroy 425 | call nd_arr%destroy 426 | call nd_arr_trans%destroy 427 | end subroutine 428 | 429 | subroutine test_copy() 430 | integer ierror 431 | type(ndarray) :: nd_arr, nd_arr_copy 432 | integer, dimension(:), pointer :: arr, arr_copy 433 | integer :: testarr(2) 434 | 435 | testarr = [314, 297] 436 | 437 | ierror = ndarray_create(nd_arr, testarr) 438 | ASSERT(ierror==0) 439 | ierror = nd_arr%copy(nd_arr_copy) 440 | ASSERT(ierror==0) 441 | ierror = nd_arr%get_data(arr) 442 | ASSERT(ierror==0) 443 | ierror = nd_arr_copy%get_data(arr_copy) 444 | ASSERT(ierror==0) 445 | 446 | ASSERT(all(arr==arr_copy)) 447 | arr(1) = 12345 448 | ASSERT(.not. all(arr==arr_copy)) 449 | 450 | call nd_arr%destroy 451 | call nd_arr_copy%destroy 452 | end subroutine 453 | 454 | subroutine test_copy_order() 455 | !creating C-ordered array from Fortran-ordered array by copying 456 | integer ierror 457 | type(object) :: retval 458 | type(ndarray) :: nd_arr, nd_arr_copy 459 | type(tuple) :: args 460 | 461 | ierror = call_py(retval, test_mod, "get_ndarray_2d") !returned array has Fortran-order 462 | ASSERT(ierror==0) 463 | 464 | ierror = cast(nd_arr, retval) 465 | call retval%destroy 466 | ASSERT(ierror==0) 467 | 468 | ierror = nd_arr%copy(nd_arr_copy, 'C') 469 | ASSERT(ierror==0) 470 | 471 | ierror = tuple_create(args, 1) 472 | ASSERT(ierror==0) 473 | ierror = args%setitem(0, nd_arr_copy) 474 | ASSERT(ierror==0) 475 | ierror = call_py_noret(test_mod, "c_order_expected", args) 476 | ASSERT(ierror==0) 477 | ASSERT(.not. have_exception()) 478 | 479 | call args%destroy 480 | call nd_arr%destroy 481 | call nd_arr_copy%destroy 482 | end subroutine 483 | 484 | subroutine test_is_ordered_fortran() 485 | integer ierror 486 | type(object) :: retval 487 | type(ndarray) :: nd_arr 488 | 489 | ierror = call_py(retval, test_mod, "get_ndarray_2d") !returned array has Fortran-order 490 | ASSERT(ierror==0) 491 | 492 | ierror = cast(nd_arr, retval) 493 | call retval%destroy 494 | ASSERT(ierror==0) 495 | 496 | ASSERT(nd_arr%is_ordered('F')) 497 | ASSERT(.not. nd_arr%is_ordered('C')) 498 | ASSERT(nd_arr%is_ordered('A')) 499 | 500 | call nd_arr%destroy 501 | end subroutine 502 | 503 | subroutine test_is_ordered_c() 504 | integer ierror 505 | type(object) :: retval 506 | type(ndarray) :: nd_arr 507 | 508 | ierror = call_py(retval, test_mod, "get_ndarray_2d_c_order") !returned array has C-order 509 | ASSERT(ierror==0) 510 | 511 | ierror = cast(nd_arr, retval) 512 | call retval%destroy 513 | ASSERT(ierror==0) 514 | 515 | ASSERT(.not. nd_arr%is_ordered('F')) 516 | ASSERT(nd_arr%is_ordered('C')) 517 | ASSERT(nd_arr%is_ordered('A')) 518 | 519 | call nd_arr%destroy 520 | end subroutine 521 | 522 | subroutine test_is_ordered_discont() 523 | integer ierror 524 | type(object) :: retval 525 | type(ndarray) :: nd_arr 526 | 527 | ierror = call_py(retval, test_mod, "get_ndarray_2d_not_contiguous") 528 | ASSERT(ierror==0) 529 | 530 | ierror = cast(nd_arr, retval) 531 | call retval%destroy 532 | ASSERT(ierror==0) 533 | 534 | ASSERT(.not. nd_arr%is_ordered('F')) 535 | ASSERT(.not. nd_arr%is_ordered('C')) 536 | ASSERT(.not. nd_arr%is_ordered('A')) 537 | 538 | call nd_arr%destroy 539 | end subroutine 540 | 541 | subroutine test_is_ordered_1d() 542 | !for 1D array, the distinction between Fortran- and C-order does not matter 543 | integer ierror 544 | type(ndarray) :: nd_arr 545 | integer :: testarr(2) = [1, 2] 546 | 547 | ierror = ndarray_create(nd_arr, testarr) 548 | ASSERT(ierror==0) 549 | ASSERT(nd_arr%is_ordered('F')) 550 | ASSERT(nd_arr%is_ordered('C')) 551 | ASSERT(nd_arr%is_ordered('A')) 552 | ! test bad order parameter 553 | ASSERT(.not. nd_arr%is_ordered('Q')) 554 | 555 | call nd_arr%destroy 556 | end subroutine 557 | 558 | subroutine test_get_dtype_name() 559 | integer ierror 560 | type(ndarray) :: nd_arr 561 | real(kind=real64) :: testarr(1) = [42.0_real64] 562 | character(kind=C_CHAR, len=:), allocatable :: dname 563 | 564 | ierror = ndarray_create(nd_arr, testarr) 565 | ASSERT(ierror==0) 566 | ierror = nd_arr%get_dtype_name(dname) 567 | ASSERT(ierror==0) 568 | ASSERT(dname=='float64') 569 | 570 | call nd_arr%destroy 571 | end subroutine 572 | 573 | subroutine test_ndim() 574 | integer ierror 575 | type(ndarray) :: nd_arr 576 | integer :: testarr(2,3,4) 577 | integer :: ndim 578 | 579 | testarr = 0 580 | ierror = ndarray_create(nd_arr, testarr) 581 | ASSERT(ierror==0) 582 | ierror = nd_arr%ndim(ndim) 583 | ASSERT(ndim==3) 584 | 585 | call nd_arr%destroy 586 | end subroutine 587 | 588 | subroutine test_ndarray_create_empty01() 589 | integer ierror 590 | type(ndarray) :: nd_arr 591 | integer :: nx, ny 592 | real(kind=real64), dimension(:,:), pointer :: ptr 593 | nx = 3 594 | ny = 4 595 | ierror = ndarray_create_empty(nd_arr, [nx,ny], dtype="float64") 596 | ASSERT(ierror==0) 597 | ierror = nd_arr%get_data(ptr) 598 | ASSERT(ierror==0) 599 | ASSERT(size(ptr,1)==nx) 600 | ASSERT(size(ptr,2)==ny) 601 | call nd_arr%destroy 602 | end subroutine 603 | 604 | subroutine test_ndarray_create_empty02() 605 | integer ierror 606 | type(ndarray) :: nd_arr 607 | integer :: nx, ny 608 | real(kind=real64), dimension(:,:), pointer :: ptr 609 | nx = 3 610 | ny = 4 611 | ierror = ndarray_create_empty(nd_arr, [nx,ny], order="C") 612 | ASSERT(ierror==0) 613 | ierror = nd_arr%get_data(ptr, order="C") 614 | ASSERT(ierror==0) 615 | ASSERT(size(ptr,1)==ny) 616 | ASSERT(size(ptr,2)==nx) 617 | call nd_arr%destroy 618 | end subroutine 619 | 620 | subroutine test_ndarray_create_empty03() 621 | integer ierror 622 | type(ndarray) :: nd_arr 623 | integer(kind=int64) :: nx 624 | integer(kind=int64), dimension(:), pointer :: ptr 625 | nx = 11 626 | ierror = ndarray_create_empty(nd_arr, nx, dtype="int64", order="C") 627 | ASSERT(ierror==0) 628 | ierror = nd_arr%get_data(ptr, order="C") 629 | ASSERT(ierror==0) 630 | ASSERT(size(ptr,1)==nx) 631 | call nd_arr%destroy 632 | end subroutine 633 | 634 | subroutine test_ndarray_create_zeros01() 635 | integer ierror 636 | type(ndarray) :: nd_arr 637 | integer :: nx, ny 638 | real(kind=real64), dimension(:,:), pointer :: ptr 639 | nx = 2 640 | ny = 6 641 | ierror = ndarray_create_zeros(nd_arr, [nx,ny], dtype="float64") 642 | ASSERT(ierror==0) 643 | ierror = nd_arr%get_data(ptr) 644 | ASSERT(ierror==0) 645 | ASSERT(size(ptr,1)==nx) 646 | ASSERT(size(ptr,2)==ny) 647 | ASSERT(all(ptr==0.0_real64)) 648 | call nd_arr%destroy 649 | end subroutine 650 | 651 | subroutine test_ndarray_create_zeros02() 652 | integer ierror 653 | type(ndarray) :: nd_arr 654 | integer :: nx, ny 655 | real(kind=real64), dimension(:,:), pointer :: ptr 656 | nx = 3 657 | ny = 4 658 | ierror = ndarray_create_zeros(nd_arr, [nx,ny], order="C") 659 | ASSERT(ierror==0) 660 | ierror = nd_arr%get_data(ptr, order="C") 661 | ASSERT(ierror==0) 662 | ASSERT(size(ptr,1)==ny) 663 | ASSERT(size(ptr,2)==nx) 664 | ASSERT(all(ptr==0.0_real64)) 665 | call nd_arr%destroy 666 | end subroutine 667 | 668 | subroutine test_ndarray_create_zeros03() 669 | integer ierror 670 | type(ndarray) :: nd_arr 671 | integer(kind=int64) :: nx 672 | integer(kind=int64), dimension(:), pointer :: ptr 673 | nx = 11 674 | ierror = ndarray_create_zeros(nd_arr, nx, dtype="int64") 675 | ASSERT(ierror==0) 676 | ierror = nd_arr%get_data(ptr, order="C") 677 | ASSERT(ierror==0) 678 | ASSERT(size(ptr,1)==nx) 679 | ASSERT(all(ptr==0_int64)) 680 | call nd_arr%destroy 681 | end subroutine 682 | 683 | subroutine test_ndarray_create_ones01() 684 | integer ierror 685 | type(ndarray) :: nd_arr 686 | integer :: nx, ny 687 | complex(kind=real64), dimension(:,:), pointer :: ptr 688 | complex(kind=real64), parameter :: C_ONE = (1.0_real64, 0.0_real64) 689 | nx = 2 690 | ny = 6 691 | ierror = ndarray_create_ones(nd_arr, [nx,ny], dtype="complex128") 692 | ASSERT(ierror==0) 693 | ierror = nd_arr%get_data(ptr) 694 | ASSERT(ierror==0) 695 | ASSERT(size(ptr,1)==nx) 696 | ASSERT(size(ptr,2)==ny) 697 | ASSERT(all(ptr==C_ONE)) 698 | call nd_arr%destroy 699 | end subroutine 700 | 701 | subroutine test_ndarray_create_ones02() 702 | integer ierror 703 | type(ndarray) :: nd_arr 704 | integer :: nx, ny 705 | real(kind=real64), dimension(:,:), pointer :: ptr 706 | nx = 3 707 | ny = 4 708 | ierror = ndarray_create_ones(nd_arr, [nx,ny], order="C") 709 | ASSERT(ierror==0) 710 | ierror = nd_arr%get_data(ptr, order="C") 711 | ASSERT(ierror==0) 712 | ASSERT(size(ptr,1)==ny) 713 | ASSERT(size(ptr,2)==nx) 714 | ASSERT(all(ptr==1.0_real64)) 715 | call nd_arr%destroy 716 | end subroutine 717 | 718 | subroutine test_ndarray_create_ones03() 719 | integer ierror 720 | type(ndarray) :: nd_arr 721 | integer(kind=int64) :: nx 722 | integer(kind=int64), dimension(:), pointer :: ptr 723 | nx = 11 724 | ierror = ndarray_create_ones(nd_arr, nx, dtype="int64") 725 | ASSERT(ierror==0) 726 | ierror = nd_arr%get_data(ptr, order="C") 727 | ASSERT(ierror==0) 728 | ASSERT(size(ptr,1)==nx) 729 | ASSERT(all(ptr==1_int64)) 730 | call nd_arr%destroy 731 | end subroutine 732 | 733 | subroutine test_dtype_int32() 734 | integer ierror 735 | type(ndarray) :: nd_arr 736 | integer(kind=int32), dimension(:), pointer :: ptr_int32 737 | integer(kind=int64), dimension(:), pointer :: ptr_int64 738 | ierror = ndarray_create_zeros(nd_arr, 1, dtype="int32") 739 | ASSERT(ierror==0) 740 | ierror = nd_arr%get_data(ptr_int32) 741 | ASSERT(ierror==0) 742 | ierror = nd_arr%get_data(ptr_int64) 743 | ASSERT(ierror==EXCEPTION_ERROR) 744 | call err_clear 745 | call nd_arr%destroy 746 | end subroutine 747 | 748 | subroutine test_dtype_int64() 749 | integer ierror 750 | type(ndarray) :: nd_arr 751 | integer(kind=int32), dimension(:), pointer :: ptr_int32 752 | integer(kind=int64), dimension(:), pointer :: ptr_int64 753 | ierror = ndarray_create_zeros(nd_arr, 1, dtype="int64") 754 | ASSERT(ierror==0) 755 | ierror = nd_arr%get_data(ptr_int32) 756 | ASSERT(ierror==EXCEPTION_ERROR) 757 | call err_clear 758 | ierror = nd_arr%get_data(ptr_int64) 759 | ASSERT(ierror==0) 760 | call nd_arr%destroy 761 | end subroutine 762 | 763 | subroutine test_dtype_float32() 764 | integer ierror 765 | type(ndarray) :: nd_arr 766 | real(kind=real32), dimension(:), pointer :: ptr_real32 767 | real(kind=real64), dimension(:), pointer :: ptr_real64 768 | ierror = ndarray_create_zeros(nd_arr, 1, dtype="float32") 769 | ASSERT(ierror==0) 770 | ierror = nd_arr%get_data(ptr_real32) 771 | ASSERT(ierror==0) 772 | ierror = nd_arr%get_data(ptr_real64) 773 | ASSERT(ierror==EXCEPTION_ERROR) 774 | call err_clear 775 | call nd_arr%destroy 776 | end subroutine 777 | 778 | subroutine test_dtype_float64() 779 | integer ierror 780 | type(ndarray) :: nd_arr 781 | real(kind=real32), dimension(:), pointer :: ptr_real32 782 | real(kind=real64), dimension(:), pointer :: ptr_real64 783 | ierror = ndarray_create_zeros(nd_arr, 1, dtype="float64") 784 | ASSERT(ierror==0) 785 | ierror = nd_arr%get_data(ptr_real32) 786 | ASSERT(ierror==EXCEPTION_ERROR) 787 | call err_clear 788 | ierror = nd_arr%get_data(ptr_real64) 789 | ASSERT(ierror==0) 790 | call nd_arr%destroy 791 | end subroutine 792 | 793 | subroutine test_dtype_complex64() 794 | integer ierror 795 | type(ndarray) :: nd_arr 796 | complex(kind=real32), dimension(:), pointer :: ptr_creal32 797 | complex(kind=real64), dimension(:), pointer :: ptr_creal64 798 | ierror = ndarray_create_zeros(nd_arr, 1, dtype="complex64") 799 | ASSERT(ierror==0) 800 | ierror = nd_arr%get_data(ptr_creal32) 801 | ASSERT(ierror==0) 802 | ierror = nd_arr%get_data(ptr_creal64) 803 | ASSERT(ierror==EXCEPTION_ERROR) 804 | call err_clear 805 | call nd_arr%destroy 806 | end subroutine 807 | 808 | subroutine test_dtype_complex128() 809 | integer ierror 810 | type(ndarray) :: nd_arr 811 | complex(kind=real32), dimension(:), pointer :: ptr_creal32 812 | complex(kind=real64), dimension(:), pointer :: ptr_creal64 813 | ierror = ndarray_create_zeros(nd_arr, 1, dtype="complex128") 814 | ASSERT(ierror==0) 815 | ierror = nd_arr%get_data(ptr_creal32) 816 | ASSERT(ierror==EXCEPTION_ERROR) 817 | call err_clear 818 | ierror = nd_arr%get_data(ptr_creal64) 819 | ASSERT(ierror==0) 820 | call nd_arr%destroy 821 | end subroutine 822 | 823 | subroutine test_compiler_opt_issue 824 | integer ierror 825 | type(ndarray) :: nd_arr 826 | ! without asynchronous this test fails with ifort -O2 or -O1 827 | integer, asynchronous :: array(1) 828 | integer, dimension(:), pointer :: ptr 829 | integer :: b 830 | array(1) = 5 831 | ierror = ndarray_create_nocopy(nd_arr, array) 832 | ierror = nd_arr%get_data(ptr) 833 | b = array(1) 834 | ptr(1) = 9 835 | b = array(1) 836 | ASSERT(b==9) 837 | call nd_arr%destroy 838 | end subroutine 839 | 840 | subroutine test_ndarray_create_noncontiguous 841 | integer ierror 842 | type(ndarray) :: nd_arr 843 | integer(kind=int32), target :: test_array(6) 844 | integer(kind=int32), dimension(:), pointer :: slice 845 | integer(kind=int32), dimension(:), pointer :: ptr 846 | 847 | test_array = [1, 2, 3, 4, 5, 6] 848 | slice => test_array(1:6:2) 849 | 850 | ierror = ndarray_create(nd_arr, slice) 851 | ASSERT(ierror==0) 852 | ierror = nd_arr%get_data(ptr) 853 | ASSERT(ierror==0) 854 | ASSERT(all(ptr==slice)) 855 | call nd_arr%destroy 856 | end subroutine 857 | 858 | subroutine test_ndarray_create_nocopy_noncontig_fail 859 | ! ndarray_create_nocopy does not support 860 | ! non-contig. arrays in contrast to ndarray_create 861 | ! This test demonstrates that you get incorrect results 862 | ! when passing a non-contig. array 863 | integer ierror 864 | type(ndarray) :: nd_arr 865 | integer(kind=int32), target :: test_array(6) 866 | integer(kind=int32), dimension(:), pointer :: slice 867 | integer(kind=int32), dimension(:), pointer :: ptr 868 | 869 | test_array = [1, 2, 3, 4, 5, 6] 870 | slice => test_array(1:6:2) ! slice non-contig. 871 | 872 | ierror = ndarray_create_nocopy(nd_arr, slice) 873 | ASSERT(ierror==0) 874 | ierror = nd_arr%get_data(ptr) 875 | ASSERT(ierror==0) 876 | ASSERT(any(ptr/=slice)) 877 | call nd_arr%destroy 878 | end subroutine 879 | 880 | #:for NDIM in range(1, 5) 881 | #:set DIM_SPECIFIER = ",".join((":",) * NDIM) 882 | #:set FIRST_INDEX = ",".join(("1",) * NDIM) 883 | #:for DTYPE, FORTRAN_TYPE, FORTRAN_KIND, CONV_INTRINSIC in (("int32", "integer", "int32", "int"), & 884 | & ("int64", "integer", "int64", "int"), & 885 | & ("float32", "real", "real32", "real"), & 886 | & ("float64", "real", "real64", "real"), & 887 | & ("complex64", "complex", "real32", "cmplx"), & 888 | & ("complex128", "complex", "real64", "cmplx")) 889 | subroutine test_ndarray_create_${DTYPE}$_${NDIM}$d 890 | ${FORTRAN_TYPE}$(kind=${FORTRAN_KIND}$), allocatable, dimension(${DIM_SPECIFIER}$) :: test_array 891 | ${FORTRAN_TYPE}$(kind=${FORTRAN_KIND}$), pointer, dimension(${DIM_SPECIFIER}$) :: ptr 892 | type(ndarray) :: nd_arr 893 | type(tuple) :: args 894 | integer :: ierror 895 | 896 | call get_test_array_${DTYPE}$_${NDIM}$d(test_array) 897 | 898 | ierror = ndarray_create(nd_arr, test_array) 899 | ASSERT(ierror==0) 900 | ierror = tuple_create(args, 3) 901 | ASSERT(ierror==0) 902 | ierror = args%setitem(0, nd_arr) 903 | ASSERT(ierror==0) 904 | ierror = args%setitem(1, ${NDIM}$) 905 | ASSERT(ierror==0) 906 | ierror = args%setitem(2, "${DTYPE}$") 907 | ASSERT(ierror==0) 908 | 909 | ierror = call_py_noret(test_mod, "check_test_array", args) 910 | ASSERT(ierror==0) 911 | 912 | ! test copy semantics - change in nd_arr does not affect test_array and vice versa 913 | test_array(${FIRST_INDEX}$) = 12345 914 | ierror = nd_arr%get_data(ptr) 915 | ASSERT(ierror==0) 916 | ASSERT(ptr(${FIRST_INDEX}$) /= 12345) 917 | 918 | call args%destroy 919 | call nd_arr%destroy 920 | end subroutine 921 | 922 | subroutine test_ndarray_create_nocopy_${DTYPE}$_${NDIM}$d 923 | ${FORTRAN_TYPE}$(kind=${FORTRAN_KIND}$), allocatable, asynchronous, dimension(${DIM_SPECIFIER}$) :: test_array 924 | ${FORTRAN_TYPE}$(kind=${FORTRAN_KIND}$), pointer, dimension(${DIM_SPECIFIER}$) :: ptr 925 | type(ndarray) :: nd_arr 926 | type(tuple) :: args 927 | integer :: ierror 928 | 929 | call get_test_array_${DTYPE}$_${NDIM}$d(test_array) 930 | 931 | ierror = ndarray_create_nocopy(nd_arr, test_array) 932 | ASSERT(ierror==0) 933 | ierror = tuple_create(args, 3) 934 | ASSERT(ierror==0) 935 | ierror = args%setitem(0, nd_arr) 936 | ASSERT(ierror==0) 937 | ierror = args%setitem(1, ${NDIM}$) 938 | ASSERT(ierror==0) 939 | ierror = args%setitem(2, "${DTYPE}$") 940 | ASSERT(ierror==0) 941 | 942 | ierror = call_py_noret(test_mod, "check_test_array", args) 943 | ASSERT(ierror==0) 944 | 945 | ! test no-copy semantics - change in nd_arr affects test_array and vice versa 946 | test_array(${FIRST_INDEX}$) = 12345 947 | ierror = nd_arr%get_data(ptr) 948 | ASSERT(ierror==0) 949 | ASSERT(ptr(${FIRST_INDEX}$) == 12345) 950 | 951 | call args%destroy 952 | call nd_arr%destroy 953 | end subroutine 954 | 955 | subroutine test_get_data_${DTYPE}$_${NDIM}$d 956 | ${FORTRAN_TYPE}$(kind=${FORTRAN_KIND}$), allocatable, dimension(${DIM_SPECIFIER}$) :: test_array 957 | ${FORTRAN_TYPE}$(kind=${FORTRAN_KIND}$), pointer, dimension(${DIM_SPECIFIER}$) :: ptr 958 | type(object) :: retval 959 | type(ndarray) :: nd_arr 960 | type(tuple) :: args 961 | integer :: ierror 962 | 963 | call get_test_array_${DTYPE}$_${NDIM}$d(test_array) 964 | 965 | ierror = tuple_create(args, 2) 966 | ASSERT(ierror==0) 967 | ierror = args%setitem(0, ${NDIM}$) 968 | ASSERT(ierror==0) 969 | ierror = args%setitem(1, "${DTYPE}$") 970 | ASSERT(ierror==0) 971 | 972 | ierror = call_py(retval, test_mod, "get_test_array", args) 973 | ASSERT(ierror==0) 974 | ierror = cast(nd_arr, retval) 975 | ASSERT(ierror==0) 976 | ierror = nd_arr%get_data(ptr) 977 | ASSERT(ierror==0) 978 | 979 | ASSERT(all(test_array==ptr)) 980 | 981 | call retval%destroy 982 | call args%destroy 983 | call nd_arr%destroy 984 | end subroutine 985 | 986 | #:endfor 987 | #:endfor 988 | 989 | ! code to execute before every test 990 | subroutine setUp() 991 | call setUp_forpy_test 992 | end subroutine 993 | 994 | subroutine tearDown() 995 | call tearDown_forpy_test 996 | end subroutine 997 | 998 | subroutine setUpClass() 999 | integer ierror 1000 | type(list) :: paths 1001 | 1002 | ierror = forpy_initialize() 1003 | 1004 | if (ierror /= 0) then 1005 | write (*,*) "Initialisation of forpy failed!!! Can not test. Errorcode = ", ierror 1006 | stop 1007 | endif 1008 | 1009 | ! add current dir (".") to search path 1010 | ierror = get_sys_path(paths) 1011 | if (ierror == 0) then 1012 | ierror = paths%append(".") 1013 | call paths%destroy 1014 | endif 1015 | 1016 | if (ierror /= 0) then 1017 | write(*,*) "Error setting PYTHONPATH. Cannot test...", ierror 1018 | call err_print 1019 | STOP 1020 | endif 1021 | 1022 | ierror = import_py(test_mod, "test_ndarray") 1023 | if (ierror /= 0) then 1024 | write(*,*) "Could not import test module 'test_ndarray'. Cannot test..." 1025 | STOP 1026 | endif 1027 | end subroutine 1028 | 1029 | subroutine tearDownClass() 1030 | call test_mod%destroy 1031 | call forpy_finalize() 1032 | call print_test_count 1033 | end subroutine 1034 | 1035 | !=============================================================================== 1036 | != Test array generation 1037 | !=============================================================================== 1038 | 1039 | subroutine get_integer_test_array_1d(test_array) 1040 | integer(kind=int32), allocatable, dimension(:), intent(out) :: test_array 1041 | integer :: ii 1042 | 1043 | test_array = [ (ii, ii = 1, 7) ] 1044 | end subroutine 1045 | 1046 | subroutine get_integer_test_array_2d(test_array) 1047 | integer(kind=int32), allocatable, dimension(:,:), intent(out) :: test_array 1048 | integer :: ii 1049 | 1050 | test_array = reshape( [ (ii, ii = 1, 7*5) ], [7,5]) 1051 | end subroutine 1052 | 1053 | subroutine get_integer_test_array_3d(test_array) 1054 | integer(kind=int32), allocatable, dimension(:,:,:), intent(out) :: test_array 1055 | integer :: ii 1056 | 1057 | test_array = reshape( [ (ii, ii = 1, 7*5*3) ], [7,5,3]) 1058 | end subroutine 1059 | 1060 | subroutine get_integer_test_array_4d(test_array) 1061 | integer(kind=int32), allocatable, dimension(:,:,:,:), intent(out) :: test_array 1062 | integer :: ii 1063 | 1064 | test_array = reshape( [ (ii, ii = 1, 7*5*3*2) ], [7,5,3,2]) 1065 | end subroutine 1066 | 1067 | #:for NDIM in range(1, 5) 1068 | #:set DIM_SPECIFIER = ",".join((":",) * NDIM) 1069 | #:for DTYPE, FORTRAN_TYPE, FORTRAN_KIND, CONV_INTRINSIC in (("int32", "integer", "int32", "int"), & 1070 | & ("int64", "integer", "int64", "int"), & 1071 | & ("float32", "real", "real32", "real"), & 1072 | & ("float64", "real", "real64", "real"), & 1073 | & ("complex64", "complex", "real32", "cmplx"), & 1074 | & ("complex128", "complex", "real64", "cmplx")) 1075 | subroutine get_test_array_${DTYPE}$_${NDIM}$d(test_array) 1076 | ${FORTRAN_TYPE}$(kind=${FORTRAN_KIND}$), allocatable, dimension(${DIM_SPECIFIER}$), intent(out) :: test_array 1077 | integer(kind=int32), allocatable, dimension(${DIM_SPECIFIER}$) :: test_array_integer 1078 | 1079 | call get_integer_test_array_${NDIM}$d(test_array_integer) 1080 | 1081 | test_array = ${CONV_INTRINSIC}$(test_array_integer, kind=${FORTRAN_KIND}$) 1082 | 1083 | #:if FORTRAN_TYPE == "complex" 1084 | test_array = test_array * (1, -3) 1085 | #:endif 1086 | 1087 | end subroutine 1088 | 1089 | #:endfor 1090 | #:endfor 1091 | 1092 | end module 1093 | -------------------------------------------------------------------------------- /tests/unittest_mod.F90: -------------------------------------------------------------------------------- 1 | ! Copyright (C) 2017-2018 Elias Rabel 2 | ! 3 | ! This program is free software: you can redistribute it and/or modify 4 | ! it under the terms of the GNU Lesser General Public License as published by 5 | ! the Free Software Foundation, either version 3 of the License, or 6 | ! (at your option) any later version. 7 | ! 8 | ! This program is distributed in the hope that it will be useful, 9 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ! GNU Lesser General Public License for more details. 12 | ! 13 | ! You should have received a copy of the GNU Lesser General Public License 14 | ! along with this program. If not, see . 15 | 16 | module unittest_mod 17 | use, intrinsic :: iso_fortran_env, only: int32 18 | implicit none 19 | 20 | integer, private, save :: global_fail_flag = 0 21 | integer, private, save :: global_tests_run = 0 22 | integer, private, save :: global_tests_failed = 0 23 | 24 | character(len=:), allocatable, save :: global_testname 25 | 26 | interface pFail 27 | module procedure pFail_assert_fail 28 | module procedure pFail_assertequal_fail_int32 29 | end interface 30 | 31 | CONTAINS 32 | 33 | subroutine fail_test() 34 | global_fail_flag = 1 35 | end subroutine 36 | 37 | subroutine reset_fail_flag() 38 | global_fail_flag = 0 39 | end subroutine 40 | 41 | function get_fail_flag() result(flag) 42 | integer flag 43 | flag = global_fail_flag 44 | end function 45 | 46 | subroutine update_test_count() 47 | if (global_fail_flag == 1) then 48 | global_tests_failed = global_tests_failed + 1 49 | endif 50 | global_tests_run = global_tests_run + 1 51 | end subroutine 52 | 53 | subroutine print_test_count() 54 | write(*,*) "---------------------------------------------------------" 55 | write(*,*) global_tests_run, " tests run." 56 | write(*,*) global_tests_failed, " tests failed." 57 | end subroutine 58 | 59 | ! set the name of the current test 60 | subroutine setN(tname) 61 | character(len=*), intent(in) :: tname 62 | global_testname = tname 63 | end subroutine 64 | 65 | subroutine pFail_assert_fail(assertion, filename, line) 66 | character(len=*), intent(in) :: assertion 67 | character(len=*), intent(in) :: filename 68 | integer, intent(in) :: line 69 | 70 | call fail_test 71 | write(*,fmt="(A,A,A,A,A,I6)") "Assertion (", assertion, ") failed @", filename, ":", line 72 | end subroutine 73 | 74 | subroutine pFail_assertequal_fail_int32(value1, value2, filename, line) 75 | integer(kind=int32), intent(in) :: value1, value2 76 | character(len=*), intent(in) :: filename 77 | integer, intent(in) :: line 78 | 79 | call fail_test 80 | write(*,fmt="(A,I9,A,I9,A,A,A,I6)") "Assertion (", value1, " ==", value2, ") failed @", filename, ":", line 81 | end subroutine 82 | 83 | end module 84 | -------------------------------------------------------------------------------- /tests/unittest_mod.inc: -------------------------------------------------------------------------------- 1 | ! Copyright (C) 2017-2018 Elias Rabel 2 | ! 3 | ! This program is free software: you can redistribute it and/or modify 4 | ! it under the terms of the GNU Lesser General Public License as published by 5 | ! the Free Software Foundation, either version 3 of the License, or 6 | ! (at your option) any later version. 7 | ! 8 | ! This program is distributed in the hope that it will be useful, 9 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | ! GNU Lesser General Public License for more details. 12 | ! 13 | ! You should have received a copy of the GNU Lesser General Public License 14 | ! along with this program. If not, see . 15 | 16 | ! include this in the "contains" - section of each test module 17 | 18 | ! Note: When using the ASSERT macro, put strings into single quotes! 19 | 20 | #ifdef __GFORTRAN__ 21 | #define ASSERT(X) if(.not.(X)) then;call pFail("X",__FILE__,__LINE__);return;endif 22 | #else 23 | #define ASSERT(X) if(.not.(X)) then;call pFail(#X,__FILE__,__LINE__);return;endif 24 | #endif 25 | 26 | #define ASSERTEQUAL(X,Y) if((X)/=(Y)) then;call pFail(X,Y,__FILE__,__LINE__);return;endif 27 | 28 | subroutine preT() 29 | call setUp() 30 | call reset_fail_flag() 31 | end subroutine 32 | 33 | subroutine postT() 34 | call tearDown() 35 | 36 | call update_test_count() 37 | 38 | if (get_fail_flag() == 0) then 39 | write(*,*) "[OK ] ", global_testname 40 | else 41 | write(*,*) "[FAIL] ", global_testname 42 | endif 43 | end subroutine 44 | 45 | --------------------------------------------------------------------------------