├── .gitignore ├── assets ├── ullu-logo.png ├── ullu-cover.png └── unique-email.png ├── .gitattributes ├── errors.apln ├── tests ├── less_than.apln ├── greater_than.apln ├── equal.apln ├── less_than_or_equal.apln ├── not_equal.apln ├── greater_than_or_equal.apln ├── not.apln ├── _relational.apln ├── magnitude.apln ├── subtract.apln ├── add.apln ├── multiply.apln ├── behind.apln ├── union_and_intersection.apln ├── membership.apln ├── indexof.apln ├── residue.apln ├── uniquemask.apln ├── unique.apln ├── floor.apln └── divide.apln ├── docs ├── decision │ ├── readme.md │ ├── primitive-functions │ │ ├── scalar-dyadic-arithmetic.md │ │ ├── scalar-monadic.md │ │ ├── non-scalar-selection.md │ │ └── non-scalar-selector.md │ └── index.md ├── code-coverage.md └── how-to-add-tests.md ├── .github └── PULL_REQUEST_TEMPLATE.md ├── LICENSE ├── utils.apln ├── run.apls ├── readme.md ├── unittest.apln ├── contributing.md ├── random.apln ├── testfns.apln └── iso_defs.apln /.gitignore: -------------------------------------------------------------------------------- 1 | aplcore -------------------------------------------------------------------------------- /assets/ullu-logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Dyalog/ullu/main/assets/ullu-logo.png -------------------------------------------------------------------------------- /assets/ullu-cover.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Dyalog/ullu/main/assets/ullu-cover.png -------------------------------------------------------------------------------- /assets/unique-email.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Dyalog/ullu/main/assets/unique-email.png -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # Normalize line endings 2 | * text=auto eol=lf 3 | *.apl? linguist-language=APL 4 | -------------------------------------------------------------------------------- /errors.apln: -------------------------------------------------------------------------------- 1 | :Namespace errors 2 | DMX_NODMX←'' 3 | DMX_FR645LIMIT←'⎕FR=645 limits arithmetic to the range +/-1.79E308 (approx)' 4 | :EndNamespace 5 | -------------------------------------------------------------------------------- /tests/less_than.apln: -------------------------------------------------------------------------------- 1 | :Namespace less_than 2 | ∇ {r}←test_less_than;test 3 | test←⎕NS ⍬ 4 | test.primitive←< 5 | test.description←'Less than' 6 | test.error←1 7 | 8 | test.patterns←⍬ 9 | test.patterns,←⊂1 0 0 ⍝ Numeric less than 10 | 11 | r←#.tests._relational.test_relational test 12 | ∇ 13 | :EndNamespace 14 | -------------------------------------------------------------------------------- /tests/greater_than.apln: -------------------------------------------------------------------------------- 1 | :Namespace greater_than 2 | ∇ {r}←test_greater_than;test 3 | test←⎕NS ⍬ 4 | test.primitive←> 5 | test.description←'Greater than' 6 | test.error←1 7 | 8 | test.patterns←⍬ 9 | test.patterns,←⊂0 0 1 ⍝ Numeric greater than 10 | 11 | r←#.tests._relational.test_relational test 12 | ∇ 13 | :EndNamespace 14 | -------------------------------------------------------------------------------- /docs/decision/readme.md: -------------------------------------------------------------------------------- 1 | # Decision Docs 2 | 3 | Decision Docs are records detailing key decisions, fostering transparency and aiding future collaboration by providing a structured account of the decision-making process. Documentation about why certain decisions were taken in the codebase, it basically explains the mindset of the developer writing the tests and it also documents all the anomalies in the codebase. 4 | -------------------------------------------------------------------------------- /tests/equal.apln: -------------------------------------------------------------------------------- 1 | :Namespace equal 2 | ∇ {r}←test_equal;test 3 | test←⎕NS ⍬ 4 | test.primitive←= 5 | test.description←'Equal' 6 | test.error←0 7 | 8 | test.patterns←⍬ 9 | test.patterns,←⊂0 1 0 ⍝ Numeric equal 10 | test.patterns,←⊂¯1 1 ¯1 ⍝ Non-numeric equal 11 | 12 | r←#.tests._relational.test_relational test 13 | ∇ 14 | :EndNamespace 15 | -------------------------------------------------------------------------------- /tests/less_than_or_equal.apln: -------------------------------------------------------------------------------- 1 | :Namespace less_than_or_equal 2 | ∇ {r}←test_less_than_or_equal;test 3 | test←⎕NS ⍬ 4 | test.primitive←≤ 5 | test.description←'Less than or equal' 6 | test.error←1 7 | 8 | test.patterns←⍬ 9 | test.patterns,←⊂1 0 0 ⍝ Numeric less than 10 | test.patterns,←⊂0 1 0 ⍝ Numeric equal to 11 | 12 | r←#.tests._relational.test_relational test 13 | ∇ 14 | :EndNamespace 15 | -------------------------------------------------------------------------------- /tests/not_equal.apln: -------------------------------------------------------------------------------- 1 | :Namespace not_equal 2 | ∇ {r}←test_not_equal;test 3 | test←⎕NS ⍬ 4 | test.primitive←≠ 5 | test.description←'Not equal' 6 | test.error←0 7 | 8 | test.patterns←⍬ 9 | test.patterns,←⊂1 0 0 ⍝ less than 10 | test.patterns,←⊂0 0 1 ⍝ greater than 11 | test.patterns,←⊂¯1 0 ¯1 ⍝ Not equal 12 | 13 | r←#.tests._relational.test_relational test 14 | ∇ 15 | :EndNamespace 16 | -------------------------------------------------------------------------------- /.github/PULL_REQUEST_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | ## Related Issue(s) 2 | 3 | - Link or list the issue(s) this PR addresses. 4 | - Fixes `#xxx` 5 | - Closes `#xxx` 6 | 7 | ## Description 8 | 9 | Describe the changes made and why they were made. 10 | 11 | 12 | ## PR Checklist (Remove options that are not relevant) 13 | 14 | - [ ] This PR adds tests for a new primitive 15 | - [ ] Code coverage has been checked 16 | - [ ] Documentation complete (Decision docs, code comments, etc.) 17 | -------------------------------------------------------------------------------- /tests/greater_than_or_equal.apln: -------------------------------------------------------------------------------- 1 | :Namespace greater_than_or_equal 2 | ∇ {r}←test_greater_than_or_equal;test 3 | test←⎕NS ⍬ 4 | test.primitive←≥ 5 | test.description←'Greater than or equal' 6 | test.error←1 7 | 8 | test.patterns←⍬ 9 | test.patterns,←⊂0 0 1 ⍝ Numeric greater than 10 | test.patterns,←⊂0 1 0 ⍝ Numeric equal to 11 | 12 | r←#.tests._relational.test_relational test 13 | ∇ 14 | :EndNamespace 15 | -------------------------------------------------------------------------------- /docs/code-coverage.md: -------------------------------------------------------------------------------- 1 | # How to get code coverage reports? 2 | 3 | > This is only relevant to people working at Dyalog Ltd. 4 | 5 | Checking for code coverage reports is a very important part. Though not very reliable to measure all cases have been tested, code coverage reports give us an assurance that there are no codepaths left unturned with the tests. It helps us remove dead code and refactor code. It is a very helpful testing and refactoring technique. 6 | 7 | Find the documentation at on how to generate a code coverage report with Dyalog APL: https://wiki.bramley.dyalog.com/index.php/Code_coverage_reports -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2023 Dyalog 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /docs/decision/primitive-functions/scalar-dyadic-arithmetic.md: -------------------------------------------------------------------------------- 1 | # Scalar Dyadic Arithmetic Functions 2 | 3 | ## [Residue](../../../tests/residue.apln) (`R←X|Y`)([docs](http://help.dyalog.com/latest/Content/Language/Primitive%20Functions/Residue.htm)) 4 | 5 | The tests include: 6 | - Datatype tests: tests for positive and negative for all the available numeric datatypes 7 | - Tests based on Floating point representation(`⎕FR`): All the tests run with values of `⎕FR` as 645 and 1287. 8 | - Tests based on Comparison tolerance(`⎕CT` and `⎕DCT`): All the tests run with default and zero values. 9 | - Edge Cases: 10 | - Separate cases had to be added for 0, ¯1, 0J0, 0.0 11 | - Separate cases had to be added to residue propogated using a scan to target certain sections of sources. 12 | 13 | Variations include: 14 | - Normal: general test case with parameter and expected result. 15 | - Empty: an empty array generated from the parameter of the testcase is used for the test. 16 | - Different shapes: shapes are randomly generated. 17 | - Different shapes with 0 in shape: A 0 is randomly inserted into the shape to generate this case. 18 | 19 | Code Coverage report: Residue is 100% covered by these tests. 20 | Significant covered files include: `allos/src/arith_su.c`, `allos/src/z.c`, and `allos/src/scalarscalar.cpp` 21 | -------------------------------------------------------------------------------- /docs/decision/index.md: -------------------------------------------------------------------------------- 1 | # Decision Doc 2 | 3 | # [unittest.apln](../../unittest.apln) 4 | 5 | Unit tests file is the main file of the program that runs the tests. It is structured with 3 main functions: 6 | - `RunTests` 7 | - `Assert` 8 | - `GetTests` 9 | 10 | ### RunTests 11 | Base function, parses all input parameters, fetches and executes tests. 12 | 13 | Parses verbose, stop and random link(⎕RL) values. 14 | 15 | ⎕RL value is set to 0 by default, 0 here generates a random ⎕RL value and logs it, so that non-similar tests run everytime the suite is executed. It logs the random value put into ⎕RL so these tests can be repeated. Any valid value can be put into ⎕RL. 16 | 17 | Final result is displayed with number of tests ran, failed, passed and the time taken to complete the testing. 18 | 19 | ### Assert 20 | Handles execution, termination and visualization of each test based on instructions from verbose and stop. 21 | 22 | It is a dyadic function of the format `r←tData Assert r`. `tData` being test ID and test comments for the particular test. `r` being the result of the indivisual test. 23 | 24 | ### GetTests 25 | Fetches tests for RunTests to execute them. Fetches a namespace containing functions called test_*. 26 | 27 | # The tests 28 | The tests are categorised into the type of function/operator they are categorised according to the Language Reference by [help.dyalog.com](https://help.dyalog.com/latest/) 29 | - Primitive functions 30 | - Non Scalar Selector functions 31 | - Scalar Monadic Functions 32 | 33 | ## Test Files 34 | 35 | The test files are structed with two functions: 36 | - `test_functionname`: General testcases including variations of ⎕IO, ⎕FR, ⎕CT, ⎕DCT(implicit arguments of the function) and datatypes for each testcase. 37 | - `RunVariations`: Each test is run with variations of normal, empty, and differently shaped. 38 | -------------------------------------------------------------------------------- /utils.apln: -------------------------------------------------------------------------------- 1 | :Namespace utils 2 | ⍝ constants 3 | ct_default←1E¯14 ⍝ ⎕CT values 4 | dct_default←1E¯28 5 | 6 | fr_dbl←645 ⍝ ⎕FR values 7 | fr_decf←1287 8 | 9 | io_default←1 ⍝ ⎕IO values 10 | io_0←0 11 | 12 | div_0←0 ⍝ ⎕DIV values 13 | div_1←1 14 | 15 | ⍝ utility functions 16 | shuffle←{⊂⍤?⍨∘≢⌷⍵} ⍝ completely Random shuffle 17 | intertwine←{(⊂⍋∊⍳∘≢¨⍺ ⍵)⌷⍺⍪⍵} ⍝ perfectly intertwine two arrays 18 | hashArray←1500⌶ ⍝ pre-hash array 19 | stripToSameLen←{(⍺(⌊⍥≢)⍵)↑¨⍺ ⍵} ⍝ get two arrays to the length of the shorter array 20 | numOrChar←{326(=-⍨2|⊢)⎕DR ⍵} ⍝ Type of ⍵ (¯1:mixed, 0:character, 1:numeric) 21 | change0sto1←{1@(0∘=)⍵} ⍝ Replacing zeroes in ⍵ with 1 22 | ints←{ ⍝ ⍺ integers of size ⍵ (bits), excluding the booleans 23 | ⎕IO←0 24 | ⍺⍴0 1~⍨(2*⍵-1)-⍨?⍺⍴2*⍵ 25 | } 26 | 27 | ⍝ Interpreter version information 28 | isClassic←82=⎕dr'' 29 | width←{2×⎕SIZE '⍵'}⍬ 30 | isBigEndian←0=⊃11 ⎕DR 128 31 | version←{⍎(2>+\⍵='.')/⍵}⊃1↓'.'⎕wg'APLVersion' 32 | verifyDotNetInterface←(2250⌶)0 33 | doSlowTests←((,'1')≡ 2 ⎕NQ #'GetEnvironment' 'DYALOG_QA_SLOW_TESTS') 34 | 35 | ∇ (min max)←NumericMinMax type;RealMinMax;bits 36 | ⍝ Return the min and max value of a number with element 37 | ⍝ type 'type' 38 | RealMinMax←{ 39 | ⎕FR←⍵ 40 | (⌈⌿,⌊⌿)⍬ 41 | } 42 | :Select type 43 | :Case 11 44 | (min max)←0 1 45 | :CaseList 83 163 323 46 | bits←⌊type÷10 47 | min←-2*bits-1 48 | max←¯1+2*bits-1 49 | :CaseList 645 1287 50 | (min max)←RealMinMax type 51 | :Case 1289 52 | (min max)←{⍵+¯11○⍵}RealMinMax 645 53 | :Else 54 | 'Missing case'⎕SIGNAL 11 55 | :EndSelect 56 | 57 | ∇ 58 | :EndNamespace 59 | -------------------------------------------------------------------------------- /run.apls: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env dyalogscript 2 | 3 | ⍝ Full session start-up 4 | ⎕SE.(⍎⊃2⎕FIX'/StartupSession.aplf',⍨2⎕NQ#'GetEnvironment' 'DYALOG') 5 | 6 | ⍝ Load the code from the current directory 7 | ⎕SE.Link.Import # (⎕SE.Dyalog.Utils.CD '') 8 | 9 | retry←{ 10 | fn←∇ 11 | 11::{⎕←'→ ',⎕DMX.EM ⋄ fn ⍵}⍵ 12 | ⍺⍺ ⍵⍵ ⍵ 13 | } 14 | 15 | testnames←tests.⎕NL ¯9 16 | testnames⌿⍨←('_'≠⊃)¨testnames 17 | 18 | ⎕←'Available tests:' 19 | ⎕←'∘ ',⍤1⊢↑testnames 20 | 21 | readName←{ 22 | ⍵≡'all': testnames 23 | (⊂⍵)∊testnames: ⊂⍵ 24 | ('Invalid test name: ',⍵)⎕SIGNAL 11 25 | } 26 | 27 | askNames←{ 28 | ⍞←'Choose tests to run, or hit ENTER to run all: ' 29 | in←¯1⎕C⍞ ⍝ lowercase stdin 30 | in≡'':⊂'all' 31 | ' '(≠⊆⊢)in ⍝ split on spaces 32 | } 33 | 34 | choosen←⊃,⌿readName¨ retry askNames ⍬ 35 | ⎕←'Tests choosen:' 36 | ⎕←'∘ ',⍤1⊢↑choosen 37 | 38 | options ←⊂1 'prod' 'Production mode (0 or 1)' 39 | options,←⊂0 'verbose' 'Verbose output (0 or 1)' 40 | options,←⊂1 'reps' 'How many repetitions of the tests to run' 41 | options,←⊂0 'randlink' 'Initial value of ⎕RL. 0 for random ⎕RL' 42 | (optionValues optionNames optionDescriptions)←↓⍉↑options 43 | 44 | readOption←{ 45 | ''≡⍵:⍬ ⍝ done 46 | 47 | (name val)←'='(≠⊆⊢)⍵ 48 | name←optionNames⍳⊂name 49 | (valid val)←⎕VFI val 50 | (1≠+⌿'='=⍵)∨(name>≢optionNames)∨(0∊valid): ('Invalid option update: ',⍵)⎕SIGNAL 11 51 | (name⊃optionValues)←val 52 | ('Updated ',(name⊃optionNames),': ',⍕val)⎕SIGNAL 11 53 | } 54 | 55 | askOptions←{ 56 | ⎕←'Change test options, or hit ENTER to use the current values.' 57 | ⎕←'Type ? for more information, or OPTION=NEWVAL to update.' 58 | ⎕←'Current options:' 59 | _←optionNames{⎕←'∘ ',⍺,': ',⍕⍵ ⋄ 0}¨optionValues 60 | {⍞}⍣{ 61 | ⍺≢,'?': 1 62 | ⎕←↑optionNames{'∘ ',⍺,': ',⍵}¨optionDescriptions 63 | 0 64 | }⍬ 65 | } 66 | 67 | readOption retry askOptions ⍬ 68 | 69 | optionNames,←⊂'stop' 70 | optionValues,←0 71 | 72 | :For test :In choosen 73 | ⎕←'Running test: ',test 74 | unittest.RunTests (⍎'tests.',test),optionValues[optionNames⍳'prod' 'verbose' 'stop' 'reps' 'randlink'] 75 | :EndFor 76 | -------------------------------------------------------------------------------- /docs/decision/primitive-functions/scalar-monadic.md: -------------------------------------------------------------------------------- 1 | # Scalar Monadic Functions 2 | 3 | ## [Magnitude](../../../tests/magnitude.apln) (`R←|Y`)([docs](https://help.dyalog.com/latest/Content/Language/Primitive%20Functions/Magnitude.htm)) 4 | 5 | The tests include: 6 | - Datatype tests: tests for positive and negative for all the available numeric datatypes 7 | - Tests based on Floating point representation(`⎕FR`): All the tests run with values of `⎕FR` as 645 and 1287. 8 | - Separate tests for boolean values: Booleans need special tests because construction of boolean arrays is simple and different than others. 9 | - Edge Cases: 10 | - I4 (32-bit int) argument and D8 (IEEE float) result. ¯2147483648 is the largest magnitude negative 32-bit int but 2147483647 is the largest positive. Therefore, the absolute value of ¯2147483648 has to be stored in a float. Note that the argument must not be a scalar for this code to be hit. Magnitude on a non-complex number is abs(olute). Also, The elements in the argument to | will all have the same type, and similarly the elements in the result will do as well (The other side of the turnary operator for the template). 11 | - Same as the above example, except that DF is DECF. 12 | - Z (complex) argument and DF (DECF float) result. Magnitude, when applied to complex, gives a non-complex result. 13 | - When a singleton scalar boolean is passed as rarg to magnitude, this `if block` hits, but there is no way to make a singleton scalar boolean as it is rarely used due to performance concerns. They way to make singleton booleans ∧/1 0 1 0. Whether this will continue is hard to say, but it is still the case in v19.0. This case basically returns the rarg as the result as booleans are 0 and 1 values which need not be changed by magnitude. 14 | 15 | Variations include: 16 | - Normal: general test case with parameter and expected result. 17 | - Empty: an empty array generated from the parameter of the testcase is used for the test. 18 | - Different shapes: shapes are randomly generated. 19 | - Different shapes with 0 in shape: A 0 is randomly inserted into the shape to generate this case. 20 | 21 | Code Coverage report: Magnitude is 100% covered by these tests. The portions from - `allos/src/optimise_expr.cpp` and `allos/src/optimise_parse.cpp` are not covered because they are obsolete. 22 | -------------------------------------------------------------------------------- /docs/decision/primitive-functions/non-scalar-selection.md: -------------------------------------------------------------------------------- 1 | # Non Scalar Selection functions 2 | 3 | ## [Unique](../../../tests/unique.apln) (`R←∪Y`)([docs](https://help.dyalog.com/latest/Content/Language/Primitive%20Functions/Unique.htm)) 4 | Same as unqiue mask below 5 | 6 | ## [Unique Mask](../../../tests/uniquemask.apln) (`R←≠Y`)([docs](https://help.dyalog.com/latest/Content/Language/Primitive%20Functions/Unique%20Mask.htm)) 7 | 8 | Most of it is very similar to other tests so only documenting the different parts here. One thing that bugged me for a very long time was a switch case at `allos/src/same.c.html#L1311` in function `tolerant_nubsieve(void)` where the lines of code were not hit with a the normal cases. 9 | 10 | Exerpt from ROS's email: 11 | 12 | ``` 13 | This wasn’t easy to figure out ☹ 14 | 15 | I think the important factors here are the leading shape (“s”) of the array, and the number of unique elements (“u”). This creates such a thing: 16 | 17 | s 2⍴?u⍴0 18 | 19 | (It assumes two identical random floats won’t be created, which is nearly but not quite safe to do.) 20 | 21 | Now, the cluster index seems to be a vector with a length s and range of values dependent on u. 22 | 23 | The grade-up index of the cluster index will also have a length s, but s unique values. 24 | 25 | ct is the element type of the cluster index, so its (squeezed) type is dependent on the number of unique values. It appears it can be Boolean or 1, 2 or 4 bytes (unsigned), encoded 1, 2, 3 or 4 (referred in big switch statement as APLBOOL, APLSINT, APLINTG and APLLONG, but that’s misleading because those are signed). 26 | 27 | gt is the element type of the grade-up index, so its squeezed type is dependent on the leading shape. It can be 1, 2 or 4 bytes (unsigned), encoded 2, 3 or 4 (APLSINT, APLINTG, APLLONG) 28 | 29 | This gives the possible combinations (ignore the colouring for now): 30 | ``` 31 | ![unique email](../../../assets/unique-email.png) 32 | ``` 33 | However, there can’t be more unique elements than elements, so I think the red lines are impossible. 34 | 35 | Also, it appears that the generated cluster index doesn’t necessarily consist of the smallest element type – in particular, if gt is APLLONG then ct is always APLLONG too. That makes the orange lines impossible. 36 | 37 | You can get the remaining ones (those in black) by evaluating ≠s 2⍴?u⍴0, for the values u and s in the table. 38 | 39 | (You can also test the orange cases by squeezing the value you get back from cluster_index(), but that’s not something you can do in a “standard” interpreter.) 40 | 41 | Regards, 42 | Richard 43 | ``` 44 | -------------------------------------------------------------------------------- /docs/decision/primitive-functions/non-scalar-selector.md: -------------------------------------------------------------------------------- 1 | # Non Scalar Selector functions 2 | 3 | ## [Index of](../../../tests/indexof.apln) (`R←X⍳Y`)([docs](https://help.dyalog.com/latest/Content/Language/Primitive%20Functions/Index%20Of.htm)) 4 | 5 | The tests include: 6 | - Datatype tests: tests for found and indexed/not-found variations for all the available datatypes 7 | - Cross-datatype tests: tests for found and indexed/not-found across datatypes, concatenating expressions and results to find any errors. 8 | - Tests based on comparison tolerance(`⎕CT` & `⎕DCT`): tests to check if `d=d+1` on larger values of double, floating and complex numbers based on comparison tolerance values(default or 0). 9 | - Tests based on Floating point representation(`⎕FR`): All the tests run with values of `⎕FR` as 645 and 1287. 10 | - Separate tests for boolean values: Booleans need special tests because they only have 2 elements and since `i1` and `bool` have overlapping values. 11 | 12 | Variations include: 13 | - Normal: general test case with left, right and expected result. 14 | - Empty left: an empty array generated from the left argument of the testcase is used for the test. 15 | - Empty right: Right argument cannot be empty so it is not included. 16 | - Different shapes: TBD. 17 | - Different shapes with 0 in shape: TBD. 18 | 19 | Code Coverage report: NA 20 | 21 | ## [Membership](../../../tests/membership.apln) (`R←X∊Y`) ([docs](https://help.dyalog.com/latest/Content/Language/Primitive%20Functions/Membership.htm)) 22 | 23 | The tests include: 24 | - Datatype tests: tests for found/not-found variations for all the available datatypes. 25 | - Cross-datatype tests: tests for found/not-found across datatypes, concatenating expressions and results to find any errors. 26 | - Tests based on comparison tolerance(`⎕CT` & `⎕DCT`): tests to check if `d=d+1` on larger values of double, floating and complex numbers based on comparison tolerance values(default or 0). 27 | - Tests based on Floating point representation(`⎕FR`): All the tests run with values of `⎕FR` as 645 and 1287. 28 | - Separate tests for boolean values: Booleans need special tests because they only have 2 elements and since `i1` and `bool` have overlapping values. 29 | 30 | Variations include: 31 | - Normal: general test case with left, right and expected result. 32 | - Empty left: an empty array generated from the left argument of the testcase is used for the test. 33 | - Empty right: an empty array generated from the right argument of the testcase is used for the test. 34 | - Different shapes: shapes are randomly generated with a certain rule. That is, for ANY array lshape, and for any rightshape where `(≢right)≤×/rshape` the condition guarantees that `rshape⍴right` will create an array which contains ALL the elements of right, possibly more than once. 35 | - Different shapes with 0 in shape: A 0 is randomly inserted into the shape of the left array to generate this case. 36 | 37 | Code Coverage report: NA 38 | -------------------------------------------------------------------------------- /tests/not.apln: -------------------------------------------------------------------------------- 1 | :Namespace not 2 | Assert←#.unittest.Assert 3 | NearBoolean←#.iso_defs.NearBoolean 4 | IntegerNearestTo←#.iso_defs.IntegerNearestTo 5 | SetupSysvars←#.iso_defs.SetupSysvars 6 | 7 | ∇ r←model data 8 | ⍝ ISO 7.1.12 9 | 10 | SetupSysvars ⎕THIS 11 | :If ∧⌿∊NearBoolean data 12 | r←1≠IntegerNearestTo data 13 | :Else 14 | ⎕SIGNAL 11 15 | :EndIf 16 | ∇ 17 | 18 | ∇ r←testDesc 19 | r←'for ',case,' & ⎕CT ⎕DCT ⎕FR:',⍕⎕CT ⎕DCT ⎕FR 20 | ∇ 21 | 22 | ∇ {r}←test_not;Chars;Ints;RunVariations;case;caselist;ct;data;data_bool;data_char;data_char1;data_char2;data_char4;data_int1;data_int2;data_int4;data_largercomplex;data_nearbool;data_notnearbool;data_smallcomplex;desc;expected;fr;id;ok;quadparams;static_rslt;static_tests 23 | r←⍬ 24 | RunVariations←model #.testfns._RunVariationsWithModel_~ 25 | Ints←#.random.Ints 26 | Chars←#.random.Chars 27 | 28 | :For ct :In 0 1 10 0.1 29 | (⎕CT ⎕DCT)←ct×#.utils.(ct_default dct_default) 30 | :For fr :In 1 2 31 | ⎕FR←fr⊃#.utils.(fr_dbl fr_decf) 32 | ⎕IO←1 33 | 34 | quadparams←⎕CT ⎕DCT ⎕FR ⎕IO ⎕DIV 35 | 36 | data_bool←1 0 37 | data_nearbool←0 1∘.+{⍵,-⍵}0,#.iso_defs.IntegerTolerance÷⍳10 38 | data_notnearbool←0 1∘.+{⍵,-⍵}#.iso_defs.(IntegerTolerance+IntegerTolerance÷⍳10) 39 | 40 | :If #.utils.version≥20 ⍝ Mantis 21762: 20.0 contains a fix for ~ on complex numbers 41 | data_smallcomplex←,∘.{⍺+¯11○⍵}⍨1⊃↓data_nearbool 42 | data_largercomplex←,∘.{⍺+¯11○⍵}⍨2⊃↓data_nearbool 43 | data_largercomplex,←,∘.{⍺+¯11○⍵}⍨,data_notnearbool 44 | :EndIf 45 | 46 | data_int1←100 Ints 8 47 | data_int2←100 Ints 16 48 | data_int4←100 Ints 32 49 | data_char1←100 Chars 8 50 | 51 | :If ~#.utils.isClassic 52 | data_char2←100 Chars 16 53 | data_char4←100 Chars 32 54 | :EndIf 55 | 56 | caselist←⎕NL ¯2 57 | caselist←caselist⌿⍨{'data_'⊃⍤⍷⍵}¨caselist 58 | 59 | :For case :In caselist 60 | data←⍎case 61 | desc←testDesc 62 | r,←'Not (~)'desc quadparams RunVariations⊂data 63 | :EndFor 64 | 65 | static_tests←⍬ 66 | static_tests,←⊂'0≡~1' 1 67 | static_tests,←⊂'1≡~0' 1 68 | static_tests,←⊂'0≡~≠⌿0 1' 1 69 | static_tests,←⊂'1≡~≠⌿1 1' 1 70 | static_tests,←⊂'~2'(11 '') 71 | static_tests,←⊂'~1.5'(11 '') 72 | 73 | :For (case expected) :In static_tests 74 | :Trap 0 75 | static_rslt←⍎case 76 | :Else 77 | static_rslt←⎕DMX.(EN Message) 78 | :EndTrap 79 | desc←testDesc 80 | r,←'Not (~)'desc Assert expected≡static_rslt 81 | :EndFor 82 | 83 | :EndFor 84 | :EndFor 85 | ∇ 86 | :EndNamespace 87 | -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | ![ullu Banner](assets/ullu-cover.png) 2 | 3 | [![GitHub Licence](https://img.shields.io/github/license/sloorush/ullu)](LICENSE) 4 | 5 | # ullu 6 | 7 | > A test suite to test APL Primitives. 8 | 9 | ## 🤔 What is ullu? 10 | 11 | Ullu is a QA for DyalogAPL (can be used to test any APL ideally) which tests specifically the functionality of primitives one by one. This test suite's main focus is finding bugs, irregularities, edge cases and code coverage. 12 | 13 | ## 🎿 Coverage 14 | 15 | ### 💪 Available Tests 16 | 17 | Check the tests in the [tests](./tests/) folder 18 | 19 | ### 🧱 In progress and Next up 20 | 21 | All details about upcoming tests can be found in the [project board](https://github.com/orgs/Dyalog/projects/4/views/1) 22 | 23 | ## ✍ The name 24 | 25 | Pronounced as `/ˈulːluː/`, The name comes from the Hindi word for owl. The owl looks over Dyalog APL when everyone else is asleep. 26 | 27 | Just as the owl represents both wisdom and foolishness the QA also has a dual nature of being wise and dumb at the same time. 28 | 29 | ### 🔗 Contrituting guide 30 | 31 | - [contributing.md](contributing.md): Guide on how to contribute to the codebase 32 | - [How to add tests?](docs/how-to-add-tests.md): Detailed guide on how to add tests 33 | - [Coverage Docs](docs/code-coverage.md): Guide on how to generate code coverage reports 34 | - [Decision docs](docs/decision): Explains the decisions taken with each step of the codebase and also documents anomalies for future users 35 | 36 | ## ⬇ Usage 37 | 38 | You can use ullu in a dyalog session on any supported operating system. 39 | 40 | ### Quick Run 41 | 42 | Run tests using dyalogscript: 43 | ``` 44 | dyalogscript run.apls 45 | ``` 46 | 47 | After this, you will be prompted with options to choose from 48 | 49 | ### Detailed Run 50 | 51 | Using Dyalog Interpreter (prefered): 52 | 53 | - Load the namespaces: 54 | 55 | ``` 56 | ]LINK.Create # 57 | ``` 58 | 59 | - Run the test cases 60 | 61 | ``` 62 | unittest.RunTests tests.[test_namespace] [prod=1|0] [verbose= 1|0] [stop=1|0] [⎕RL=any seed value(''?'' for random)] (0 default) 63 | ``` 64 | 65 | Options: 66 | 67 | prod: Changes the result of the test suite to be completely non-verbose and just return 1 if everything passes to not clutter the Jenkins jobs 68 | 69 | verbose: if set to 0, only output failing tests and a single summary line and version information. 70 | 71 | stop: if set to 1, any test which fails causes the framework to stop and allows the developer to inspect the failing test. 72 | 73 | ⎕RL: Seed value to for the random link variable that generates random numbers through the tests (it gets reset after each test) 74 | 75 | Example: 76 | ``` 77 | unittest.RunTests tests.membership 0 1 0 1232 78 | ``` 79 | or 80 | ``` 81 | unittest.RunTests tests.membership 82 | ``` 83 | 84 | 85 | 86 | ### 🔗 Suggestions/Questions 87 | 88 | Feel free to open GitHub issues for any questions, suggestions or feature requests 89 | 90 | If you want to reach out, please email `aarush[at]dyalog.com` 91 | 92 | 93 | 94 | ## ⚖ Licence 95 | 96 | Copyright 2023 Dyalog 97 | 98 | Licensed under MIT License: https://opensource.org/licenses/MIT 99 | 100 | 101 | -------------------------------------------------------------------------------- /unittest.apln: -------------------------------------------------------------------------------- 1 | :Namespace unittest 2 | GetTests←{ ⍝ ⍵ is a ref to a namespace containing functions called test_* 3 | tests←'test_.+'⎕S'&'⍵.⎕NL ¯3 4 | tests←('.',⍨⍕⍵)∘,¨tests 5 | tests 6 | } 7 | 8 | FAIL_OK←'[FAIL]' '[OK]' ⍝ 1+bool will give fail and ok on 0 and 1 9 | 10 | ⍝ Pretty print test result 11 | PPTestResult←{⍵[2], ⍵[3], ': ', FAIL_OK[1+⍵[1]]} 12 | 13 | ∇ r←tData Assert r;r;tID;tCmt ⍝ to output result of tests 14 | (tID tCmt)←tData 15 | :If (~r)∧stop 16 | PPTestResult r tID tCmt 17 | 'Stopping on failure of:'⎕SIGNAL 500 18 | :EndIf 19 | :If verbose 20 | PPTestResult r tID tCmt 21 | :ElseIf ~r∨stop 22 | PPTestResult r tID tCmt 23 | :EndIf 24 | ∇ 25 | 26 | ∇ r←rep ExecuteTests tests;r;tests;i;expr;t;nPass;nFail;time 27 | time←⎕AI[2] 28 | :Section ExecuteTests 29 | tList←⍳≢tests 30 | r←⍬ 31 | :For i :In tList 32 | :If ~prod 33 | ⎕←'' ⋄ tests[i] ⋄ ⎕←'' 34 | :EndIf 35 | t←i⊃tests 36 | :If 0=11 ⎕ATX t ⍝ Skip if the function isn't niladic. It is probably a helper function and not a test on its own. 37 | r,←⍎expr←t 38 | :EndIf 39 | :EndFor 40 | :EndSection 41 | 42 | :Section EvalRepeatResult 43 | nPass←(+/,)r ⋄ nFail←(≢r)-nPass 44 | :If ~prod∧(nPass≡≢r) 45 | ⎕←'Repetition:',rep,'with Option:' 46 | ⎕←(6⍴' '),'⎕RL is set to:',{0∊⍴⍵:' ⍬' ⋄ ⍵}rl 47 | ⎕←'' ⋄ ⎕←'Repetition',rep,'tests completed: ',(≢r),'ran,',nFail,'failed test,',nPass,'successes',((⎕AI[2]-time)÷1000),'s' ⋄ ⎕←'' 48 | :EndIf 49 | :EndSection 50 | ∇ 51 | 52 | ⍝ This function runs the tests 53 | ⍝ It takes 1 mandatory and 3 optional arguments [test_namespace] [prod=1|0] [verbose= 1|0] [stop=1|0] [repetitions=any num] [⎕RL=any seed value] (0 default) 54 | ∇ {z}←RunTests args;time;testNS;tests;i;tList;r;nPass;nFail;reps;rep;versionInfo 55 | time←⎕AI[2] ⍝ Start time of execution of tests 56 | ⎕PW←1000 57 | :Section parseArguments ⍝ This section parses and verifies input arguments 58 | 'missing or extra arguments. Correct usage is: [test_namespace] [prod=1|0] [verbose= 1|0] [stop=1|0] [repetitions=any num] [⎕RL=any seed value(0 for random)] (0 default)'⎕SIGNAL((≢args)∊⍳6)↓11 59 | (testNS prod verbose stop reps randLink)←6↑args,0 0 0 0 0 0 60 | 'Prod can only be 0 or 1'⎕SIGNAL(prod∊0 1)↓11 61 | 'Verbose can only be 0 or 1'⎕SIGNAL(verbose∊0 1)↓11 62 | 'Stop can only be 0 or 1'⎕SIGNAL(stop∊0 1)↓11 63 | reps←{reps<1:1 ⋄ reps}reps 64 | :If prod 65 | verbose←0 66 | :Else 67 | ⎕←'' 68 | ⎕←'Version information:' 69 | versionInfo←⎕SE.UCMD'tools.version' 70 | ⎕←versionInfo 71 | :EndIf 72 | 73 | :If verbose 74 | ⎕←'Options:' 75 | ⎕←(6⍴' '),'verbose:',verbose 76 | ⎕←(6⍴' '),'stop:',stop ⋄ ⎕←'' 77 | :EndIf 78 | :EndSection 79 | 80 | ⍝ 0 is used to generate a random seed value and the random value is the noted in the logs 81 | ⍝ all test namespaces have the same ⎕RL value supplied at the start of the tests 82 | (#.testfns({⍎'#.tests.',⍵}¨#.tests.⎕NL ¯9.1)).⎕RL←rl←{⍵≡0:?¯2+2*31 ⋄ ⍵}randLink 83 | 84 | :Section FetchTests 85 | tests←GetTests testNS 86 | 'no tests found'⎕SIGNAL(~(0=≢tests))↓11 87 | :EndSection 88 | 89 | r←⍬ 90 | :For rep :In ⍳reps 91 | r,←rep ExecuteTests tests 92 | :EndFor 93 | 94 | :Section EvalResult 95 | nPass←(+/,)r ⋄ nFail←(≢r)-nPass 96 | :If ~prod∧(nPass≡≢r) 97 | ⎕←'' ⋄ ⎕←'All tests completed for',testNS,':',reps'repetitions,','total tests:',(≢r),'ran,',nFail,'failed test,',nPass,'successes in',((⎕AI[2]-time)÷1000),'s' ⋄ ⎕←'' 98 | :EndIf 99 | z←nPass≡≢r 100 | :EndSection 101 | ∇ 102 | 103 | :EndNamespace 104 | -------------------------------------------------------------------------------- /tests/_relational.apln: -------------------------------------------------------------------------------- 1 | :Namespace _relational 2 | ⎕IO←0 3 | ⍝ Shared code between the relational primitives: dyadic <≤≥>=≠ 4 | 5 | ∇ r←x model_equal y 6 | :Trap 0 7 | :Select #.iso_defs.Type¨x y 8 | :Case 'numeric' 'numeric' 9 | r←x #.iso_defs.(ComparisonTolerance TolerantlyEqual)y 10 | :Case 'character' 'character' 11 | r←x≡y 12 | :Case 'object' 'object' ⍝ Not in the ISO standard 13 | r←x≡y 14 | :Else 15 | r←0 16 | :EndSelect 17 | :Else 18 | r←¯1 19 | :EndTrap 20 | ∇ 21 | 22 | ∇ r←x model_less_than y 23 | :Trap 0 24 | x←#.iso_defs.NearestRealNumber x 25 | y←#.iso_defs.NearestRealNumber y 26 | :If x model_equal y 27 | r←0 28 | :ElseIf x #.iso_defs.LessThan y 29 | r←1 30 | :Else 31 | r←0 32 | :EndIf 33 | :Else 34 | r←¯1 35 | :EndTrap 36 | ∇ 37 | 38 | ∇ r←x model_greater_than y 39 | :Trap 0 40 | x←#.iso_defs.NearestRealNumber x 41 | y←#.iso_defs.NearestRealNumber y 42 | :If x model_equal y 43 | r←0 44 | :ElseIf x #.iso_defs.GreaterThan y 45 | r←1 46 | :Else 47 | r←0 48 | :EndIf 49 | :Else 50 | r←¯1 51 | :EndTrap 52 | ∇ 53 | 54 | ∇ r←x(ns relational_model)y;empty;max;min;sameShape;shapes;single 55 | #.iso_defs.SetupSysvars ⎕THIS 56 | r←x(model_less_than,model_equal,model_greater_than)y 57 | 58 | (min max)←1 59 | :If ¯1∊r 60 | min←0 61 | :EndIf 62 | 63 | ⍝ Check that the computed results make sense 64 | :If {(⍵max}+⌿1=r 65 | ⎕SIGNAL 16 ⍝ NONCE ERROR 66 | :EndIf 67 | 68 | ⍝ Check if the results from the less_than, equal and greater_than tests match the expected pattern 69 | ⍝ for the given primitive. See the tests that use this module for examples. 70 | r←(⊂r)∊ns.patterns 71 | 72 | :If ns.error∧(min=0)∧~r ⍝ there was an error 73 | ⎕SIGNAL 11 ⍝ DOMAIN ERROR 74 | :EndIf 75 | ∇ 76 | 77 | ∇ {r}←test_relational ns;Chars;Ints;caselist;ct;data;data_bool;data_bool_0;data_bool_0_special;data_bool_1;data_bool_1_special;data_char1;data_char2;data_char4;data_complex;data_float;data_int1;data_int2;data_int4;data_real;data_ref1;data_ref2;data_refs;fr;model;prim;primSymb;quadparams;runVariations;testDesc;testName;x;y 78 | r←⍬ 79 | model←(ns relational_model)#.iso_defs.ScalarExtensionOperator 80 | prim←ns.primitive 81 | primSymb←⍕⎕OR'ns.primitive' 82 | runVariations←model #.testfns._RunVariationsWithModel_ prim 83 | testName←ns.description,' (',primSymb,')' 84 | Ints←#.random.Ints 85 | Chars←#.random.Chars 86 | 87 | :For fr :In #.utils.(fr_dbl fr_decf) 88 | ns.⎕FR←⎕FR←fr 89 | :For ct :In 0 1 10 0.1 90 | ns.(⎕CT ⎕DCT)←(⎕CT ⎕DCT)←ct×#.utils.(ct_default dct_default) 91 | 92 | quadparams←⎕CT ⎕DCT ⎕FR ⎕IO ⎕DIV 93 | testDesc←'with (⎕FR ⎕CT ⎕DCT)≡(',(⍕⎕FR ⎕CT ⎕DCT),')' 94 | 95 | data_int1←100 Ints 8 96 | data_int2←100 Ints 16 97 | data_int4←100 Ints 32 98 | data_char1←100 Chars 8 99 | :If ~#.utils.isClassic 100 | data_char2←100 Chars 16 101 | data_char4←100 Chars 32 102 | :EndIf 103 | 104 | data_real←?100⍴0 105 | 106 | data_complex←(?100⍴0){⍺+0J1×⍵}?100⍴0 107 | 108 | data_ref1←# 109 | data_ref2←⎕DMX 110 | data_refs←⎕NS¨⍬ ⍬ ⍬ 111 | 112 | data_bool←0 1 113 | data_bool_1←1 114 | data_bool_0←0 115 | data_bool_1_special←=⌿0 0 116 | data_bool_0_special←≠⌿0 0 117 | 118 | caselist←⎕NL ¯2 119 | caselist←caselist⌿⍨{'data_'⊃⍤⍷⍵}¨caselist 120 | 121 | :For x :In caselist 122 | x←⎕VGET x 123 | :For y :In caselist 124 | y←⎕VGET y 125 | r,←testName testDesc quadparams runVariations x y 126 | :EndFor 127 | :EndFor 128 | :EndFor 129 | :EndFor 130 | ∇ 131 | :EndNamespace 132 | -------------------------------------------------------------------------------- /contributing.md: -------------------------------------------------------------------------------- 1 | # Contributing Guide 2 | 3 | We welcome contributions from anyone, even if you are new to open source. We will help you with any technical issues and help improve your contribution so that it can be merged. 4 | 5 | Every small change of refactoring, documentation, code commenting, questions, suggestions, adding a test, adding a primitive makes the project better and will help making Dyalog APL bug free. 𓆣 6 | 7 | ## Rules followed 8 | 9 | ### File formatting 10 | 11 | Reformat settings in ride should be "handle formatting: through the interpreter" which can be found under the Trace/Edit section of the preferences. 12 | 13 | ## Code coverage checks 14 | 15 | All PRs that introduce tests for a new primitives should ensure that they have checked for Code Coverage. (This is something people from Dyalog will be able to see, you can let the maintainers know if you have written tests and want somebody else to look at the code coverage) 16 | 17 | ## Basic Setup 18 | 19 | To contribute, make sure you set up: 20 | 21 | - Your username + email 22 | - Your ~/.gitconfig 23 | - Dyalog (preferably version >v18.2) 24 | 25 | ### Fork ullu 26 | 27 | Step 1. Create a fork of the project repository 28 | 29 | Step 2. Clone the project repository from GitHub and set up your remote repository 30 | 31 | ``` 32 | git clone https://github.com/dyalog/ullu.git 33 | cd ullu 34 | git remote add REMOTE_NAME https://github.com/YOUR_GITHUB_USERNAME/ullu.git 35 | ``` 36 | 37 | `REMOTE_NAME` is the name of your remote repository and could be any name you like, for example, your first name. 38 | 39 | `YOUR_GITHUB_USERNAME` is your username on GitHub and should be part of your account path. 40 | 41 | You can use `git remote -v` to check if the new remote is set up correctly. 42 | 43 | ## Sending a Pull Request/Merge Request 44 | 45 | Step 1. Create a new branch 46 | 47 | ``` 48 | git checkout -b fix1 49 | ``` 50 | 51 | Step 2. Make changes in the relevant file(s) 52 | 53 | Step 3. Commit the changes 54 | 55 | ``` 56 | git add FILE1 (FILE2 ...) 57 | git commit -m "YOUR_COMMIT_MESSAGE" 58 | ``` 59 | 60 | [Here](https://cbea.ms/git-commit/) are some great tips on writing good commit messages. 61 | 62 | Step 4. Check to ensure that your changes look good 63 | ``` 64 | git log --pretty=oneline --graph --decorate --all 65 | ``` 66 | 67 | Step 5. Send the pull request 68 | ``` 69 | git push REMOTE_NAME fix1 70 | ``` 71 | 72 | The command will push the new branch `fix1` into your remote repository `REMOTE_NAME` that you created earlier. Additionally, it will also display a link that you can click on to open the new pull request. After clicking on the link, write a title and a concise description then click the “Create” button. 73 | 74 | Yay! Now, you are all set. ٩(ˊᗜˋ*)و 75 | 76 | ## Contributing Code 77 | 78 | ### Adding a primitive 79 | 80 | A primitive is a built-in function or operator which is a core part of the language. It is represented by a glyph, which it may share with another primitive. More information [here](https://aplwiki.com/wiki/Primitive) 81 | 82 | Ullu tests the primitives one by one, covering all the code written in the sources of Dyalog APL, all possible cases, including edge cases, and all types of inputs it can receive. 83 | 84 | 85 | A workflow demonstration blog on how to write tests is present in [docs/how-to-add-tests.md](docs/how-to-add-tests.md) 86 | 87 | ## Contributing Docs 88 | 89 | ### Decision docs 90 | 91 | 92 | Decision Docs are records for detailing key decisions, fostering transparency and aiding future collaboration by providing a structured account of the decision-making process. Documenting why certain decisions were taken in the codebase, they explain the mindset of the developer writing the tests and also help document any anomalies in the codebase. 93 | 94 | It can be found [here](docs/decision) 95 | 96 | 97 | In the decision docs, you need to mention the types of test cases included in the tests, a description of all the variations of the tests, and all the edge cases that were faced/handled. It needs to have all the information that a person in the future would need to expand on the same tests or write new related ones. 98 | 99 | 100 | Decision docs for the primitive Magnitude are a good example of this. They can be found [here](docs/decision/primitive-functions/scalar-monadic.md#magnitude-rydocs) 101 | 102 | --- 103 | 104 | Note: By submitting a PR you agree to license your contribution under the ullu’s MIT [license](LICENSE) unless explicitly noted otherwise. 105 | -------------------------------------------------------------------------------- /random.apln: -------------------------------------------------------------------------------- 1 | :Namespace random 2 | ⍝ This namespace contains functions for generating random 3 | ⍝ data of different APL types. 4 | 5 | ∇ r←{bounds}VariationOf data;IntBounds;type 6 | ⍝ Generate an array of the same structure and element type as 'data', 7 | ⍝ but with random elements. The optional left argument can be used 8 | ⍝ to specify a lower and upper bound for the generated data, but 9 | ⍝ it only works when the data is numeric. 10 | ⍝ For nested arrays, the function will generate random variations 11 | ⍝ of the nested elements as well. 12 | ⍝ Note that ⎕DR of the result array might show a different 13 | ⍝ type than expected, if all the random values happen to be small enough 14 | ⍝ to fit into a smaller element type. 15 | 16 | type←#.iso_defs.Type data 17 | :If (type≢'numeric')∧0≠⎕NC'bounds' 18 | 'Bounds can only be specified for numeric arrays'⎕SIGNAL 11 19 | :EndIf 20 | 21 | :Select type 22 | :Case 'numeric' 23 | :If 0=⎕NC'bounds' 24 | bounds←#.utils.NumericMinMax ⎕DR data 25 | :EndIf 26 | r←(⍴data)BoundedNumeric bounds 27 | :Case 'character' 28 | r←(⍴data)Character ⎕DR data 29 | :Case 'mixed' 30 | r←VariationOf¨data 31 | :Case 'object' 32 | r←data ⍝ We don't generate random objects 33 | :Else 34 | 'Missing case'⎕SIGNAL 11 35 | :EndSelect 36 | ∇ 37 | 38 | ∇ r←shape BoundedNumeric(min max);imaginaryParts;neg;negMask;negPct;pos;range;realParts;scaledMax;scaledMin;smallFloats;type;⎕FR;⎕IO 39 | ⎕IO←0 40 | type←⎕DR min max 41 | :Select type 42 | :CaseList 11 83 163 323 43 | r←min+?shape⍴1+max-min 44 | :CaseList 645 1287 45 | ⎕FR←type 46 | smallFloats←?shape⍴0 ⍝ small floats in the range 0 to 1 47 | :Select ×min max 48 | :CaseList (¯1 ¯1)(0 1)(1 1) ⍝ Either all negative, or all non-negative 49 | r←min+smallFloats×max-min 50 | :CaseList (¯1 0)(¯1 1) ⍝ from negative to non-negative 51 | ⍝ Since the calculation of max-min might fail due to the size 52 | ⍝ of the numbers, compute the negative and positive parts separately 53 | (scaledMin scaledMax)←min max÷10 54 | negPct←(|scaledMin)÷scaledMax-scaledMin 55 | negMask←negPct>?shape⍴0 56 | r←0 57 | r+←min×smallFloats×negMask 58 | r+←max×smallFloats×~negMask 59 | :Else 60 | 'Missing case'⎕SIGNAL 11 61 | :EndSelect 62 | :Case 1289 63 | ⍝ Generate the real and imaginary parts independently 64 | ⍝ NOTE: this might not be the best way to generate 65 | ⍝ complext number within some bound. 66 | realParts←shape BoundedNumeric 9○min max 67 | imaginaryParts←shape BoundedNumeric 11○min max 68 | r←realParts+¯11○imaginaryParts 69 | :Else 70 | 'Missing case'⎕SIGNAL 11 71 | :EndSelect 72 | 73 | ⍝ Since some of the calculations above might be incorrect 74 | ⍝ due to rounding, remove the elements out of range, and 75 | ⍝ reshape the remaining elements 76 | :If 1289≠⎕DR r ⍝ don't do it for complex numbers 77 | r←,r 78 | r←r⌿⍨(r≥min)∧(r≤max) 79 | r←shape⍴r 80 | :EndIf 81 | ∇ 82 | 83 | ∇ r←shape Character eltype;max;⎕IO 84 | ⎕IO←0 85 | :Select eltype 86 | :CaseList 80 160 320 ⍝ unicode chars 87 | max←1114111 ⍝ Maximum unicode code point value 88 | max⌊←¯1+2*eltype÷10 89 | r←⎕UCS shape BoundedNumeric 0 max 90 | :Case 82 ⍝ Classic chars 91 | r←⎕AV⌷⍨⊂shape BoundedNumeric 0 255 92 | :Else 93 | 'Missing case'⎕SIGNAL 11 94 | :EndSelect 95 | ∇ 96 | 97 | ∇ r←count Chars bits;eltype;isClassic;validBits 98 | ⍝ Produce a vector of 'count' random characters of bit-size 'bits' 99 | isClassic←#.utils.isClassic 100 | :If isClassic 101 | validBits←8 102 | :Else 103 | validBits←8 16 32 104 | :EndIf 105 | 106 | :If bits∊validBits 107 | eltype←(2×isClassic)+bits×10 108 | r←count Character eltype 109 | :Else 110 | 'Unexpected character size'⎕SIGNAL 11 111 | :EndIf 112 | ∇ 113 | 114 | ∇ r←count Ints bits;type 115 | ⍝ Produce a vector of 'count' random integers of bit-size 'bits'. 116 | :Select bits 117 | :CaseList 8 16 32 118 | r←VariationOf count⍴2*bits-2 119 | :Else 120 | 'Unexpected integer size'⎕SIGNAL 11 121 | :EndSelect 122 | ∇ 123 | 124 | 125 | :EndNamespace 126 | -------------------------------------------------------------------------------- /tests/magnitude.apln: -------------------------------------------------------------------------------- 1 | ⍝ This Namespace includes tests for the function Magnitude which is represented by Monadic stile(|) 2 | ⍝ 3 | ⍝ Magnitude: 4 | ⍝ Y may be any numeric array. R is numeric composed of the absolute (unsigned) values of Y. 5 | ⍝ Note that the magnitude of a complex number a+⍳b is defined to be (a^2+b^2)*(÷2). 6 | :Namespace magnitude 7 | Assert←#.unittest.Assert 8 | isDyalogClassic←#.utils.isClassic 9 | 10 | modelMag←{⍵×(¯1@(∊∘0)(⍵>0))} 11 | modelMagCmplx←{0.5*⍨+.×⍨9 11○⍵} 12 | 13 | ∇ {r}←test_magnitude_general;RunVariations;bool;i1;i2;i3;dbl;fl;Hdbl;Hfl;fr_dbl;fr_decf;case;data;d;testDesc;desc;fr;⎕FR;Sdbl;Sfl;char0;char1;char2;char3;charptr;c1;f;Message 14 | ⍝ use RunVariations operator and modify it for non-cmplx magnitude 15 | RunVariations←(modelMag #.testfns._RunVariations_|) 16 | 17 | fr_dbl←#.utils.fr_dbl 18 | fr_decf←#.utils.fr_decf 19 | 20 | bool←0 1 ⍝ 11: 1 bit Boolean type arrays 21 | i1←{⍵,-⍵}⍳120 ⍝ 83: 8 bits signed integer 22 | i2←{⍵,-⍵}10000+⍳1000 ⍝ 163: 16 bits signed integer 23 | i3←{⍵,-⍵}100000+⍳100 ⍝ 323: 32 bits signed integer 24 | 25 | char0←⎕AV ⍝ 82: DyalogAPL classic char set 26 | :If ~isDyalogClassic 27 | char1←⎕UCS⍳255 ⍝ 80: 8 bits character 28 | char2←⎕UCS(1000+⍳100) ⍝ 160: 16 bits character 29 | char3←⎕UCS(100000+⍳100) ⍝ 320: 32 bits character 30 | :EndIf 31 | charptr←2,/⎕A ⍝ 326: Pointer (32-bit or 64-bit as appropriate) 32 | 33 | dbl←{⍵,-⍵}1000.5+⍳100 ⍝ 645: 64 bits Floating 34 | ⍝ Hdbl and Sdbl is 645 but larger and smaller numbers 35 | Hdbl←{⍵,-⍵}100000000000000+(2×⍳50) 36 | Sdbl←{⍵,-⍵}(⍳10)×1E¯40 37 | 38 | ⍝ Hfl and Sfl is 1287 but larger and smaller numbers 39 | ⎕FR←fr_decf ⍝ use ⎕FR=1287 40 | fl←{⍵,-⍵}1000.5+⍳100 ⍝ 1287: 128 bits Decimal 41 | Hfl←{⍵,-⍵}200000000000000000000000000000+(10000000000000000×⍳10) 42 | Sfl←{⍵,-⍵}(⍳10)×1E¯40 43 | ⎕FR←fr_dbl ⍝ revert ⎕FR=645 44 | 45 | r←⍬ 46 | testDesc←{'for ',case,' & ⎕FR:',⎕FR} 47 | 48 | :For fr :In 1 2 49 | ⎕FR←fr⊃fr_dbl fr_decf 50 | 51 | quadparams←⎕CT ⎕DCT ⎕FR ⎕IO ⎕DIV 52 | 53 | :For case :In 'bool' 'i1' 'i2' 'i3' 'dbl' 'Hdbl' 'Sdbl' 'fl' 'Hfl' 'Sfl' 54 | data←⍎case 55 | desc←testDesc ⍬ 56 | :If case≢'bool' 57 | r,←'T1'desc quadparams RunVariations({(⊣,⊣)((≢⍵)÷2)↑⍵}data)data ⍝ all positive values are chosen 58 | r,←'T2'desc quadparams RunVariations(modelMag data)data ⍝ custom func finds results on array 59 | r,←'T3'desc Assert(modelMag¨(data data))≡(|data data) ⍝ test on pointer array 60 | 61 | d←data[?≢data] 62 | r,←'T4'desc quadparams RunVariations(modelMag d)d ⍝ custom func finds results on single element 63 | :Else 64 | r,←'Tb1'desc quadparams RunVariations(0 1)bool 65 | r,←'Tb2'desc quadparams RunVariations 0(⊃bool) 66 | :EndIf 67 | :EndFor 68 | 69 | case←'for limits of i4' ⍝ 32-bit int range [¯2147483648, 2147483647]. Therefore, |¯2147483648 is stored as float. 70 | desc←testDesc ⍬ 71 | r,←'tLim1'desc quadparams RunVariations(,2147483648)(,¯2147483648) 72 | r,←'tLim2'desc quadparams RunVariations(,2147483648,modelMag i1)(¯2147483648,i1) ⍝ Rarg to | will have the same type, and similarly the elements in the result will do as well. 73 | 74 | case←'for singleton scalar boolean' ⍝ edge case for when a singleton scalar boolean is passed as rarg to magnitude. 75 | desc←testDesc ⍬ 76 | r,←'tb3'desc quadparams RunVariations(∧/1 0 1 0)(|∧/1 0 1 0) ⍝ | is applied here becuase of type conversion when argument is passed to RunVariations 77 | 78 | ⍝ tests for known errors 79 | :For case :In 'char0' 'char1' 'char2' 'char3' 'charptr' 80 | :If (isDyalogClassic)∧(case≢'char0')∧(case≢'charptr') 81 | :Continue ⍝ Skip tests for unicode character sets in DyalogAPL classic 82 | :EndIf 83 | data←⍎case 84 | desc←testDesc ⍬ 85 | c1←data[?≢data] 86 | 87 | f←0 ⍝ flag 88 | :Trap 11 ⍝ 11: Domain error 89 | |c1 90 | :Else 91 | f←1 92 | :EndTrap 93 | r,←'TDomainE1'desc Assert(f∧⎕DMX.Message≡'') 94 | :EndFor 95 | :EndFor 96 | ∇ 97 | 98 | 99 | ∇ {r}←test_magnitude_cmplx;RunVariations;cmplx;Hcmplx;d;case;data;testDesc;desc;i1;fr_dbl;fr_decf;fr;⎕FR 100 | ⍝ use RunVariations operator and modify it for cmplx magnitude 101 | RunVariations←(modelMagCmplx #.testfns._RunVariations_|) 102 | 103 | i1←{⍵}⍳120 ⍝ 83: 8 bits signed integer 104 | cmplx←{(-⍵),⍵,(+⍵),(-+⍵)}(0J1×⍳100)+⌽⍳100 ⍝ 1289: 128 bits Complex 105 | Hcmplx←{(-⍵),⍵,(+⍵),(-+⍵)}(10000000000000J10000000000000×⍳20) ⍝ 1289 but larger numbers 106 | ⍝ DECF in cmplx numbers are not recommended to be used by the docs 107 | fr_dbl←645 108 | fr_decf←1287 109 | 110 | r←⍬ 111 | testDesc←{'for ',case} 112 | 113 | :For fr :In 2 1 114 | ⎕FR←fr⊃fr_dbl fr_decf 115 | quadparams←⎕CT ⎕DCT ⎕FR ⎕IO ⎕DIV 116 | case←'cmplx with non-cmplx nums with ⎕fr',⎕FR ⍝ Z (complex) argument and DF (DECF float) result. Magnitude, when applied to complex, gives a non-complex result. 117 | desc←testDesc ⍬ 118 | r,←'TcI1'desc quadparams RunVariations(,5,i1)(,3J4,i1) ⍝ using a fixed number because DECF in cmplx numbers are not recommended to be used by the docs and produced uncertain results 119 | :EndFor 120 | 121 | :For case :In 'cmplx' 'Hcmplx' 122 | quadparams←⎕CT ⎕DCT ⎕FR ⎕IO ⎕DIV 123 | data←⍎case 124 | desc←testDesc ⍬ 125 | r,←'Tc1'desc quadparams RunVariations(modelMagCmplx¨data)data 126 | r,←'Tc2'desc Assert(modelMagCmplx¨¨(data data))≡(|data data) ⍝ test on pointer array 127 | :For d :In data 128 | case←d 129 | desc←testDesc ⍬ 130 | r,←'Tc2'desc quadparams RunVariations(modelMagCmplx d)d 131 | :EndFor 132 | :EndFor 133 | ∇ 134 | :EndNamespace 135 | -------------------------------------------------------------------------------- /testfns.apln: -------------------------------------------------------------------------------- 1 | :Namespace testfns 2 | Assert←#.unittest.Assert 3 | 4 | ⍝ Run the operand function and return either (1 Rslt) or (0 (⎕DMX.EN Message)) 5 | runOrErr←{ 6 | 0::⊂0 ⎕DMX.EN ⍝ We should care about the ⎕DMX message, but that is hard to model, so we don't. 7 | ⍺←⊢ 8 | ⊂1(⍺ ⍺⍺ ⍵) 9 | } 10 | 11 | ⍝ isCurrentlyRunning checks what test is running and returns a 1 12 | ⍝ if the test mentioned in ⍵ is running, to simplify the if case 13 | ⍝ in _RunVariations_ to skip part of the test for certain primitives. 14 | isCurrentlyRunning←{∨/⊃,/{∨/⍵⍷↑#.unittest.tests}¨⍵} 15 | 16 | ⍝ tests that don't use this are: 17 | ⍝ use a different runvariations: 18 | ⍝ - unique 19 | ⍝ - uniquemask 20 | ⍝ - indexof 21 | ⍝ - membership 22 | 23 | ⍝ Run Variations of each test with normal, empty and multiple shaped data 24 | ∇ {tRes}←tData(model _RunVariations_ op)exp;actualR;actualRE;actualRS;actualRSW0;expectedR;larg;nlarg;nrarg;randr;rarg;shape;shapeW0;skipRandom;tCmt;tID;trimmedrarg;val;⎕CT;⎕DCT;⎕DIV;⎕FR;⎕IO 25 | :If 3≡≢exp ⍝ dyadic op 26 | val←2 ⍝ valence 27 | (expectedR larg rarg)←exp 28 | :Else ⍝ monadic op 29 | val←1 30 | (expectedR rarg)←exp 31 | :EndIf 32 | (tID tCmt quadparams)←tData 33 | ⎕CT ⎕DCT ⎕FR ⎕IO ⎕DIV←quadparams 34 | tRes←⍬ 35 | 36 | ⍝ normal 37 | actualR←{val≡2:larg op rarg ⋄ op rarg}⍬ 38 | tRes,←(tID tCmt)Assert expectedR≡actualR 39 | 40 | :If val≡1 41 | ⍝ scalar 42 | randr←?≢rarg 43 | trimmedrarg←randr↓rarg ⍝ so that not always the first is selected 44 | shape←⍬ ⍝ scalar shape 45 | actualRS←op shape⍴trimmedrarg 46 | tRes,←('Scalar',tID)tCmt Assert(shape⍴randr↓expectedR)≡actualRS 47 | :EndIf 48 | 49 | ⍝ empty 50 | actualRE←{val≡2:(0⍴larg)op(0⍴rarg) ⋄ op(0⍴rarg)}⍬ ⍝ 0 in the shape means we have no elements in the array, i.e. it's empty. 51 | tRes,←('EmptyL',tID)tCmt Assert ⍬≡actualRE ⍝ empty array is expectedR 52 | 53 | ⍝ different shapes 54 | shape←?(?4)/4 55 | actualRS←{val≡2:(shape⍴larg)op(shape⍴rarg) ⋄ op(shape⍴rarg)}⍬ 56 | tRes,←('Multiple',tID)tCmt Assert(shape⍴expectedR)≡actualRS 57 | 58 | ⍝ different shapes with 0 in shape 59 | shapeW0←(0@(?(≢shape)))shape 60 | actualRSW0←{val≡2:(shapeW0⍴larg)op(shapeW0⍴rarg) ⋄ op(shapeW0⍴rarg)}⍬ 61 | tRes,←('ShapeW0',tID)tCmt Assert(shapeW0⍴0)≡actualRSW0 62 | 63 | ⍝ testing larg and rarg specifically from model 64 | tRes,←('ModelTest',tID)tCmt Assert({val≡2:(larg model rarg)≡larg op rarg ⋄ (model¨rarg)≡op rarg}⍬) 65 | 66 | ⍝ This test creates a random element based on the datatype of the rarg and larg 67 | ⍝ it is then tested using models of the function. 68 | ⍝ The purpose of this test is to use the entire range of the datatype so a dataset 69 | ⍝ is generated in the longer run to test more data. 70 | ⍝ 71 | ⍝ skipping big rand test for mentioned primitives because of issues with the model 72 | skipRandom←0 73 | skipRandom∨←isCurrentlyRunning'residue' 'floor' 'multiply' 'divide' 74 | skipRandom∨←(1289 1287∊⍨⎕DR rarg)∧isCurrentlyRunning'magnitude' 75 | :If ~skipRandom 76 | nrarg←#.random.VariationOf rarg 77 | :If val=2 78 | nlarg←#.random.VariationOf larg 79 | :EndIf 80 | 81 | 82 | :If val=2 83 | actualR←nlarg(op runOrErr)nrarg 84 | expectedR←nlarg(model runOrErr)nrarg 85 | :Else 86 | actualR←(op runOrErr)nrarg 87 | expectedR←(model runOrErr)nrarg 88 | :EndIf 89 | tRes,←('RandModelTest',tID)tCmt Assert expectedR≡actualR 90 | :EndIf 91 | 92 | ⍝ todo: 93 | ⍝ new variations needs more tests of: 94 | ⍝ lengths of arrays from 1 to 10000 95 | ⍝ and 96 | ⍝ of kind 97 | ⍝ scalar 98 | ⍝ vector 99 | ⍝ tall matrix, 11-column matrix with 10*0 1 2 4 rows 100 | ⍝ wide matrix, 11-row matrix with 10*0 1 2 4 columns 101 | ⍝ square matrix with ⌈10*0 1 2 4×0.6 (1 4 16 252) rows/columns 102 | ∇ 103 | 104 | ⍝ Run Variations of each test with normal, empty and multiple shaped data. 105 | ⍝ This operator is similar to _RunVariations_, but runs the model function and compares 106 | ⍝ the produced result/error messages with the primitive. 107 | ∇ {tRes}←spec(rawModel _RunVariationsWithModel_ rawOp)args;ChkEqual;Eval;quadparams;shape;tCmt;tID;⎕CT;⎕DCT;⎕DIV;⎕FR;⎕IO 108 | tRes←⍬ 109 | (tID tCmt quadparams)←spec 110 | ⎕CT ⎕DCT ⎕FR ⎕IO ⎕DIV←quadparams 111 | 112 | ⍝ Run the operand function either monadically or dyadically, depending on the 113 | ⍝ argument to _RunVariationsWithModel_ 114 | Eval←{ 115 | 2=≢args:⍺ ⍺⍺ ⍵ 116 | 1=≢args:⍺⍺ ⍵ 117 | ⎕SIGNAL 5 ⍝ length error 118 | } 119 | 120 | ⍝ run a transformation function (⍺⍺) on both arguments, 121 | ⍝ and then compare the result produced by the model and 122 | ⍝ the primitive, when the transformed arguments are applied. 123 | ⍝ This checks that the model produces the expected results 124 | ⍝ and the expected error messages. 125 | ChkEqual←{ 126 | (larg rarg)←2⍴⍺⍺¨args 127 | model←rawModel runOrErr 128 | op←rawOp runOrErr 129 | expected←larg model Eval rarg 130 | actual←larg op Eval rarg 131 | tRes,←(tID,' - ',⍵)tCmt Assert expected≡actual 132 | } 133 | 134 | ⍝ Base test: check that the function behaves as the model with the provided data 135 | {⍵}ChkEqual'Base' 136 | 137 | ⍝ scalar test: Pick a random item and check. 138 | {⍵[⊂?⍴⍵]}ChkEqual'RandomScalar' 139 | 140 | ⍝ Empty test: check that the function behaves as the model when given an empty vector of the given type. 141 | {0⍴⍵}ChkEqual'Empty' 142 | 143 | ⍝ High rank test: generate a random shape, and check. 144 | shape←{⎕IO←1 ⋄ ?(?⍵)/⍵}4 145 | {shape⍴⍵}ChkEqual'RandomHighRank' 146 | 147 | ⍝ High rank with 0 in shape test 148 | shape[?≢shape]←0 149 | {shape⍴⍵}ChkEqual'RandomEmptyHighRank' 150 | 151 | ⍝ Random data test: 152 | ⍝ This test creates a random element based on the datatype of the rarg and larg 153 | ⍝ it is then tested using models of the function. 154 | ⍝ The purpose of this test is to use the entire range of the datatype so a dataset 155 | ⍝ is generated in the longer run to test more data. 156 | 157 | #.random.VariationOf ChkEqual'RandModelTest' 158 | 159 | ⍝ todo: 160 | ⍝ new variations needs more tests of: 161 | ⍝ lengths of arrays from 1 to 10000 162 | ⍝ and 163 | ⍝ of kind 164 | ⍝ scalar 165 | ⍝ vector 166 | ⍝ tall matrix, 11-column matrix with 10*0 1 2 4 rows 167 | ⍝ wide matrix, 11-row matrix with 10*0 1 2 4 columns 168 | ⍝ square matrix with ⌈10*0 1 2 4×0.6 (1 4 16 252) rows/columns 169 | ∇ 170 | :EndNamespace 171 | -------------------------------------------------------------------------------- /iso_defs.apln: -------------------------------------------------------------------------------- 1 | :Namespace iso_defs 2 | ⍝ This namespace contains definitions from 3 | ⍝ the Extended APL ISO standard (ISO/IEC 13751:2001) 4 | 5 | ⍝ Every function or value is defined within 6 | ⍝ a :Section with the corresponding section number, 7 | ⍝ which makes it easier to find what we are looking 8 | ⍝ for. 9 | 10 | :Section Utils 11 | ∇ SetupSysvars ns 12 | ⍝ Set system variables in the iso_defs namespace, to their 13 | ⍝ values in the argument namespace. 14 | ⍝ This function MUST be called before using any of the 15 | ⍝ iso_defs functions, as some of them depend on the current 16 | ⍝ system variable values. 17 | (⎕CT ⎕DCT ⎕FR ⎕IO)←ns.(⎕CT ⎕DCT ⎕FR ⎕IO) 18 | ∇ 19 | :EndSection 20 | 21 | :Section 5.2.3 22 | ∇ r←IsBoolean A 23 | r←∨/A∘.Equals 0 1 24 | ∇ 25 | 26 | ∇ r←RealPart n 27 | r←9○n 28 | ∇ 29 | 30 | ∇ r←ImaginaryPart n 31 | r←11○n 32 | ∇ 33 | 34 | ∇ r←x SameHalfPlane y;imaginary_parts;real_parts 35 | real_parts←×RealPart¨x y 36 | imaginary_parts←×ImaginaryPart¨x y 37 | :If (0≠⊃real_parts)∧=⌿real_parts 38 | r←1 39 | :ElseIf (0≠⊃imaginary_parts)∧=⌿imaginary_parts 40 | r←1 41 | :Else 42 | r←0 43 | :EndIf 44 | ∇ 45 | :EndSection 46 | 47 | :Section 5.2.5 48 | 49 | ∇ r←A Equals B 50 | r←A≡⍥(11∘⎕DR)B 51 | ∇ 52 | 53 | ∇ r←A GreaterThan B;⎕CT;⎕DCT 54 | (⎕CT ⎕DCT)←0 55 | :If (A>0)∧(B<0) 56 | r←1 57 | :Else 58 | :Trap 11 59 | :If (A-B)>0 60 | r←1 61 | :Else 62 | r←0 63 | :EndIf 64 | :Else 65 | ⍝ Getting a DOMAIN ERROR from A-B means 66 | ⍝ their difference isn't representable. 67 | r←0 68 | :EndTrap 69 | :EndIf 70 | ∇ 71 | 72 | ∇ r←A LessThan B 73 | r←B GreaterThan A 74 | ∇ 75 | 76 | ∇ r←Magnitude A 77 | r←|A 78 | ∇ 79 | 80 | ∇ r←A LargerMagnitude B 81 | A←Magnitude A 82 | B←Magnitude B 83 | :If A GreaterThan B 84 | r←A 85 | :Else 86 | r←B 87 | :EndIf 88 | ∇ 89 | 90 | ∇ r←A DistanceBetween B 91 | r←Magnitude A-B 92 | ∇ 93 | 94 | ∇ r←A(C TolerantlyEqual)B;_;distance;max_distance 95 | :If C<0 96 | ⎕SIGNAL 11 ⍝ DOMAIN ERROR 97 | :EndIf 98 | 99 | :If A Equals B 100 | r←1 101 | :Return 102 | :EndIf 103 | 104 | :If ~A SameHalfPlane B 105 | r←0 106 | :Return 107 | :EndIf 108 | 109 | :Trap 11 110 | distance←A DistanceBetween B 111 | :Else 112 | ⍝ If the distance calculation failed with a DOMAIN ERROR, they 113 | ⍝ must be so far apart that their differences is not representable. 114 | ⍝ Therefore, they are not equal. -- This is not in the ISO standard. 115 | r←0 116 | :Return 117 | :EndTrap 118 | 119 | max_distance←(C×A)LargerMagnitude(C×B) 120 | :If (distance LessThan max_distance)∨distance Equals max_distance 121 | r←1 122 | :Else 123 | r←0 124 | :EndIf 125 | ∇ 126 | 127 | ∇ r←B TolerantFloor A;⎕CT;⎕DCT 128 | (⎕CT ⎕DCT)←B 129 | r←⌊A 130 | ∇ 131 | 132 | ∇ r←B IntegralWithin A;F1;F2 133 | :If 0∊⍴A 134 | r←(⍴A)⍴0 135 | :Return 136 | :EndIf 137 | 138 | F1←B TolerantFloor¨-A 139 | F2←-B TolerantFloor¨A 140 | r←F1 Equals F2 141 | ∇ 142 | 143 | ∇ r←NearInteger data 144 | r←IntegerTolerance IntegralWithin data 145 | ∇ 146 | 147 | ∇ r←NearBoolean data 148 | :If ∧⌿∊NearInteger data 149 | r←IsBoolean IntegerNearestTo data 150 | :Else 151 | r←0 152 | :EndIf 153 | ∇ 154 | 155 | ∇ r←IntegerNearestTo data 156 | r←IntegerTolerance TolerantFloor data 157 | ∇ 158 | 159 | ∇ r←A RealWithin B;I;R 160 | R←Magnitude RealPart A 161 | I←Magnitude ImaginaryPart A 162 | r←∨⌿I(LessThan∨Equals)¨B(R×B) 163 | ∇ 164 | 165 | ∇ r←NearReal A 166 | r←A RealWithin RealTolerance 167 | ∇ 168 | 169 | ∇ r←NearestRealNumber A 170 | :If NearReal A 171 | r←RealPart A 172 | :Else 173 | ⎕SIGNAL 11 ⍝ DOMAIN ERROR 174 | :EndIf 175 | ∇ 176 | :EndSection 177 | 178 | :Section 5.3.2 179 | ∇ r←Type array 180 | :Select ⎕DR array 181 | :CaseList 11 83 163 323 645 1287 1289 182 | r←'numeric' 183 | :CaseList 82 80 160 320 184 | r←'character' 185 | :Else 186 | :If 9=⎕NC'array' 187 | r←'object' ⍝ Not in the ISO standard 188 | :Else 189 | r←'mixed' 190 | :EndIf 191 | :EndSelect 192 | ∇ 193 | :EndSection 194 | 195 | :Section 5.3.8 196 | ∇ r←ComparisonTolerance 197 | ⍝ The iso standard doesn't have ⎕DCT, but we do. 198 | :Select ⎕FR 199 | :Case 645 200 | r←⎕CT 201 | :Case 1287 202 | r←⎕DCT 203 | :Else 204 | ⎕SIGNAL 11 ⍝ DOMAIN ERROR 205 | :EndSelect 206 | ∇ 207 | :EndSection 208 | 209 | :Section 5.3.10 210 | IntegerTolerance←1E¯14 ⍝ aka SYSFUZZ 211 | RealTolerance←1E¯14 ⍝ aka SYSFUZZ 212 | :EndSection 213 | 214 | :Section 7 215 | ∇ r←{x}(primFn ScalarExtensionOperator)y;a;b;fn;ix;ranks;shape;shapes 216 | :If 0=⎕NC'x' 217 | x←y 218 | fn←{primFn ⍵} ⍝ ambivalent function which ignores left argument 219 | :Else 220 | fn←primFn 221 | :EndIf 222 | 223 | shapes←⍴¨x y 224 | ranks←≢¨shapes 225 | :If ≡⌿shapes 226 | ⍝ Shapes match, so loop over each element and apply the function 227 | :If ⍬ ⍬≡shapes ⍝ Scalars 228 | r←x fn y 229 | :Else 230 | shape←⊃shapes 231 | r←⍬ 232 | :For a b :InEach x y 233 | r,←⊂a fn ScalarExtensionOperator b 234 | :EndFor 235 | :If ((⊂'object')∊Type⍤⊃¨x y)∧0=×⌿shape 236 | ⎕SIGNAL 16 237 | :EndIf 238 | r←shape⍴r 239 | :EndIf 240 | 241 | :ElseIf 1∊×⌿¨shapes 242 | ⍝ Shapes do not match, but one argument is a singleton. 243 | ⍝ NOTE: singleton extension is defined more strictly in 244 | ⍝ the ISO standard than in Dyalog APL, but this definition 245 | ⍝ follows the Dyalog APL one. 246 | :Select 1=×⌿¨shapes 247 | :Case 0 1 248 | shape←⍴x 249 | :Case 1 0 250 | shape←⍴y 251 | :Case 1 1 252 | :If <⌿ranks 253 | shape←⍴y 254 | :Else 255 | shape←⍴x 256 | :EndIf 257 | :EndSelect 258 | x←shape⍴x 259 | y←shape⍴y 260 | 261 | r←x fn ScalarExtensionOperator y 262 | :ElseIf =⌿ranks 263 | ⍝ Shapes do not match, but the ranks do. 264 | ⍝ ⎕SIGNAL 5 ⍝ LENGTH ERROR 265 | 1 2+3 4 5 ⍝ use + to get the correct DMX message 266 | :Else 267 | ⍝ Shapes do not match, and the ranks differ. 268 | ⍝ ⎕SIGNAL 4 ⍝ RANK ERROR 269 | 1 2+(3 3⍴0) ⍝ use + to get the correct DMX message 270 | :EndIf 271 | ∇ 272 | :EndSection 273 | 274 | :EndNamespace 275 | -------------------------------------------------------------------------------- /tests/subtract.apln: -------------------------------------------------------------------------------- 1 | :Namespace subtract 2 | Assert←#.unittest.Assert 3 | stripToSameLen←#.utils.stripToSameLen 4 | isDyalogClassic←#.utils.isClassic 5 | 6 | model←{ 7 | ⍺+-⍵ 8 | } 9 | 10 | 11 | ∇ {r}←test_substract;RunVariations;fr_dbl;fr_decf;bool;i1;i2;i3;char0;char1;char2;char3;charptr;dbl;cmplx;Hcmplx;Hdbl;Sdbl;fl;Hfl;testDesc;case;case2;fr;desc;data;d1;d2;data2;case3;data3;c1;c2;f 12 | ⍝ use RunVariations operator and modify it for subtract 13 | RunVariations←(model #.testfns._RunVariations_-) 14 | 15 | fr_dbl←#.utils.fr_dbl 16 | fr_decf←#.utils.fr_decf 17 | 18 | ⍝ All data generated is unique 19 | bool←0 1 ⍝ 11: 1 bit Boolean type arrays 20 | i1←{⍵,-⍵}⍳120 ⍝ 83: 8 bits signed integer 21 | i2←{⍵,-⍵}10000+⍳100 ⍝ 163: 16 bits signed integer 22 | i3←{⍵,-⍵}100000+⍳100 ⍝ 323: 32 bits signed integer 23 | char0←⎕AV ⍝ 82: DyalogAPL classic char set 24 | :If ~isDyalogClassic 25 | char1←⎕UCS(100+⍳100) ⍝ 80: 8 bits character 26 | char2←⎕UCS(1000+⍳100) ⍝ 160: 16 bits character 27 | char3←⎕UCS(100000+⍳100) ⍝ 320: 32 bits character 28 | :EndIf 29 | charptr←(13↑⎕A)(13↓⎕A) ⍝ 326: Pointer (32-bit or 64-bit as appropriate) 30 | dbl←{⍵,-⍵}i3+0.1 ⍝ 645: 64 bits Floating 31 | cmplx←{⍵,-⍵}(0J1×⍳100)+⌽⍳100 ⍝ 1289: 128 bits Complex 32 | Hcmplx←{⍵,-⍵}(100000000000000J100000000000000×⍳20) ⍝ 1289 but larger numbers to test for CT value 33 | ⍝ Hdbl is 645 but larger numbers to test for CT value 34 | ⍝ intervals of 2 are chosen because CT for these numbers +1 and -1 35 | ⍝ come under the region of tolerant equality 36 | Hdbl←{⍵,-⍵}100000000000000+(2×⍳50) ⍝ 645: large numbers 37 | Sdbl←{⍵,-⍵}(⍳500)÷1000 ⍝ 645: Small numbers 38 | 39 | ⍝ Hfl is 1287 but larger numbers to test for CT value 40 | ⍝ far intervals are chosen for non overlap 41 | ⍝ with region of tolerant equality 42 | ⎕FR←fr_decf 43 | fl←{⍵,-⍵}i3+0.01 ⍝ 1287: 128 bits Decimal 44 | Hfl←{⍵,-⍵}200000000000000000000000000000+(10000000000000000×⍳10) 45 | ⎕FR←fr_dbl 46 | 47 | testDesc←{'for ',case,{0∊⍴case2:'',⍵ ⋄ ' , ',case2,⍵},' & ⎕CT ⎕DCT:',⎕CT,⎕DCT,'& ⎕FR:',⎕FR} 48 | 49 | r case case2←⍬ ⍬ ⍬ 50 | 51 | :For fr :In 2 1 52 | ⎕FR←fr⊃fr_dbl fr_decf 53 | 54 | quadparams←⎕CT ⎕DCT ⎕FR ⎕IO ⎕DIV 55 | 56 | case←'independant' 57 | desc←testDesc ⍬ 58 | r,←'TI1'desc Assert(0)≡0-0 59 | r,←'TNull1'desc Assert ⍬≡''-0 60 | r,←'TNull2'desc Assert ⍬≡⍬-0 61 | r,←'TNull3'desc Assert ⍬≡0-'' 62 | r,←'TNull4'desc Assert ⍬≡0-⍬ 63 | r,←'TNull5'desc Assert ⍬≡''-⍬ 64 | r,←'TNull6'desc Assert ⍬≡⍬-'' 65 | :For case :In 'bool' 'i1' 'i2' 'i3' 'dbl' 'fl' 'cmplx' 'Hdbl' 'Sdbl' 'Hfl' 'Hcmplx' 66 | data←⍎case 67 | desc←testDesc ⍬ 68 | 69 | r,←'T1'desc quadparams RunVariations((0⍨¨data)data data) ⍝ substraction with the same number gives 0 70 | d1←data[?≢data] 71 | d2←data[?≢(data~d1)] 72 | r,←'T2'desc quadparams RunVariations(d1 model d2)d1 d2 ⍝ model func finds results on single element 73 | r,←'T3'desc quadparams RunVariations data data 0 ⍝ Identity 74 | r,←'T4'desc quadparams RunVariations(-data)0 data ⍝ Identity 75 | r,←'T5'desc quadparams RunVariations d1 d1 0 ⍝ Identity 76 | r,←'T6'desc quadparams RunVariations(-d1)0 d1 ⍝ Identity 77 | r,←'T7'desc quadparams RunVariations(d1 d1)d1(0 0) ⍝ Identity (also hits arith_su.c#432 l_lsub_l) 78 | r,←'T8'desc Assert((|d1){(-⍵-⍺)≡⍺-⍵}|d2) ⍝ Anti-commutative 79 | 80 | ⍝ General tests to test the basic rules of subtract 81 | r,←'TGen1'desc Assert(≢data)≡≢data-data ⍝ length of the array will not change 82 | ⍝ r,← 'TGen2' desc Assert (d1{(1287≡⎕dr ⍺-⍵)∨((⎕dr ⍺) ⌈ ⎕dr ⍵)≥⎕dr ⍺-⍵}d2) ⍝ datatype will always be greater than or equal to the original datatype 83 | r,←'TGen3'desc Assert(11≡⎕DR data-data) ⍝ should always be an array of 0s 84 | 85 | ⍝ Cross type tests 86 | :For case2 :In 'i1' 'i2' 'i3' 'dbl' 'fl' 'cmplx' 'Hdbl' 'Hfl' 'Hcmplx' 87 | :If (case≡case2) 88 | :Continue 89 | :EndIf 90 | data2←⍎case2 91 | data data2←data stripToSameLen data2 92 | desc←testDesc ⍬ 93 | 94 | ⍝ data type test 95 | ⍝ r,← 'TGen4' desc Assert (d1{(1287≡⎕dr ⍺-⍵)∨((⎕dr ⍺) ⌈ ⎕dr ⍵)≥⎕dr ⍺-⍵}d2) 96 | 97 | r,←'TCross1'desc quadparams RunVariations(data model data2)data data2 ⍝ check result of different datatypes using model 98 | r,←'TCross2'desc quadparams RunVariations(data2 model data)data2 data ⍝ reverse of TCross1 99 | r,←'TCross3'desc quadparams RunVariations((data2,data)model(data,data2))(data2,data)(data,data2) ⍝ concat 2 different types 100 | r,←'TCross4'desc Assert(((data2 data)model(data data2))≡(data2 data)-(data data2)) ⍝ merge two different arrays creating a pointer array 101 | 102 | d1←data[?≢data] 103 | d2←data2[?≢(data2~d1)] 104 | r,←'TCross5'desc quadparams RunVariations(d1 model d2)d1 d2 ⍝ model finds results on single element 105 | :EndFor 106 | case2←⍬ ⍝ dispose case2 107 | desc←testDesc ⍬ 108 | 109 | ⍝ tests for known errors 110 | :For case3 :In 'char1' 'char2' 'char3' 'char0' 'charptr' 111 | :If (isDyalogClassic)∧(case≢'char0')∧(case≢'ptr') 112 | :Continue ⍝ Skip tests for unicode character sets in DyalogAPL classic 113 | :EndIf 114 | data3←⍎case3 115 | desc←testDesc ⍬ 116 | c1←data3[?≢data3] 117 | c2←(data3~c1)[?¯1+≢data3] 118 | 119 | f←0 ⍝ flag 120 | :Trap 11 ⍝ 11: Domain error 121 | c1-c2 ⍝ N/A type + N/A type 122 | :Else 123 | f←1 124 | r,←'TDomainE2'desc Assert(f∧⎕DMX.Message≡'') ⍝ check for error and dmx message 125 | :EndTrap 126 | 127 | f←0 ⍝ flag 128 | :Trap 11 ⍝ 11: Domain error 129 | d1-c2 ⍝ Number type + N/A type 130 | :Else 131 | f←1 132 | r,←'TDomainE3'desc Assert(f∧⎕DMX.Message≡'') ⍝ check for error and dmx message 133 | :EndTrap 134 | 135 | f←0 ⍝ flag 136 | :Trap 11 ⍝ 11: Domain error 137 | c1-d1 ⍝ N/A type + number type 138 | :Else 139 | f←1 140 | r,←'TDomainE4'desc Assert(f∧⎕DMX.Message≡'') ⍝ check for error and dmx message 141 | :EndTrap 142 | :EndFor 143 | :EndFor 144 | :EndFor 145 | ∇ 146 | :EndNamespace 147 | -------------------------------------------------------------------------------- /tests/add.apln: -------------------------------------------------------------------------------- 1 | :Namespace add 2 | Assert←#.unittest.Assert 3 | stripToSameLen←#.utils.stripToSameLen 4 | isDyalogClassic←#.utils.isClassic 5 | DMX_NODMX←#.errors.DMX_NODMX 6 | 7 | model←{ 8 | ⍺--⍵ 9 | } 10 | 11 | ∇ {r}←test_add;RunVariations;fr_dbl;fr_decf;bool;i1;i2;i3;char0;char1;char2;char3;charptr;dbl;cmplx;Hcmplx;Hdbl;Sdbl;fl;Hfl;testDesc;case;case2;fr;desc;data;d2;d1;data2;case3;data3;c1;c2;f 12 | ⍝ use RunVariations operator and modify it for addition 13 | RunVariations←(model #.testfns._RunVariations_+) 14 | 15 | fr_dbl←#.utils.fr_dbl 16 | fr_decf←#.utils.fr_decf 17 | 18 | ⍝ All data generated is unique 19 | bool←0 1 ⍝ 11: 1 bit Boolean type arrays 20 | i1←{⍵,-⍵}⍳120 ⍝ 83: 8 bits signed integer 21 | i2←{⍵,-⍵}10000+⍳100 ⍝ 163: 16 bits signed integer 22 | i3←{⍵,-⍵}100000+⍳100 ⍝ 323: 32 bits signed integer 23 | char0←⎕AV ⍝ 82: DyalogAPL classic char set 24 | :If ~isDyalogClassic 25 | char1←⎕UCS(100+⍳100) ⍝ 80: 8 bits character 26 | char2←⎕UCS(1000+⍳100) ⍝ 160: 16 bits character 27 | char3←⎕UCS(100000+⍳100) ⍝ 320: 32 bits character 28 | :EndIf 29 | charptr←(13↑⎕A)(13↓⎕A) ⍝ 326: Pointer (32-bit or 64-bit as appropriate) 30 | dbl←{⍵,-⍵}i3+0.1 ⍝ 645: 64 bits Floating 31 | cmplx←{⍵,-⍵}(0J1×⍳100)+⌽⍳100 ⍝ 1289: 128 bits Complex 32 | Hcmplx←{⍵,-⍵}(100000000000000J100000000000000×⍳20) ⍝ 1289 but larger numbers to test for CT value 33 | ⍝ Hdbl is 645 but larger numbers to test for CT value 34 | ⍝ intervals of 2 are chosen because CT for these numbers +1 and -1 35 | ⍝ come under the region of tolerant equality 36 | Hdbl←{⍵,-⍵}100000000000000+(2×⍳50) ⍝ 645: large numbers 37 | Sdbl←{⍵,-⍵}(⍳500)÷1000 ⍝ 645: Small numbers 38 | 39 | ⍝ Hfl is 1287 but larger numbers to test for CT value 40 | ⍝ far intervals are chosen for non overlap 41 | ⍝ with region of tolerant equality 42 | ⎕FR←fr_decf 43 | fl←{⍵,-⍵}i3+0.01 ⍝ 1287: 128 bits Decimal 44 | Hfl←{⍵,-⍵}200000000000000000000000000000+(10000000000000000×⍳10) 45 | ⎕FR←fr_dbl 46 | 47 | testDesc←{'for ',case,{0∊⍴case2:'',⍵ ⋄ ' , ',case2,⍵},' & ⎕CT ⎕DCT:',⎕CT,⎕DCT,'& ⎕FR:',⎕FR} 48 | 49 | r case case2←⍬ ⍬ ⍬ 50 | 51 | :For fr :In 2 1 52 | ⎕FR←fr⊃fr_dbl fr_decf 53 | 54 | quadparams←⎕CT ⎕DCT ⎕FR ⎕IO ⎕DIV 55 | 56 | case←'independant' 57 | desc←testDesc ⍬ 58 | r,←'TI1'desc Assert(0)≡0+0 59 | r,←'TNull1'desc Assert ⍬≡''+0 60 | r,←'TNull2'desc Assert ⍬≡⍬+0 61 | r,←'TNull3'desc Assert ⍬≡0+'' 62 | r,←'TNull4'desc Assert ⍬≡0+⍬ 63 | r,←'TNull5'desc Assert ⍬≡''+⍬ 64 | r,←'TNull6'desc Assert ⍬≡⍬+'' 65 | :For case :In 'bool' 'i1' 'i2' 'i3' 'dbl' 'fl' 'cmplx' 'Hdbl' 'Sdbl' 'Hfl' 'Hcmplx' 66 | data←⍎case 67 | desc←testDesc ⍬ 68 | 69 | ⍝ General tests to test the basic rules of addition 70 | r,←'TGen1'desc Assert(≢data)≡≢data+data ⍝ length of the array will not change 71 | r,←'TGen2'desc Assert({1287≡(⎕DR ⍵):⎕FR≡⎕DR ⍵+⍵ ⋄ (⎕DR ⍵)≤⎕DR ⍵+⍵}data) ⍝ datatype will always be greater than or equal to the original datatype, excluding floats 72 | r,←'TGen3'desc Assert(11≡⎕DR data+-data) ⍝ should always be an array of 0s 73 | 74 | r,←'T1'desc quadparams RunVariations(2×data)data data ⍝ addition with the same number doubles the result 75 | d1←data[?≢data] 76 | d2←data[?≢(data~d1)] 77 | r,←'T2'desc quadparams RunVariations(d1 model d2)d1 d2 ⍝ model func finds results on single element 78 | r,←'T3'desc quadparams RunVariations data data 0 ⍝ Identity 79 | r,←'T4'desc quadparams RunVariations data 0 data ⍝ Identity 80 | r,←'T5'desc quadparams RunVariations d1 d1 0 ⍝ Identity 81 | r,←'T6'desc quadparams RunVariations d1 0 d1 ⍝ Identity 82 | r,←'T7'desc quadparams RunVariations(d1 d1)d1(0 0) ⍝ Identity (also hits arith_su.c#352 l_ladd_l) 83 | 84 | ⍝ Cross type tests 85 | :For case2 :In 'i1' 'i2' 'i3' 'dbl' 'fl' 'cmplx' 'Hdbl' 'Hfl' 'Hcmplx' 86 | :If (case≡case2) 87 | :Continue 88 | :EndIf 89 | data2←⍎case2 90 | data data2←data stripToSameLen data2 91 | desc←testDesc ⍬ 92 | 93 | ⍝ data type test 94 | ⍝ except for 1287, the maximum of the ⎕dr value of data and data2 will be the result 95 | ⍝ skipped for cmplx 96 | r,←'TGen4'desc Assert(data{(1287≡(⎕DR ⍺))∨(1287≡(⎕DR ⍵)):⎕FR≡⎕DR ⍺+⍵ ⋄ ((⎕DR ⍺)⌈⎕DR ⍵)≤⎕DR ⍺+⍵}data2)∨((1289≡⎕DR data2)∨(1289≡⎕DR data)) 97 | 98 | r,←'TCross1'desc quadparams RunVariations(data model data2)data data2 ⍝ check result of different datatypes using model 99 | r,←'TCross2'desc quadparams RunVariations(data2 model data)data2 data ⍝ reverse of TCross1 100 | r,←'TCross3'desc quadparams RunVariations((data2,data)model(data,data2))(data2,data)(data,data2) ⍝ concat 2 different types 101 | r,←'TCross4'desc Assert(((data2 data)model(data data2))≡(data2 data)+(data data2)) ⍝ merge two different arrays creating a pointer array 102 | 103 | d1←data[?≢data] 104 | d2←data2[?≢(data2~d1)] 105 | r,←'TCross5'desc quadparams RunVariations(d1 model d2)d1 d2 ⍝ model finds results on single element 106 | :EndFor 107 | case2←⍬ ⍝ dispose case2 108 | desc←testDesc ⍬ 109 | 110 | ⍝ tests for known errors 111 | :For case3 :In 'char1' 'char2' 'char3' 'char0' 'charptr' 112 | :If (isDyalogClassic)∧(case≢'char0')∧(case≢'ptr') 113 | :Continue ⍝ Skip tests for unicode character sets in DyalogAPL classic 114 | :EndIf 115 | data3←⍎case3 116 | desc←testDesc ⍬ 117 | c1←data3[?≢data3] 118 | c2←(data3~c1)[?¯1+≢data3] 119 | 120 | f←0 ⍝ flag 121 | :Trap 11 ⍝ 11: Domain error 122 | c1+c2 ⍝ N/A type + N/A type 123 | :Else 124 | f←1 125 | r,←'TDomainE2'desc Assert(f∧⎕DMX.Message≡DMX_NODMX) ⍝ check for error and dmx message 126 | :EndTrap 127 | 128 | f←0 ⍝ flag 129 | :Trap 11 ⍝ 11: Domain error 130 | d1+c2 ⍝ Number type + N/A type 131 | :Else 132 | f←1 133 | r,←'TDomainE3'desc Assert(f∧⎕DMX.Message≡DMX_NODMX) ⍝ check for error and dmx message 134 | :EndTrap 135 | 136 | f←0 ⍝ flag 137 | :Trap 11 ⍝ 11: Domain error 138 | c1+d1 ⍝ N/A type + number type 139 | :Else 140 | f←1 141 | r,←'TDomainE4'desc Assert(f∧⎕DMX.Message≡DMX_NODMX) ⍝ check for error and dmx message 142 | :EndTrap 143 | :EndFor 144 | :EndFor 145 | :EndFor 146 | ∇ 147 | :EndNamespace 148 | -------------------------------------------------------------------------------- /tests/multiply.apln: -------------------------------------------------------------------------------- 1 | :Namespace multiply 2 | Assert←#.unittest.Assert 3 | stripToSameLen←#.utils.stripToSameLen 4 | isDyalogClassic←#.utils.isClassic 5 | DMX_NODMX←#.errors.DMX_NODMX 6 | DMX_FR645LIMIT←#.errors.DMX_FR645LIMIT 7 | 8 | complexMultiplyModel←{ 9 | (⎕FR≡1287)∧case≡'Hcmplx':⍺×⍵ ⍝ Skipping cmplx for ⎕FR←1287 10 | a c b d←∊(9 11○⊂)⍺ ⍵ 11 | ⍝ using formula (a+bi)(c+di)=(ac-bd)+(ad+bc)i 12 | x←((a model c)-(b model d)) 13 | y←((a model d)+(b model c)) 14 | x(⊣+¯11○⊢)y 15 | } 16 | 17 | ⍝ model for multiply might not be completely accurate for floats 18 | ⍝ because it uses reciprocal and divide and there might be a 19 | ⍝ loss of precision 20 | model←{⍺{ 21 | 0≡⍵:0 22 | ⍝ is ⍵ or ⍺ complex 23 | (1289≡⎕DR ⍵)∨(1289≡⎕DR ⍺):⍺ complexMultiplyModel¨⍵ 24 | ⍺⌹¨÷⍵ 25 | }¨⍵} 26 | 27 | ⍝ model←{*(⍟⍺)+⍟⍵} 28 | 29 | ∇ {r}←test_multiply;fr_decf;RunVariations;bool;i1;i2;i3;char0;char1;char2;char3;charptr;dbl;cmplx;Hcmplx;Hdbl;Sdbl;fl;Hfl;testDesc;case;case2;fr;desc;data;d1;d2;data2;case3;data3;c1;c2;f;fr_dbl 30 | RunVariations←(model #.testfns._RunVariations_×) 31 | 32 | ⍝ constants 33 | fr_dbl←#.utils.fr_dbl 34 | fr_decf←#.utils.fr_decf 35 | 36 | ⍝ All data generated is unique 37 | bool←0 1 ⍝ 11: 1 bit Boolean type arrays 38 | i1←{⍵,-⍵}⍳120 ⍝ 83: 8 bits signed integer 39 | i2←{⍵,-⍵}10000+⍳100 ⍝ 163: 16 bits signed integer 40 | i3←{⍵,-⍵}100000+⍳100 ⍝ 323: 32 bits signed integer 41 | char0←⎕AV ⍝ 82: DyalogAPL classic char set 42 | :If ~isDyalogClassic 43 | char1←⎕UCS(100+⍳100) ⍝ 80: 8 bits character 44 | char2←⎕UCS(1000+⍳100) ⍝ 160: 16 bits character 45 | char3←⎕UCS(100000+⍳100) ⍝ 320: 32 bits character 46 | :EndIf 47 | charptr←(13↑⎕A)(13↓⎕A) ⍝ 326: Pointer (32-bit or 64-bit as appropriate) 48 | dbl←{⍵,-⍵}i3+0.1 ⍝ 645: 64 bits Floating 49 | cmplx←{⍵,-⍵}(0J1×⍳100)+⌽⍳100 ⍝ 1289: 128 bits Complex 50 | Hcmplx←{⍵,-⍵}(100000000000000J100000000000000×⍳20) ⍝ 1289 but larger numbers to test for CT value 51 | ⍝ Hdbl is 645 but larger numbers to test for CT value 52 | ⍝ intervals of 2 are chosen because CT for these numbers +1 and -1 53 | ⍝ come under the region of tolerant equality 54 | Hdbl←{⍵,-⍵}100000000000000+(2×⍳50) ⍝ 645: large numbers 55 | Sdbl←{⍵,-⍵}(⍳500)÷1000 ⍝ 645: Small numbers 56 | 57 | ⍝ Hfl is 1287 but larger numbers to test for CT value 58 | ⍝ far intervals are chosen for non overlap 59 | ⍝ with region of tolerant equality 60 | ⎕FR←fr_decf 61 | fl←{⍵,-⍵}i3+0.01 ⍝ 1287: 128 bits Decimal 62 | Hfl←{⍵,-⍵}200000000000000000000000000000+(10000000000000000×⍳10) 63 | ⎕FR←fr_dbl 64 | 65 | r←⍬ 66 | testDesc←{'for ',case,{0∊⍴case2:'',⍵ ⋄ ' , ',case2,⍵},' & ⎕FR:',⎕FR} 67 | 68 | r case case2←⍬ ⍬ ⍬ 69 | 70 | :For fr :In 2 1 71 | ⎕FR←fr⊃fr_dbl fr_decf 72 | 73 | quadparams←⎕CT ⎕DCT ⎕FR ⎕IO ⎕DIV 74 | case←'independant' 75 | desc←testDesc ⍬ 76 | 77 | r,←'TI1'desc Assert 0≡0×0 78 | r,←'TNull1'desc Assert ⍬≡''×0 ⍝ testing for null values 79 | r,←'TNull2'desc Assert ⍬≡⍬×0 80 | r,←'TNull3'desc Assert ⍬≡0×'' 81 | r,←'TNull4'desc Assert ⍬≡0×⍬ 82 | 83 | :For case :In 'bool' 'i1' 'i2' 'i3' 'dbl' 'fl' 'cmplx' 'Hdbl' 'Sdbl' 'Hfl' 'Hcmplx' 84 | data←⍎case 85 | desc←testDesc ⍬ 86 | 87 | ⍝ General tests to test the basic rules of multiply 88 | r,←'TGen1'desc Assert(≢data)≡≢data×data 89 | 90 | d1←(data~0)[?≢data~0] 91 | 92 | r,←'T1'desc quadparams RunVariations(data model data)data data ⍝ model test 93 | d1←data[?≢data] 94 | d2←data[?≢(data~d1)] 95 | r,←'T2'desc quadparams RunVariations data data 1 ⍝ Identity 96 | r,←'T3'desc quadparams RunVariations(0⍨¨data)data 0 ⍝ x×0=0 97 | r,←'T4'desc Assert 0≡0×d1 98 | r,←'T5'desc Assert 0≡d1×0 99 | r,←'T6'desc Assert d1≡1×d1 100 | r,←'T7'desc Assert d1≡d1×1 101 | r,←'T8'desc Assert(d1×d2)≡d2×d1 ⍝ commutability 102 | :EndFor 103 | 104 | ⍝ Cross type tests 105 | :For case2 :In 'i1' 'i2' 'i3' 'dbl' 'fl' 'cmplx' 'Hdbl' 'Hfl' 'Hcmplx' 106 | data2←⍎case2 107 | data data2←data stripToSameLen data2 108 | desc←testDesc ⍬ 109 | :If (case≡case2) 110 | :Continue 111 | :EndIf 112 | 113 | r,←'TCross1'desc quadparams RunVariations(data model data2)data data2 ⍝ check result of different datatypes using model 114 | r,←'TCross2'desc quadparams RunVariations(data2 model data)data2 data ⍝ TCross1 but reversed 115 | r,←'TCross3'desc quadparams RunVariations((data2,data)model(data,data2))(data2,data)(data,data2) ⍝ concat 2 different types 116 | r,←'TCross4'desc Assert(((data2 data)model(data data2))≡(data2 data)×(data data2)) ⍝ merge two different arrays creating a pointer array 117 | :EndFor 118 | 119 | ⍝ tests for known errors 120 | :For case3 :In 'char1' 'char2' 'char3' 'char0' 'charptr' 121 | :If (isDyalogClassic)∧(case≢'char0')∧(case≢'ptr') 122 | :Continue ⍝ Skip tests for unicode character sets in DyalogAPL classic 123 | :EndIf 124 | data3←⍎case3 125 | desc←testDesc ⍬ 126 | c1←data3[?≢data3] 127 | c2←(data3~c1)[?¯1+≢data3] 128 | 129 | f←0 ⍝ flag 130 | :Trap 11 ⍝ 11: Domain error 131 | c1×c2 ⍝ N/A type × N/A type 132 | :Else 133 | f←1 134 | r,←'TDomainE2'desc Assert(f∧⎕DMX.Message≡DMX_NODMX) ⍝ check for error and dmx message 135 | :EndTrap 136 | 137 | f←0 ⍝ flag 138 | :Trap 11 ⍝ 11: Domain error 139 | d1×c2 ⍝ Number type × N/A type 140 | :Else 141 | f←1 142 | r,←'TDomainE3'desc Assert(f∧⎕DMX.Message≡DMX_NODMX) ⍝ check for error and dmx message 143 | :EndTrap 144 | 145 | f←0 ⍝ flag 146 | :Trap 11 ⍝ 11: Domain error 147 | c1×d1 ⍝ N/A type × number type 148 | :Else 149 | f←1 150 | r,←'TDomainE4'desc Assert(f∧⎕DMX.Message≡DMX_NODMX) ⍝ check for error and dmx message 151 | :EndTrap 152 | :EndFor 153 | 154 | case←'manual known cases' 155 | case2←⍬ 156 | desc←testDesc ⍬ 157 | :If fr≡1 158 | f dmx←0 '' ⍝ flag 159 | :Trap 11 ⍝ 11: Domain error 160 | _←×⍨1E155 ⍝ expected faliure 161 | :Else 162 | f←1 163 | dmx←⎕DMX.Message 164 | :EndTrap 165 | r,←'TM1'desc Assert(f∧dmx≡DMX_FR645LIMIT) ⍝ check for error and dmx message 166 | :EndIf 167 | r,←'TM2'desc Assert(⊢≡1×⊢)9007199254740992 ⍝ Mantis mantis 21743: largest float that can be expressed as an integer (might be moved to a generalised test) 168 | :EndFor 169 | ∇ 170 | :EndNamespace 171 | -------------------------------------------------------------------------------- /tests/behind.apln: -------------------------------------------------------------------------------- 1 | :Namespace behind 2 | Assert←#.unittest.Assert 3 | runOrErr←#.testfns.runOrErr 4 | Ints←#.random.Ints 5 | Chars←#.random.Chars 6 | shuffle←#.utils.shuffle 7 | intertwine←#.utils.intertwine 8 | 9 | model←{ 10 | ⍺←⍵ 11 | (⍺⍺ ⍺)⍵⍵ ⍵ 12 | } 13 | 14 | ∇ r←testDesc 15 | r←'for ',case,' & ⎕CT ⎕DCT ⎕FR:',⍕⎕CT ⎕DCT ⎕FR 16 | ∇ 17 | 18 | ⍝ test function used to test for errors 19 | ∇ op_fn arg 20 | ∇ 21 | 22 | ∇ {r}←test_behind;flag;m;f;g;case;quadparams;desc;RunVariations 23 | r←⍬ 24 | 25 | ⍝ Monadic behind 26 | ⍝ making a palindrome function with behind 27 | f←⌽ ⋄ g←≡ 28 | RunVariations←(f model g)#.testfns._RunVariationsWithModel_(f⍛g) 29 | case←'mondaic' 30 | quadparams←⎕CT ⎕DCT ⎕FR ⎕IO ⎕DIV 31 | desc←testDesc 32 | 33 | r,←'T1'desc quadparams RunVariations⊂'dyalog' 34 | r,←'T2'desc quadparams RunVariations⊂'racecar' 35 | 36 | ⍝ Dyadic behind 37 | ⍝ strip from the back 38 | f←- ⋄ g←↓ 39 | RunVariations←(f model g)#.testfns._RunVariationsWithModel_(f⍛g) 40 | case←'dyadic' 41 | desc←testDesc 42 | 43 | r,←'T3'desc quadparams RunVariations 4 'Dyalog APL' 44 | r,←'T4'desc quadparams RunVariations 3 'racecar' 45 | 46 | ⍝ Namespace as argument 47 | ⍝ Monadic 48 | r,←'T5'desc Assert 4 4≡({⍵.⎕NL ¯9}⍛(⎕VGET⍨)(a:1 ⋄ b:(r:4) ⋄ c:(d:2 ⋄ r:4) ⋄ e:3)).r 49 | ⍝ Dyadic 50 | r,←'T6'desc Assert 1 0≡(abc:1 ⋄ def:2){⍵.⎕NL ¯2}⍛∊'abc' 'xyz' 51 | 52 | ⍝ Error cases 53 | ⍝ 2: Syntax Error 54 | ⍝ Non-function as operands 55 | :For x :In ⎕NULL ⍬''# 123 'xyz'(⊂1 2 3)(2 3⍴⍳6) 56 | r,←'TE1'desc Assert((⊂0 2)≡((x⍛+runOrErr)'Dyalog APL')) 57 | r,←'TE2'desc Assert((⊂0 2)≡((+⍛x runOrErr)123)) 58 | :EndFor 59 | 60 | ⍝ Missing Right Argument 61 | flag←0 ⍝ flag 62 | :Trap 2 ⍝ 2: Syntax error 63 | (123(+⍛×)) 64 | :Else 65 | m←⎕DMX.Message 66 | flag←1 67 | :EndTrap 68 | r,←'TE3'desc Assert(flag∧m≡'Missing right argument') 69 | 70 | ⍝ operand functions don't produce a result (in all combinations below) 71 | flag←0 ⍝ flag 72 | :Trap 6 ⍝ 2: Value error 73 | (⍳6)(op_fn⍛+)⍳10 74 | :Else 75 | m←⎕DMX.Message 76 | flag←1 77 | :EndTrap 78 | r,←'TE3'desc Assert(flag∧m≡'No result was provided when the context expected one') 79 | 80 | ⍝ operand functions don't produce a result 81 | flag←0 ⍝ flag 82 | :Trap 6 ⍝ 6: Value error 83 | (op_fn⍛+)⍳10 84 | :Else 85 | m←⎕DMX.Message 86 | flag←1 87 | :EndTrap 88 | r,←'TE3'desc Assert(flag∧m≡'No result was provided when the context expected one') 89 | 90 | ⍝ operand functions don't produce a result 91 | flag←0 ⍝ flag 92 | :Trap 2 ⍝ 2: Syntax error 93 | ⍳6(+⍛op_fn)⍳10 94 | :Else 95 | m←⎕DMX.Message 96 | flag←1 97 | :EndTrap 98 | r,←'TE3'desc Assert(flag∧m≡'The function does not take a left argument') 99 | 100 | ⍝ operand functions don't produce a result 101 | flag←0 ⍝ flag 102 | :Trap 2 ⍝ 2: Syntax error 103 | (+⍛op_fn)⍳10 104 | :Else 105 | m←⎕DMX.Message 106 | flag←1 107 | :EndTrap 108 | r,←'TE3'desc Assert(flag∧m≡'The function does not take a left argument') 109 | 110 | 111 | ∇ 112 | 113 | ∇ {r}←test_behind_idioms;sortAsc;sortDesc;modelSortAsc;modelSortDesc;case;case2;data_single_bool_0;data_single_bool_1;data_bool;data_i1;data_i2;data_i4;len;data_char0;data_char1;data_char2;data_char3;data_char_ptr;data_ptr;data_dbl;data_cmplx;data_Hcmplx;data_Hdbl;data_Sdbl;data_fl;data_Hfl;order;model;sort;RunVariations;ct;fr;quadparams;caselist;data;desc;data2 114 | r←⍬ 115 | sortAsc←⊂⍤⍋⍛⌷ 116 | sortDesc←⊂⍤⍒⍛⌷ 117 | 118 | modelSortAsc←{(⊂⍋⍵)⌷⍵} 119 | modelSortDesc←{(⊂⍒⍵)⌷⍵} 120 | 121 | ⍝ data 122 | case←⍬ 123 | case2←⍬ 124 | data_single_bool_0←∧/1 0 1 0 ⍝ singleton boolean 125 | data_single_bool_1←∧/1 1 1 1 ⍝ singleton boolean 126 | data_bool←1 0 127 | data_i1←100 Ints 8 128 | data_i2←100 Ints 16 129 | data_i4←100 Ints 32 130 | :For len :In 8 16 32 64 128 131 | ⎕SHADOW(('data_i')∘,⍤⍕¨1 2 4)⍪¨⊂'_',⍕len 132 | ⍎'data_i1_',⍕len'←len Ints 8' 133 | ⍎'data_i2_',⍕len'←len Ints 16' 134 | ⍎'data_i4_',⍕len'←len Ints 32' 135 | :EndFor 136 | 137 | data_char0←⎕AV ⍝ 82: DyalogAPL classic char set 138 | :If ~#.utils.isClassic 139 | data_char1←100 Chars 8 ⍝ 80: 8 bits character 140 | data_char2←100 Chars 16 ⍝ 160: 16 bits character 141 | data_char3←100 Chars 32 ⍝ 320: 32 bits character 142 | data_char_ptr←data_char1 data_char2 data_char3⍝ 326: Pointer (32-bit or 64-bit as appropriate) 143 | :EndIf 144 | data_ptr←data_i1 data_i2 data_i4 ⍝ 326: Pointer (32-bit or 64-bit as appropriate) 145 | data_dbl←{⍵,-⍵}data_i4+0.1 ⍝ 645: 64 bits Floating 146 | data_cmplx←{⍵,-⍵}(0J1×⍳100)+⌽⍳100 ⍝ 1289: 128 bits Complex 147 | data_Hcmplx←{⍵,-⍵}(100000000000000J100000000000000×⍳20) ⍝ 1289 but larger numbers to test for CT value 148 | ⍝ Hdbl is 645 but larger numbers to test for CT value 149 | ⍝ intervals of 2 are chosen because CT for these numbers +1 and -1 150 | ⍝ come under the region of tolerant equality 151 | data_Hdbl←{⍵,-⍵}100000000000000+(2×⍳50) 152 | 153 | data_Sdbl←{⍵,-⍵}(⍳500)÷1000 154 | 155 | ⍝ Hfl is 1287 but larger numbers to test for CT value 156 | ⍝ far intervals are chosen for non overlap 157 | ⍝ with region of tolerant equality 158 | ⎕FR←#.utils.fr_decf 159 | data_fl←{⍵,-⍵}data_i4+0.01 ⍝ 1287: 128 bits Decimal 160 | data_Hfl←{⍵,-⍵}200000000000000000000000000000+(10000000000000000×⍳10) 161 | ⎕FR←#.utils.fr_dbl 162 | 163 | :For order :In 1 2 164 | model←⍎order⊃'modelSortAsc' 'modelSortDesc' 165 | sort←⍎order⊃'sortAsc' 'sortDesc' 166 | RunVariations←model #.testfns._RunVariationsWithModel_ sort 167 | :For ct :In 0 1 10 0.1 168 | (⎕CT ⎕DCT)←ct×#.utils.(ct_default dct_default) 169 | :For fr :In 1 2 170 | ⎕FR←fr⊃#.utils.(fr_dbl fr_decf) 171 | ⎕IO←1 172 | 173 | quadparams←⎕CT ⎕DCT ⎕FR ⎕IO ⎕DIV 174 | caselist←⎕NL ¯2 175 | caselist←caselist⌿⍨{'data_'⊃⍤⍷⍵}¨caselist 176 | 177 | :For case :In caselist 178 | data←⍎case 179 | desc←testDesc 180 | r,←('TGen1: ',order⊃'Asc' 'Desc')desc Assert(≢model⊃shuffle data)≡≢(sort⊃shuffle data) ⍝ length of result does not change 181 | 182 | r,←('T1: ',order⊃'Asc' 'Desc')desc quadparams RunVariations⊂data ⍝ no shuffle 183 | r,←('T2: ',order⊃'Asc' 'Desc')desc quadparams RunVariations⊂shuffle data ⍝ shuffle data 184 | r,←('T3: ',order⊃'Asc' 'Desc')desc Assert(model⊃shuffle data)≡(sort⊃shuffle data) ⍝ different shuffles produce same result 185 | 186 | 187 | :For case2 :In caselist 188 | data2←⍎case2 189 | desc←testDesc 190 | 191 | r,←('T3: ',order⊃'Asc' 'Desc')desc quadparams RunVariations⊂data,data2 ⍝ no shuffle 192 | r,←('T4: ',order⊃'Asc' 'Desc')desc quadparams RunVariations⊂data intertwine data2 ⍝ intertwine data with data2 193 | r,←('T5: ',order⊃'Asc' 'Desc')desc quadparams RunVariations⊂shuffle data,data2 ⍝ shuffle data and data2 194 | :EndFor 195 | :EndFor 196 | :EndFor 197 | :EndFor 198 | :EndFor 199 | ∇ 200 | :EndNamespace 201 | -------------------------------------------------------------------------------- /tests/union_and_intersection.apln: -------------------------------------------------------------------------------- 1 | :Namespace union_and_intersection 2 | Assert←#.unittest.Assert 3 | ints←#.utils.ints 4 | doSlowTests←#.utils.doSlowTests 5 | 6 | ⍝ Models are not in use but kept for reference 7 | ⍝ model←{⍺,(∧/⍺≢¨⍵)/⍵} 8 | ⍝ modelUnion←{⍺,(~⍵∊⍺)/⍵} 9 | modelUnion←{⍺,⍵~⍺} 10 | modelIntersection←{(⍺∊⍵)/⍺} 11 | 12 | ∇ r←testDesc 13 | r←'for ',case,{0∊⍴case2:'',⍵ ⋄ ' , ',case2,⍵},' & ⎕CT ⎕DCT ⎕FR:',⍕⎕CT ⎕DCT ⎕FR 14 | ∇ 15 | 16 | ∇ {r}←test_union_and_intersection;RunVariations;case;case2;caselist;ct;d1;d2;d3;data;data2;data_Hcmplx;data_Hdbl;data_Hfl;data_Sdbl;data_bool;data_char0;data_char1;data_char2;data_char3;data_char_ptr;data_cmplx;data_dbl;data_fl;data_i1;data_i2;data_i4;data_ptr;data_single_bool_0;data_single_bool_1;desc;fr;len;op;quadparams 17 | r←⍬ 18 | case←⍬ 19 | case2←⍬ 20 | data_single_bool_0←∧/1 0 1 0 ⍝ singleton boolean 21 | data_single_bool_1←∧/1 1 1 1 ⍝ singleton boolean 22 | data_bool←1 0 23 | data_i1←100 ints 8 24 | data_i2←100 ints 16 25 | data_i4←100 ints 32 26 | :For len :In 8 16 32 64 128 27 | ⍎'data_i1_',⍕len'←len ints 8' 28 | ⍎'data_i2_',⍕len'←len ints 16' 29 | ⍎'data_i4_',⍕len'←len ints 32' 30 | :EndFor 31 | data_char0←⎕AV ⍝ 82: DyalogAPL classic char set 32 | :If ~#.utils.isClassic 33 | data_char1←⎕UCS(100+⍳100) ⍝ 80: 8 bits character 34 | data_char2←⎕UCS(1000+⍳100) ⍝ 160: 16 bits character 35 | data_char3←⎕UCS(100000+⍳100) ⍝ 320: 32 bits character 36 | data_char_ptr←data_char1 data_char2 data_char3⍝ 326: Pointer (32-bit or 64-bit as appropriate) 37 | :EndIf 38 | data_ptr←data_i1 data_i2 data_i4 ⍝ 326: Pointer (32-bit or 64-bit as appropriate) 39 | data_dbl←{⍵,-⍵}data_i4+0.1 ⍝ 645: 64 bits Floating 40 | data_cmplx←{⍵,-⍵}(0J1×⍳100)+⌽⍳100 ⍝ 1289: 128 bits Complex 41 | data_Hcmplx←{⍵,-⍵}(100000000000000J100000000000000×⍳20) ⍝ 1289 but larger numbers to test for CT value 42 | ⍝ Hdbl is 645 but larger numbers to test for CT value 43 | ⍝ intervals of 2 are chosen because CT for these numbers +1 and -1 44 | ⍝ come under the region of tolerant equality 45 | data_Hdbl←{⍵,-⍵}100000000000000+(2×⍳50) 46 | 47 | ⍝ This is needed for a case that can be hit if we have a lot of small numbers 48 | ⍝ which produce a hash collision 49 | ⍝ Occurrence: same.c.html#L1153 50 | data_Sdbl←{⍵,-⍵}(⍳500)÷1000 51 | 52 | ⍝ Hfl is 1287 but larger numbers to test for CT value 53 | ⍝ far intervals are chosen for non overlap 54 | ⍝ with region of tolerant equality 55 | ⎕FR←#.utils.fr_decf 56 | data_fl←{⍵,-⍵}data_i4+0.01 ⍝ 1287: 128 bits Decimal 57 | data_Hfl←{⍵,-⍵}200000000000000000000000000000+(10000000000000000×⍳10) 58 | ⎕FR←#.utils.fr_dbl 59 | 60 | ⍝ Namespaces as args 61 | desc←testDesc 62 | r,←'Union (∪) ns'desc Assert((#)modelUnion(# ⎕SE))≡(#)∪(# ⎕SE) 63 | r,←'Intersection (∩) ns'desc Assert((#)modelIntersection(# ⎕SE))≡(#)∩(# ⎕SE) 64 | 65 | :For op :In '∪' '∩' 66 | :If op≡'∪' 67 | RunVariations←modelUnion #.testfns._RunVariationsWithModel_(⍎op) 68 | :Else 69 | RunVariations←modelIntersection #.testfns._RunVariationsWithModel_(⍎op) 70 | :EndIf 71 | 72 | :For ct :In 0 1 10 0.1 73 | (⎕CT ⎕DCT)←ct×#.utils.(ct_default dct_default) 74 | :For fr :In 1 2 75 | ⎕FR←fr⊃#.utils.(fr_dbl fr_decf) 76 | ⎕IO←1 77 | 78 | quadparams←⎕CT ⎕DCT ⎕FR ⎕IO ⎕DIV 79 | 80 | caselist←⎕NL ¯2 81 | caselist←caselist⌿⍨{'data_'⊃⍤⍷⍵}¨caselist 82 | 83 | :For case :In caselist 84 | data←⍎case 85 | desc←testDesc 86 | :If (1287≡⎕DR data)∧645≡⎕FR 87 | :Else 88 | r,←({⍵≡'∪':'Union (∪)' ⋄ 'Intersection (∩)'}op)desc quadparams RunVariations data(data,data) 89 | r,←({⍵≡'∪':'Union (∪) Hash1' ⋄ 'Intersection (∩) hash1'}op)desc quadparams RunVariations data(#.utils.hashArray data) 90 | :EndIf 91 | ⍝ General tests to test the basic rules of union 92 | r,←'Union (∪) Gen1'desc Assert(≢data)≤≢data∪data ⍝ union returns a result that has less number of elements than the input 93 | r,←'Intersection (∩) Gen1'desc Assert(≢data)≥≢data∩data ⍝ intersection returns a result that is exceding the number of elements than the input 94 | 95 | r,←({⍵≡'∪':'Union (∪) Gen2' ⋄ 'Intersection (∩) Gen2'}op)desc Assert(⎕DR data)≡⎕DR data(⍎op)data ⍝ datatype of the data will not change under union or intersection 96 | :For case2 :In caselist 97 | data2←⍎case2 98 | desc←testDesc 99 | ⍝ remove very big numbers 100 | :If (data≡data2)∨((1287∊⎕DR¨data data2)∧(645≡⎕FR)) 101 | :Continue 102 | :EndIf 103 | r,←({⍵≡'∪':'Union (∪) Cross' ⋄ 'Intersection (∩) Cross'}op)desc quadparams RunVariations data data2 104 | r,←({⍵≡'∪':'Union (∪) Cross2' ⋄ 'Intersection (∩) Cross2'}op)desc quadparams RunVariations(data,data)data2 105 | r,←({⍵≡'∪':'Union (∪) Cross3' ⋄ 'Intersection (∩) Cross3'}op)desc quadparams RunVariations data(data2,data2) 106 | r,←({⍵≡'∪':'Union (∪) Cross4' ⋄ 'Intersection (∩) Cross4'}op)desc quadparams RunVariations(data,data)(data2,data2) 107 | 108 | :For len :In 1 10 100 1000 10000 109 | :If (~doSlowTests)∧(len≡10000) 110 | :Continue ⍝ Skip one case because it takes 30 minutes with len 10000 111 | :EndIf 112 | r,←({⍵≡'∪':'Union (∪) Cross5' ⋄ 'Intersection (∩) Cross5'}op)desc quadparams RunVariations((?len)⍴data,data2)((?len)⍴data2,data) 113 | :EndFor 114 | 115 | r,←({⍵≡'∪':'Union (∪) Hash2' ⋄ 'Intersection (∩) Hash2'}op)desc quadparams RunVariations(data,data)(#.utils.hashArray data2,data2) 116 | 117 | ⍝ General tests to test the basic rules of union 118 | r,←'Union (∪) CrossGen1'desc Assert((≢data)⌈≢data2)≤≢data∪data2 ⍝ union returns a result that has less number of elements than the input 119 | r,←'Intersection (∩) CrossGen1'desc Assert((≢data)⌈≢data2)≥≢data∩data2 ⍝ intersection returns a result that is exceding the number of elements than the input 120 | 121 | :If 1<(≢data)⌊≢data2 122 | d1←data[?≢data] 123 | d2←data[?≢(data~d1)] 124 | d3←data2[?≢data2] 125 | r,←({⍵≡'∪':'Union (∪) Cross5' ⋄ 'Intersection (∩) Cross5'}op)desc quadparams RunVariations d1 d2 126 | r,←({⍵≡'∪':'Union (∪) Cross6' ⋄ 'Intersection (∩) Cross6'}op)desc quadparams RunVariations d1 data 127 | r,←({⍵≡'∪':'Union (∪) Cross7' ⋄ 'Intersection (∩) Cross7'}op)desc quadparams RunVariations d1 data2 128 | r,←({⍵≡'∪':'Union (∪) Cross8' ⋄ 'Intersection (∩) Cross8'}op)desc quadparams RunVariations d1 d3 129 | :EndIf 130 | 131 | ⍝ datatype of the data will not change under union 132 | ⍝ 326 stays 326 133 | ⍝ char + num becomes 326 134 | ⍝ char + char and num + num becomes the greater sized type 135 | r,←'Union (∪) CrossGen2'desc Assert((data){(⎕DR ⍺){326∊(⍺ ⍵):326 ⋄ 0∊≠0 2∊⍨10|(⍺ ⍵):⍺⌈⍵ ⋄ 326}⎕DR ⍵}(data2))≡⎕DR data∪data2 136 | :EndFor 137 | :EndFor 138 | :EndFor 139 | :EndFor 140 | :EndFor 141 | ∇ 142 | :EndNamespace 143 | -------------------------------------------------------------------------------- /tests/membership.apln: -------------------------------------------------------------------------------- 1 | ⍝ This Namespace includes tests for the function Membership which is represented by Dyadic Epsilon(∊) 2 | ⍝ 3 | ⍝ Membership (R←X∊Y) 4 | ⍝ An element of X is considered identical to an element in Y if X≡Y returns 1 for those elements. 5 | :Namespace membership 6 | Assert←#.unittest.Assert 7 | isDyalogClassic←#.utils.isClassic 8 | 9 | ⍝ Run Variations of each test with normal, empty and multiple shaped data 10 | ∇ {tRes}←tData RunVariations exp;actualR;actualRE;expectedR;left;right;res;tID;tCmt;lshape;lshapeW0;rshape;x;actualRM 11 | (expectedR left right)←exp 12 | (tID tCmt)←tData 13 | tRes←⍬ 14 | 15 | ⍝ normal 16 | actualR←left∊right 17 | tRes,←tData Assert expectedR≡actualR 18 | 19 | ⍝ empty left 20 | actualRE←(0⍴left)∊right ⍝ 0 in the shape means we have no elements in the array, i.e. it's empty. 21 | tRes,←('Empty',tID)tCmt Assert ⍬≡actualRE ⍝ empty array is expectedR 22 | 23 | ⍝ empty right 24 | actualRE←left∊(0⍴right) ⍝ 0 in the shape means we have no elements in the array, i.e. it's empty. 25 | tRes,←('Empty',tID)tCmt Assert(0×expectedR)≡actualRE ⍝ all 0s in expectedR is the new expected result 26 | 27 | ⍝ different shapes 28 | ⍝ for ANY array lshape, and for any rightshape where (≢right)≤×/rshape 29 | ⍝ the condition guarantees that (rshape⍴right) will create an array 30 | ⍝ which contains ALL the elements of right, possibly more than once 31 | lshape←?4/4 32 | ⍝ randomized shape which has ≤4 elements and each elements is ≤12 and satisfies above condition 33 | rshape←{(×/(x←(?4)?⍤/?12))>≢right:x ⋄ ∇ ⍵}⍬ 34 | actualRM←(lshape⍴left)∊(rshape⍴right) 35 | tRes,←('Shape',tID)tCmt Assert(lshape⍴expectedR)≡actualRM 36 | 37 | ⍝ different shapes with 0 in shape 38 | lshapeW0←(0@(?4))lshape 39 | actualRM←(lshapeW0⍴left)∊(rshape⍴right) 40 | tRes,←('ShapeW0',tID)tCmt Assert(lshapeW0⍴0)≡actualRM 41 | ∇ 42 | 43 | ⍝ Read more about DR: https://help.dyalog.com/latest/#Language/System%20Functions/Data%20Representation%20Monadic.htm 44 | ⍝ Read more about CT and DCT: https://help.dyalog.com/latest/#Language/System%20Functions/ct.htm 45 | ∇ {r}←test_membership;w;n;r;data;case;data2;case2;type;bool;i1;char0;char1;char2;i2;char3;i3;ptr;dbl;fl;cmplx;Hdbl;Hfl;Hcmplx;d;ct;fr;⎕CT;⎕DCT;⎕FR;ct_default;dct_default;fr_dbl;fr_decf;testDesc;desc 46 | ct_default←#.utils.ct_default 47 | dct_default←#.utils.dct_default 48 | fr_dbl←#.utils.fr_dbl 49 | fr_decf←#.utils.fr_decf 50 | 51 | bool←0 1 ⍝ 11: 1 bit Boolean type arrays 52 | i1←¯60+⍳120 ⍝ 83: 8 bits signed integer 53 | i2←{⍵,-⍵}10000+⍳100 ⍝ 163: 16 bits signed integer 54 | i3←{⍵,-⍵}100000+⍳100 ⍝ 323: 32 bits signed integer 55 | char0←⎕AV ⍝ 82: DyalogAPL classic char set 56 | :If ~isDyalogClassic 57 | char1←⎕UCS⍳255 ⍝ 80: 8 bits character 58 | char2←⎕UCS(1000+⍳100) ⍝ 160: 16 bits character 59 | char3←⎕UCS(100000+⍳100) ⍝ 320: 32 bits character 60 | :EndIf 61 | ptr←2,/⎕A ⍝ 326: Pointer (32-bit or 64-bit as appropriate) 62 | dbl←{⍵,-⍵}i3+0.1 ⍝ 645: 64 bits Floating 63 | cmplx←{⍵,-⍵}(0J1×⍳100)+⌽⍳100 ⍝ 1289: 128 bits Complex 64 | Hcmplx←{⍵,-⍵}(100000000000000J100000000000000×⍳20) ⍝ 1289 but larger numbers to test for CT value 65 | ⍝ Hdbl is 645 but larger numbers to test for CT value 66 | ⍝ intervals of 2 are chosen because CT for these numbers +1 and -1 67 | ⍝ come under the region of tolerant equality 68 | Hdbl←{⍵,-⍵}100000000000000+(2×⍳50) 69 | ⍝ Hfl is 1287 but larger numbers to test for CT value 70 | ⍝ far intervals are chosen for non overlap 71 | ⍝ with region of tolerant equality 72 | ⎕FR←fr_decf 73 | fl←{⍵,-⍵}i3+0.01 ⍝ 1287: 128 bits Decimal 74 | Hfl←{⍵,-⍵}200000000000000000000000000000+(10000000000000000×⍳10) 75 | ⎕FR←fr_dbl 76 | 77 | r←⍬ 78 | testDesc←{'for ',case,{0∊⍴case2:'',⍵ ⋄ ' , ',case2,⍵},' & ⎕CT ⎕DCT:',⎕CT,⎕DCT,'& ⎕FR:',⎕FR} 79 | 80 | :For ct :In 1 0 81 | (⎕CT ⎕DCT)←ct×ct_default dct_default ⍝ set comparison tolerance 82 | 83 | :For fr :In 1 2 84 | ⎕FR←fr⊃fr_dbl fr_decf 85 | 86 | :For case :In 'i1' 'i2' 'i3' 'char0' 'char1' 'char2' 'char3' 'ptr' 'dbl' 'fl' 'cmplx' 'Hdbl' 'Hfl' 'Hcmplx' 87 | :If (isDyalogClassic)∧((case≡'char1')∨(case≡'char2')∨(case≡'char3')) 88 | :Continue ⍝ Skip tests for unicode character sets in DyalogAPL classic 89 | :EndIf 90 | data←⍎case 91 | :If ⎕FR=fr_decf∧1289=⎕DR data ⍝ ⎕FR=1287 is not recommended to be used with cmplx 92 | :Continue 93 | :EndIf 94 | 95 | ⍝ Cross type tests 96 | :For case2 :In 'i1' 'i2' 'i3' 'char1' 'char2' 'char3' 'ptr' 'dbl' 'fl' 'cmplx' 'Hdbl' 'Hfl' 'Hcmplx' 97 | :If (case≡'char0')∨(isDyalogClassic)∧((case2≡'char1')∨(case2≡'char2')∨(case2≡'char3')) 98 | :Continue ⍝ char0 has overlapping elements with char1 and Skip tests for unicode character sets in DyalogAPL classic 99 | :EndIf 100 | data2←⍎case2 101 | desc←testDesc ⍬ 102 | :If (data≡data2) 103 | r,←'TCross0'desc RunVariations(1⍨¨data)data data2 104 | :Continue 105 | :EndIf 106 | r,←'TCross1'desc RunVariations(0⍨¨data)data data2 ⍝ no match, all return 0 107 | r,←'TCross2'desc RunVariations(0⍨¨data2)data2 data ⍝ no match, all return 0 108 | r,←'TCross3'desc RunVariations(1⍨¨data)data(data,data2) ⍝ first data match, returns 1 109 | r,←'TCross4'desc RunVariations((1⍨¨data),(0⍨¨data2))(data,data2)data ⍝ data match, data2 no match 110 | r,←'TCross5'desc Assert((1 1)≡(data2 data)∊(data data2)) ⍝ merge two different arrays creating a pointer array 111 | :EndFor 112 | case2←⍬ ⍝ disposing case2 for testDesc 113 | desc←testDesc ⍬ 114 | 115 | ⍝ same type tests 116 | r,←'T1'desc RunVariations 1(data[?≢data])data ⍝ random element is found 117 | r,←'T2'desc RunVariations((0⍨¨¯1↓data),1)data(¯1↑data) ⍝ All elements return 0 except last 118 | r,←'T3'desc RunVariations(1⍨¨data)data data ⍝ all elements return 1 119 | r,←'T4'desc RunVariations 0 5E50 data ⍝ huge element outside set is not found 120 | 121 | ⍝ tests with comparison tolerance 122 | d←data[?≢data] 123 | :If ct ⍝ tolerant 124 | :If (⊂data)∊Hdbl Hfl Hcmplx 125 | ⍝ Hdbl=Hdbl+1 with default CT, but not for DECF 126 | r,←'CTDefault'desc Assert((1≡(d∊d+1))∨(fr=2∧case≡'Hdbl')) 127 | :EndIf 128 | :Else ⍝ exact 129 | :If ~(⎕DR data)∊80 82 160 320 326 ⍝ non-numeric are skipped 130 | ⍝ d≠d+1 for all numeric types, except when Hfl represented as DOUB 131 | r,←'CTZero'desc Assert((0≡(d∊d+1))∨(fr=1∧case≡'Hfl')) 132 | :EndIf 133 | :EndIf 134 | :EndFor 135 | 136 | ⍝ Booleans need special tests 137 | case←'bool' 138 | desc←testDesc ⍬ 139 | 140 | r,←'TB1'desc RunVariations 1 0 0 141 | r,←'TB2'desc RunVariations 1(~0)1 142 | r,←'TB3'desc RunVariations(1 1)bool bool 143 | 144 | ⍝ Boolean cross type tests 145 | :For case2 :In 'i1' 'i2' 'i3' 'char1' 'char2' 'char3' 'ptr' 'dbl' 'fl' 'cmplx' 'Hdbl' 'Hfl' 'Hcmplx' 146 | :If (isDyalogClassic)∧((case2≡'char1')∨(case2≡'char2')∨(case2≡'char3')) 147 | :Continue ⍝ Skip tests for unicode character sets in DyalogAPL classic 148 | :EndIf 149 | data2←⍎case2 150 | desc←testDesc ⍬ 151 | :If (83≠type←⎕DR data2) ⍝ bool requires separate cross tests because of overlap with i1 152 | r,←'TCrossBool1'desc RunVariations(0⍨¨bool)bool data2 ⍝ All elements return 0 153 | r,←'TCrossBool2'desc RunVariations(0⍨¨data2)data2 bool ⍝ All elements return 0 154 | :Else 155 | r,←'TCrossBooli1'desc RunVariations(1⍨¨bool)bool data2 ⍝ All elements return 1 156 | r,←'TCrossBooli2'desc RunVariations({⍵,(⌽⍵)}((1↓((≢i1)÷2)⍴0),1))data2 bool ⍝ overlaping 0 1 returns 1 157 | :EndIf 158 | :EndFor 159 | case2←⍬ 160 | :EndFor 161 | :EndFor 162 | 163 | ∇ 164 | :EndNamespace 165 | -------------------------------------------------------------------------------- /tests/indexof.apln: -------------------------------------------------------------------------------- 1 | ⍝ This Namespace includes tests for the function Index of which is represented by Dyadic Iota(⍳) 2 | ⍝ 3 | ⍝ Index Of (R←X⍳Y) 4 | ⍝ Elements of X and Y are considered the same if X≡Y returns 1 for those elements. 5 | :Namespace indexof 6 | Assert←#.unittest.Assert 7 | isDyalogClassic←#.utils.isClassic 8 | 9 | model←{(⎕IO+1+≢⍺)-+/∨\1,⍨⍵∘.≡⍺} 10 | 11 | ⍝ Run Variations of each test with normal, empty and multiple shaped data 12 | ∇ {tRes}←tData RunVariations exp;actualR;actualRE;expectedR;left;right;res;tID;tCmt;lshape;larg;rarg;rindex;r;x;n;expectedRM;actualRM 13 | (expectedR left right)←exp 14 | (tID tCmt)←tData 15 | tRes←⍬ 16 | 17 | ⍝ normal 18 | actualR←left⍳right 19 | tRes,←tData Assert expectedR≡actualR 20 | 21 | ⍝ empty left 22 | actualRE←(0⍴left)⍳right ⍝ 0 in the shape means we have no elements in the array, i.e. it's empty. 23 | tRes,←('Empty',tID)tCmt Assert((⎕IO⍨¨expectedR))≡actualRE 24 | 25 | ⍝ different shapes 26 | lshape←(~⎕IO)+?4/3 27 | larg←lshape⍴left 28 | rindex←(⊂(?n)?n←≢larg) 29 | rarg←rindex⌷larg 30 | actualRM←larg⍳rarg 31 | :If left≡⍬ ⍝ All cells will be identical 32 | expectedRM←(≢⊃rindex)⍴⎕IO 33 | :ElseIf 11≡⎕DR left 34 | expectedRM←((⊂⍤¯1)larg)model((⊂⍤¯1)rarg) ⍝ use (slow, hungry) model 35 | :Else 36 | expectedRM←⊃rindex 37 | :EndIf 38 | tRes,←('Shape',tID)tCmt Assert expectedRM≡actualRM 39 | ∇ 40 | 41 | ∇ {r}←test_indexof;⎕CT;⎕DCT;ct;⎕FR;fr;⎕IO;io;ct_default;dct_default;fr_dbl;fr_decf;io_default;io_0;bool;i1;char0;char1;char2;i2;char3;i3;ptr;dbl;Hdbl;fl;Hfl;cmplx;Hcmplx;case;case2;data;d;data2;pos;testDesc;desc 42 | ct_default←#.utils.ct_default 43 | dct_default←#.utils.dct_default 44 | fr_dbl←#.utils.fr_dbl 45 | fr_decf←#.utils.fr_decf 46 | io_default←#.utils.io_default 47 | io_0←#.utils.io_0 48 | 49 | bool←0 1 ⍝ 11: 1 bit Boolean type arrays 50 | i1←{⍵,-⍵}⍳60 ⍝ 83: 8 bits signed integer 51 | i2←{⍵,-⍵}10000+⍳100 ⍝ 163: 16 bits signed integer 52 | i3←{⍵,-⍵}100000+⍳100 ⍝ 323: 32 bits signed integer 53 | char0←⎕AV ⍝ 82: DyalogAPL classic char set 54 | :If ~isDyalogClassic 55 | char1←⎕UCS⍳255 ⍝ 80: 8 bits character 56 | char2←⎕UCS(1000+⍳100) ⍝ 160: 16 bits character 57 | char3←⎕UCS(100000+⍳100) ⍝ 320: 32 bits character 58 | :EndIf 59 | ptr←2,/⎕A ⍝ 326: Pointer (32-bit or 64-bit as appropriate) 60 | dbl←{⍵,-⍵}1000.5+⍳100 ⍝ 645: 64 bits Floating 61 | cmplx←{⍵,-⍵}(0J1×⍳100)+⌽⍳100 ⍝ 1289: 128 bits Complex 62 | ⍝ Hdbl is 645 but larger numbers to test for CT value 63 | ⍝ intervals of 2 are chosen because CT for these numbers +1 and -1 64 | ⍝ come under the region of tolerant equality 65 | Hdbl←{⍵,-⍵}1000000000000000+(10000000000×⍳50) 66 | ⍝ Hfl is 1287 but larger numbers to test for CT value 67 | ⍝ far intervals are chosen for non overlap 68 | ⍝ with region of tolerant equality 69 | ⎕FR←fr_decf 70 | fl←{⍵,-⍵}i3+0.01 ⍝ 1287: 128 bits Decimal 71 | Hfl←{⍵,-⍵}200000000000000000000000000000+(10000000000000000×⍳10) 72 | ⎕FR←fr_dbl 73 | Hcmplx←{⍵,-⍵}(100000000000000J100000000000000×⍳20) ⍝ 1289 but larger numbers to test for CT value 74 | 75 | r←⍬ 76 | testDesc←{'for ',case,{0∊⍴case2:'',⍵ ⋄ ' , ',case2,⍵},' & ⎕CT ⎕DCT:',⎕CT,⎕DCT,'& ⎕FR:',⎕FR,'& ⎕IO:',⎕IO} 77 | 78 | :For io :In io_default io_0 79 | ⎕IO←io 80 | 81 | :For ct :In 1 0 82 | (⎕CT ⎕DCT)←ct×ct_default dct_default ⍝ set comparison tolerance 83 | 84 | :For fr :In fr_dbl fr_decf 85 | ⎕FR←fr 86 | 87 | case←'zilde' ⋄ case2←⍬ 88 | desc←testDesc ⍬ 89 | r,←'T0'desc RunVariations ⍬ ⍬ ⍬ 90 | 91 | :For case :In 'i1' 'i2' 'i3' 'char0' 'char1' 'char2' 'char3' 'ptr' 'dbl' 'fl' 'cmplx' 'Hdbl' 'Hfl' 'Hcmplx' 92 | :If (isDyalogClassic)∧((case≡'char1')∨(case≡'char2')∨(case≡'char3')) 93 | :Continue ⍝ Skip tests for unicode character sets in DyalogAPL classic 94 | :EndIf 95 | data←⍎case 96 | desc←testDesc ⍬ 97 | :If ⎕FR=fr_decf∧1289=⎕DR data ⍝ ⎕FR=1287 is not recommended to be used with cmplx 98 | :Continue 99 | :EndIf 100 | 101 | ⍝ Cross type tests 102 | :For case2 :In 'i1' 'i2' 'i3' 'char1' 'char2' 'char3' 'ptr' 'dbl' 'fl' 'cmplx' 'Hdbl' 'Hfl' 'Hcmplx' 103 | :If (case≡'char0')∨(isDyalogClassic)∧((case2≡'char1')∨(case2≡'char2')∨(case2≡'char3')) 104 | :Continue ⍝ char0 has overlapping elements with char1 and Skip tests for unicode character sets in DyalogAPL classic 105 | :EndIf 106 | data2←⍎case2 107 | desc←testDesc ⍬ 108 | :If (case≡case2) 109 | r,←'TCross0'desc RunVariations(⍳≢data)data data2 110 | :Continue 111 | :EndIf 112 | r,←'TCross1'desc RunVariations((⎕IO+⊃⍴data)⍨¨data2)data data2 ⍝ no match, all return not found 113 | r,←'TCross2'desc RunVariations((⎕IO+⊃⍴data2)⍨¨data)data2 data ⍝ no match, all return not found 114 | r,←'TCross3'desc RunVariations(⍳≢data)(data,data2)data ⍝ data match, returns index for data 115 | r,←'TCross4'desc RunVariations((⍳≢data),((⎕IO+⊃⍴data)⍨¨data2))data(data,data2) ⍝ data match, data2 no match, returns index and not found 116 | r,←'TCross5'desc Assert(((data2 data)model(data data2))≡(data2 data)⍳(data data2)) ⍝ merge two different arrays creating a pointer array 117 | :EndFor 118 | case2←⍬ ⍝ dispose case2 119 | desc←testDesc ⍬ 120 | 121 | r,←'T1'desc RunVariations(⍳≢data)data data ⍝ all elements of data are indexed 122 | r,←'T2'desc RunVariations(⎕IO+⊃⍴data)data 1E50 ⍝ random huge element is not found 123 | d←data[pos←?≢data] ⍝ element from random position is chosen 124 | r,←'T3'desc RunVariations pos data d ⍝ element from random position exists 125 | 126 | d←data[pos←?≢data] 127 | :If ct ⍝ tolerant 128 | ⍝ case for CT default & is skipped for FR=1287 129 | :If (⊂data)∊Hdbl Hfl Hcmplx 130 | ⍝ Hdbl=Hdbl+1 with default CT, but not for DECF 131 | r,←'CTDefault'desc Assert((pos≡(data⍳(d+1)))∨(fr=fr_decf∧case≡'Hdbl')) 132 | :EndIf 133 | :Else ⍝ exact 134 | :If ~(⎕DR data)∊80 82 160 320 326 ⍝ non-numeric are skipped 135 | ⍝ d≠d+1 for all numeric types, except when Hfl represented as DOUB 136 | r,←'CTZero'desc Assert((pos≢(data⍳(d+1)))∨(fr=fr_dbl∧case≡'Hfl')) 137 | :EndIf 138 | :EndIf 139 | :EndFor 140 | 141 | ⍝ Booleans need special tests 142 | case←'bool' 143 | desc←testDesc ⍬ 144 | 145 | r,←'TB1'desc RunVariations(⎕IO)bool 0 146 | r,←'TB2'desc RunVariations(⎕IO+1)bool 1 147 | r,←'TB3'desc RunVariations(⍳2)bool bool 148 | 149 | ⍝ Boolean cross type tests 150 | :For case2 :In 'i1' 'i2' 'i3' 'char0' 'char1' 'char2' 'char3' 'ptr' 'dbl' 'fl' 'cmplx' 'Hdbl' 'Hfl' 'Hcmplx' 151 | :If (isDyalogClassic)∧((case2≡'char1')∨(case2≡'char2')∨(case2≡'char3')) 152 | :Continue ⍝ Skip tests for unicode character sets in DyalogAPL classic 153 | :EndIf 154 | data2←⍎case2 155 | desc←testDesc ⍬ 156 | :If (case2≢'i1') ⍝ bool requires separate cross tests because of overlap with i1 157 | r,←'TCrossBool1'desc RunVariations((⎕IO+⊃⍴bool)⍨¨data2)bool data2 ⍝ All elements return not found 158 | r,←'TCrossBool2'desc RunVariations((⎕IO+⊃⍴data2)⍨¨bool)data2 bool ⍝ All elements return not found 159 | :Else 160 | r,←'TCrossBooli1'desc RunVariations(((⎕IO+1)@⎕IO)((⎕IO+⊃⍴bool)⍨¨data2))bool data2 ⍝ All elements return are not found except 1 161 | r,←'TCrossBooli1'desc RunVariations((⎕IO+⊃⍴data2),⎕IO)data2 bool ⍝ 0 not found, 1 found 162 | :EndIf 163 | :EndFor 164 | case2←⍬ 165 | :EndFor 166 | :EndFor 167 | :EndFor 168 | ∇ 169 | :EndNamespace 170 | -------------------------------------------------------------------------------- /tests/residue.apln: -------------------------------------------------------------------------------- 1 | ⍝ This Namespace includes tests for the function Residue which is represented by Dyadic stile(|) 2 | ⍝ 3 | ⍝ Residue (R←X|Y) 4 | ⍝ Residue is a dyadic scalar function which gives the remainder of division between two real numbers. It takes the divisor as the left argument, and the dividend as the right argument. 5 | :Namespace residue 6 | Assert←#.unittest.Assert 7 | isDyalogClassic←#.utils.isClassic 8 | 9 | model←{⍵-⍺×⌊⍵÷⍺+⍺=0} ⍝ Generator function for residue 10 | 11 | 12 | ∇ {r}←test_residue;RunVariations;r;data;case;data2;case2;type;bool;i1;i2;i3;ptr;dbl;fl;cmplx;Hdbl;Hfl;Hcmplx;d1;d2;almostd1;ct;fr;⎕CT;⎕DCT;⎕FR;ct_default;dct_default;fr_dbl;fr_decf;testDesc;desc;char0;char1;char2;char3;charptr;halfLen;case3;data3;c1;c2;f;Message 13 | ⍝ use RunVariations operator and modify it for residue 14 | RunVariations←(model #.testfns._RunVariations_|) 15 | 16 | ct_default←#.utils.ct_default 17 | dct_default←#.utils.dct_default 18 | fr_dbl←#.utils.fr_dbl 19 | fr_decf←#.utils.fr_decf 20 | 21 | bool←0 1 ⍝ 11: 1 bit Boolean type arrays 22 | i1←{⍵,0,-⍵}⍳120 ⍝ 83: 8 bits signed integer 23 | i2←{⍵,0,-⍵}10000+⍳1000 ⍝ 163: 16 bits signed integer 24 | i3←{⍵,0,-⍵}100000+⍳100 ⍝ 323: 32 bits signed integer 25 | 26 | char0←⎕AV ⍝ 82: DyalogAPL classic char set 27 | :If ~isDyalogClassic 28 | char1←⎕UCS⍳255 ⍝ 80: 8 bits character 29 | char2←⎕UCS(1000+⍳100) ⍝ 160: 16 bits character 30 | char3←⎕UCS(100000+⍳100) ⍝ 320: 32 bits character 31 | :EndIf 32 | charptr←2,/⎕A ⍝ 326: Pointer (32-bit or 64-bit as appropriate) 33 | 34 | dbl←{⍵,0,-⍵}1000.5+⍳100 ⍝ 645: 64 bits Floating 35 | ⍝ Hdbl is 645 but larger numbers 36 | Hdbl←{⍵,-⍵}100000000000000+(2×⍳50) 37 | 38 | ⍝ Hfl is 1287 but larger numbers 39 | ⎕FR←fr_decf ⍝ use ⎕FR=1287 40 | fl←{⍵,0,-⍵}1000.5+⍳100 ⍝ 1287: 128 bits Decimal 41 | Hfl←{⍵,-⍵}200000000000000000000000000000+(10000000000000000×⍳10) ⍝ 1287 but larger numbers 42 | ⎕FR←fr_dbl ⍝ revert ⎕FR=645 43 | 44 | cmplx←{(-⍵),⍵,0,(+⍵),(-+⍵)}(0J1×⍳100)+⌽⍳100 ⍝ 1289: 128 bits Complex 45 | Hcmplx←{(-⍵),⍵,(+⍵),(-+⍵)}(100000000000000J100000000000000×⍳20) ⍝ 1289 but larger numbers 46 | 47 | r←⍬ 48 | testDesc←{'for ',case,{0∊⍴case2:'',⍵ ⋄ ' , ',case2,⍵},' & ⎕CT ⎕DCT:',⎕CT,⎕DCT,'& ⎕FR:',⎕FR} 49 | 50 | :For ct :In 0 1 51 | (⎕CT ⎕DCT)←ct×ct_default dct_default ⍝ set comparison tolerance 52 | :For fr :In 2 1 53 | ⎕FR←fr⊃fr_dbl fr_decf 54 | 55 | quadparams←⎕CT ⎕DCT ⎕FR ⎕IO ⎕DIV 56 | 57 | ⍝ Tests added to achieve complete code coverage 58 | case←'independant' 59 | case2←⍬ 60 | desc←testDesc ⍬ 61 | r,←'Ti1'desc quadparams RunVariations(0 model 11)0 11 ⍝ Special optimization for scalar 0 from iresidue at apl/allos/src/scalarscalar.cpp#L518 62 | r,←'Ti2'desc quadparams RunVariations(¯1 model 11)¯1 11 ⍝ Special optimization for scalar ¯1 from iresidue at apl/allos/src/scalarscalar.cpp#L518 63 | r,←'Ti3'desc Assert(2/(2 model 1J1))≡(2|2/1J1) ⍝ Special optimization for scans from code around apl/allos/src/arith_su.c#L1241 64 | r,←'Ti4'desc Assert(2/0)≡(2|2/1E40) ⍝ Special optimization for scans from code around apl/allos/src/arith_su.c#L1241 65 | 66 | :For case :In 'i1' 'i2' 'i3' 'dbl' 'Hdbl' 'fl' 'Hfl' 'cmplx' 'Hcmplx' 67 | data←⍎case 68 | ⍝ Cross type tests 69 | :For case2 :In 'i1' 'i2' 'i3' 'dbl' 'fl' 70 | data2←⍎case2 71 | :If (⊂data)∊cmplx Hdbl Hfl Hcmplx 72 | :Continue 73 | :EndIf 74 | desc←testDesc ⍬ 75 | :If (data≡data2) 76 | r,←'TCross0'desc quadparams RunVariations(0⍨¨data)data data2 77 | :Continue 78 | :EndIf 79 | data2←(≢data)↑data2 ⍝ strip data2 to be equal length to data 80 | r,←'TCross1'desc quadparams RunVariations(data model data2)data data2 81 | r,←'TCross2'desc quadparams RunVariations(data2 model data)data2 data 82 | r,←'TCross3'desc Assert(((data2 data)model(data data2))≡(data2 data)|(data data2)) ⍝ merge two different arrays creating a pointer array 83 | :EndFor 84 | 85 | case2←⍬ ⍝ disposing case2 for testDesc 86 | desc←testDesc ⍬ 87 | 88 | r,←'T1'desc quadparams RunVariations(data model⌽data)data(⌽data) ⍝ generator func finds results on array 89 | d1←data[?≢data] 90 | d2←data[?≢(data~d1)] 91 | r,←'T2'desc quadparams RunVariations(d1 model d2)d1 d2 ⍝ generator func finds results on single element 92 | r,←'T3'desc quadparams RunVariations(0⍨¨data)1(⌊data) ⍝ check remainder with 1 result is a defined output 93 | 94 | :If (⊂data)∊i1 i2 i3 95 | halfLen←(¯1+≢data)÷2 96 | r,←'TSeq2'desc quadparams RunVariations({⍵,(⌽⍵),0}halfLen⍴(⍳9),0)10 data ⍝ sequences to test functionality of residue 97 | r,←'TSeq1'desc quadparams RunVariations({⍵,(⌽⍵),0}halfLen⍴1 2 3 0)4 data ⍝ remainder sequence is ⍳(N-1), 0 98 | :EndIf 99 | 100 | :If case≡'dbl' 101 | halfLen←(¯1+≢data)÷2 102 | r,←'TSeqDbl1'desc quadparams RunVariations({⍵,0,(2↓⌽⍵),0.5,3.5}halfLen⍴(1.5 2.5 3.5 0.5))4 data ⍝ sequences to test functionality of residue 103 | r,←'TSeqDbl2'desc quadparams RunVariations({⍵,0,(2↓⌽⍵),0.5,9.5}halfLen⍴(0.5+⍳9),0.5)10 data ⍝ sequences to test functionality of residue 104 | :EndIf 105 | 106 | ⍝ tests with comparison tolerance 107 | almostd1←d1×1-fr⊃0.01×ct_default dct_default ⍝ infinitesimally close to d1 but smaller 108 | :If ct ⍝ tolerant 109 | :If (⊂data)∊Hdbl Hfl Hcmplx ⍝ bigger numbers 110 | ⍝ Hdbl=Hdbl+1 with default CT, but not for DECF (similar for Hcmplx) 111 | r,←'CTDefault'desc Assert((0≡(d1|d1+1))∨(fr=2∧(case≡'Hdbl')∨(case≡'Hcmplx'))) 112 | :Else ⍝ other than bigger numbers 113 | r,←'CTDefaultAlmost1'desc Assert 0≡d1|almostd1 ⍝ No difference because tolerantly equal 114 | r,←'CTDefaultAlmost2'desc Assert 0≡almostd1|d1 ⍝ Same as above but flipped 115 | :EndIf 116 | :Else ⍝ exact 117 | ⍝ d≠d+1 for all numeric types, except when Hfl represented as DOUB 118 | ⍝ if cmplx then generator function elseif negative then ⍵+1 else 1 because of 0 tolerance 119 | r,←'CTZero'desc Assert(({⊢≠+⍵:d1 model d1+1 ⋄ 1+0≤⍵⊃⍵+1 1}d1)≡d1|d1+1)∨(fr=1∧case≡'Hfl') 120 | 121 | ⍝ |, ⌈ and ⌊ are added to it for getting a fixed result 122 | r,←'CTZeroAlmost1'desc Assert(0≡⌊|almostd1|d1)∨(fr=1∧case≡'Hfl') 123 | r,←'CTZeroAlmost2'desc Assert((⌈|d1)≡⌈|d1|almostd1)∨(fr=1∧case≡'Hfl')∨(1289≡⎕DR data) 124 | :EndIf 125 | 126 | ⍝ tests for known errors 127 | :For case3 :In 'char1' 'char2' 'char3' 'char0' 'charptr' 128 | :If (isDyalogClassic)∧(case≢'char0')∧(case≢'ptr') 129 | :Continue ⍝ Skip tests for unicode character sets in DyalogAPL classic 130 | :EndIf 131 | data3←⍎case3 132 | desc←testDesc ⍬ 133 | c1←data3[?≢data3] 134 | c2←(data3~c1)[?¯1+≢data3] 135 | 136 | f←0 ⍝ flag 137 | :Trap 11 ⍝ 11: Domain error 138 | c1|c2 ⍝ N/A type ÷ N/A type 139 | :Else 140 | f←1 141 | r,←'TDomainE2'desc Assert(f∧⎕DMX.Message≡'') ⍝ check for error and dmx message 142 | :EndTrap 143 | 144 | f←0 ⍝ flag 145 | :Trap 11 ⍝ 11: Domain error 146 | d1÷c2 ⍝ Number type ÷ N/A type 147 | :Else 148 | f←1 149 | r,←'TDomainE3'desc Assert(f∧⎕DMX.Message≡'') ⍝ check for error and dmx message 150 | :EndTrap 151 | 152 | f←0 ⍝ flag 153 | :Trap 11 ⍝ 11: Domain error 154 | c1÷d1 ⍝ N/A type ÷ number type 155 | :Else 156 | f←1 157 | r,←'TDomainE4'desc Assert(f∧⎕DMX.Message≡'') ⍝ check for error and dmx message 158 | :EndTrap 159 | :EndFor 160 | :EndFor 161 | :EndFor 162 | :EndFor 163 | ∇ 164 | 165 | :EndNamespace 166 | -------------------------------------------------------------------------------- /tests/uniquemask.apln: -------------------------------------------------------------------------------- 1 | :Namespace uniquemask 2 | Assert←#.unittest.Assert 3 | isDyalogClassic←#.utils.isClassic 4 | doSlowTests←#.utils.doSlowTests 5 | ⍝ util functions 6 | shuffle←#.utils.shuffle 7 | intertwine←#.utils.intertwine 8 | hashArray←#.utils.hashArray 9 | 10 | ⍝ model ← { ⍝ from aplwiki nubsieve page ⍝ does not work if shape has a 0 11 | ⍝ ⎕IO←0 12 | ⍝ notin ← (⍳=≢⍤⊣)⍨ 13 | ⍝ x ← 1/⍵ ⍝ Treat scalar as vector 14 | ⍝ m ← ⍬ ⍝ Initial mask 15 | ⍝ m ⊣ {m,←(⍵⌷x) notin m⌿⍵↑x}¨ ⍳≢x 16 | ⍝ } 17 | modelUnique←{0=≢⍵:⍵ ⋄ ↑,⊃{⍺,(∧/⍺≢¨⍵)/⍵}⍨/⌽⊂¨⊂⍤¯1⊢⍵} ⍝ from tests/unique.apln 18 | model←(⍳⍤≢=⍳⍨)⍤(modelUnique⍳1/⊢) 19 | 20 | ∇ {tRes}←tData RunVariations exp;actualR;actualRE;expectedR;expectedRE;ele;rarg;tID;tCmt;shape;actualRS;shapeW0;actualRSW0;expectedRS;expectedRSW0;actualRSc;expectedRSc 21 | (expectedR rarg)←exp 22 | (tID tCmt)←tData 23 | tRes←⍬ 24 | 25 | ⍝ normal 26 | actualR←≠rarg 27 | tRes,←tData Assert expectedR≡actualR 28 | 29 | ⍝ scalar 30 | ele←(?∘≢⊃⊢)rarg 31 | actualRSc←≠ele 32 | expectedRSc←(,1⍨¨ele) 33 | tRes,←('Scalar',tID)tCmt Assert expectedRSc≡actualRSc 34 | 35 | ⍝ empty 36 | actualRE←≠0⍴rarg ⍝ 0 in the shape means we have no elements in the array, i.e. it's empty. 37 | expectedRE←0∘⌿expectedR ⍝ empty array along first axis 38 | tRes,←('Empty',tID)tCmt Assert expectedRE≡actualRE ⍝ empty array is expectedR 39 | 40 | ⍝ different shapes 41 | shape←?(?4)/4 42 | actualRS←≠(shape⍴rarg) 43 | expectedRS←model shape⍴rarg 44 | tRes,←('Multiple',tID)tCmt Assert expectedRS≡actualRS 45 | 46 | ⍝ different shapes with 0 in shape 47 | shapeW0←(0@(?(≢shape)))shape 48 | actualRSW0←≠shapeW0⍴rarg 49 | expectedRSW0←model shapeW0⍴rarg 50 | tRes,←('ShapeW0',tID)tCmt Assert expectedRSW0≡actualRSW0 51 | ∇ 52 | 53 | ∇ {r}←test_uniquemask;ct_default;dct_default;fr_dbl;fr_decf;bool;i1;char0;char1;char2;i2;char3;i3;ptr;dbl;cmplx;Hcmplx;Hdbl;Sdbl;⎕FR;fl;Hfl;testDesc;case;case2;desc;ct;⎕CT;⎕DCT;fr;u;s;x;data;data2;shuffledData;repetitions;shuffledRepeatedData;d1;almostd1S;almostd1B;d 54 | ct_default←#.utils.ct_default 55 | dct_default←#.utils.dct_default 56 | fr_dbl←#.utils.fr_dbl 57 | fr_decf←#.utils.fr_decf 58 | 59 | ⍝ All data generated is unique 60 | bool←0 1 ⍝ 11: 1 bit Boolean type arrays 61 | i1←¯60+⍳120 ⍝ 83: 8 bits signed integer 62 | i2←{⍵,-⍵}10000+⍳100 ⍝ 163: 16 bits signed integer 63 | i3←{⍵,-⍵}100000+⍳100 ⍝ 323: 32 bits signed integer 64 | char0←⎕AV ⍝ 82: DyalogAPL classic char set 65 | :If ~isDyalogClassic 66 | char1←⎕UCS(100+⍳100) ⍝ 80: 8 bits character 67 | char2←⎕UCS(1000+⍳100) ⍝ 160: 16 bits character 68 | char3←⎕UCS(100000+⍳100) ⍝ 320: 32 bits character 69 | :EndIf 70 | ptr←(13↑⎕A)(13↓⎕A) ⍝ 326: Pointer (32-bit or 64-bit as appropriate) 71 | dbl←{⍵,-⍵}i3+0.1 ⍝ 645: 64 bits Floating 72 | cmplx←{⍵,-⍵}(0J1×⍳100)+⌽⍳100 ⍝ 1289: 128 bits Complex 73 | Hcmplx←{⍵,-⍵}(100000000000000J100000000000000×⍳20) ⍝ 1289 but larger numbers to test for CT value 74 | ⍝ Hdbl is 645 but larger numbers to test for CT value 75 | ⍝ intervals of 2 are chosen because CT for these numbers +1 and -1 76 | ⍝ come under the region of tolerant equality 77 | Hdbl←{⍵,-⍵}100000000000000+(2×⍳50) 78 | 79 | ⍝ This is needed for a case that can be hit if we have a lot of small numbers 80 | ⍝ which produce a hash collision 81 | ⍝ Occurrence: same.c.html#L1153 82 | Sdbl←{⍵,-⍵}(⍳500)÷1000 83 | 84 | ⍝ Hfl is 1287 but larger numbers to test for CT value 85 | ⍝ far intervals are chosen for non overlap 86 | ⍝ with region of tolerant equality 87 | ⎕FR←fr_decf 88 | fl←{⍵,-⍵}i3+0.01 ⍝ 1287: 128 bits Decimal 89 | Hfl←{⍵,-⍵}200000000000000000000000000000+(10000000000000000×⍳10) 90 | ⎕FR←fr_dbl 91 | 92 | r←⍬ 93 | testDesc←{'for ',case,{0∊⍴case2:'',⍵ ⋄ ' , ',case2,⍵},' & ⎕CT ⎕DCT:',⎕CT,⎕DCT,'& ⎕FR:',⎕FR} 94 | 95 | case←⍬ 96 | case2←⍬ 97 | desc←testDesc ⍬ 98 | 99 | :For ct :In 0 1 100 | (⎕CT ⎕DCT)←ct×ct_default dct_default ⍝ set comparison tolerance 101 | 102 | :For fr :In 2 1 103 | ⎕FR←fr⊃fr_dbl fr_decf 104 | 105 | ⍝ Independant code coverage based (more information in decision docs) 106 | :For (u s) :In (2 10)(2 256)(10 10)(10 256)(256 256)(65536 65536) 107 | :If (~doSlowTests)∧(u≡65536) 108 | :Continue ⍝ Skip one case because it takes 4 minutes each when no Slow_QA 109 | :EndIf 110 | case←u s 111 | desc←testDesc ⍬ 112 | x←s 2⍴?u⍴0 113 | r,←'TICC1'desc Assert(model x)≡(≠x) 114 | :EndFor 115 | 116 | :For case :In 'bool' 'i1' 'i2' 'i3' 'char1' 'char2' 'char3' 'ptr' 'dbl' 'fl' 'cmplx' 'Hdbl' 'Sdbl' 'Hfl' 'Hcmplx' 117 | :If (isDyalogClassic)∧((case≡'char1')∨(case≡'char2')∨(case≡'char3')) 118 | :Continue ⍝ Skip tests for unicode character sets in DyalogAPL classic 119 | :EndIf 120 | data←⍎case 121 | desc←testDesc ⍬ 122 | 123 | ⍝ General tests to test the basic rules of uniquemask 124 | r,←'TGen1'desc Assert(≢data)≥≢≠data ⍝ uniquemask cannot return a result that is exceding the number of elements than the input 125 | r,←'TGen2'desc Assert 11≡⎕DR≠data intertwine data ⍝ datatype of the result will always be boolean 126 | 127 | :For case2 :In 'i1' 'i2' 'i3' 'char1' 'char2' 'char3' 'ptr' 'dbl' 'fl' 'cmplx' 'Hdbl' 'Hfl' 'Hcmplx' 128 | :If (case≡'char0')∨(isDyalogClassic)∧((case2≡'char1')∨(case2≡'char2')∨(case2≡'char3')) 129 | :Continue ⍝ char0 has overlapping elements with char1 and Skip tests for unicode character sets in DyalogAPL classic 130 | :EndIf 131 | data2←⍎case2 132 | desc←testDesc ⍬ 133 | :If (case≡case2)∨(case≡'bool') ⍝ skipping bool because of overlap with i1 134 | :Continue 135 | :EndIf 136 | r,←'TCross1'desc RunVariations(1⍨¨data,data2)(data,data2) ⍝ all elements are concatenated 137 | r,←'TCross2'desc RunVariations(model(2/data)intertwine(2/data2))((2/data)intertwine(2/data2)) ⍝ all elements are doubled & perfectly intertwined 138 | r,←'TCross3'desc Assert(model(data data2))≡≠(data data2) ⍝ TCross1 but with ptr arrays 139 | 140 | ⍝ datatype of the result will always be boolean 141 | r,←'TGen3'desc Assert 11≡⎕DR≠data intertwine data2 142 | :EndFor 143 | 144 | case2←⍬ ⍝ dispose case2 145 | desc←testDesc ⍬ 146 | 147 | r,←'T1'desc RunVariations(1⍨¨data)data ⍝ all elements of data are unique 148 | r,←'T2'desc RunVariations((1⍨¨data),0⍨¨data)(data,data) ⍝ all elements of data are repeated sequentially 149 | r,←'T3'desc RunVariations((1⍨¨data)intertwine(0⍨¨data))(data intertwine data) ⍝ all elements are perfectly intertwined 150 | r,←'T4'desc RunVariations((1⍨¨data)intertwine(0⍨¨data))(hashArray data intertwine data) ⍝ using a pre-hashed array on intertwined data 151 | 152 | shuffledData←↑shuffle data 153 | r,←'T5'desc RunVariations(model shuffledData)shuffledData ⍝ shuffle data without creating duplicate data 154 | 155 | repetitions←?6 156 | shuffledRepeatedData←↑shuffle repetitions/data 157 | r,←'T6'desc RunVariations(model shuffledRepeatedData)shuffledRepeatedData ⍝ duplicate and shuffle 158 | 159 | ⍝ tests with comparison tolerance 160 | :If ~(⎕DR data)∊80 82 160 320 326 ⍝ non-numeric are skipped 161 | d1←(data~0)[?≢data~0] ⍝ 0 interferes with the calculations of almostd1S and almostd1B hence it is removed 162 | almostd1S←d1×1-fr⊃0.01×ct_default dct_default ⍝ infinitesimally close to d1 but smaller 163 | almostd1B←d1×1+fr⊃0.1×ct_default dct_default ⍝ infinitesimally close to d1 but bigger 164 | :If ct ⍝ tolerant 165 | :If (⊂data)∊Hdbl Hfl Hcmplx ⍝ bigger numbers 166 | ⍝ Hdbl=Hdbl+1 with default CT, but not for DECF 167 | r,←'CTDefault1'desc Assert(((1 0)≡≠d1,d1+1)∨((fr=2)∧case≡'Hdbl')) 168 | :Else ⍝ other than bigger numbers 169 | r,←'CTDefault2'desc Assert((1 1)≡≠d1,d1+1) ⍝ not tolerantly equal for other numbers 170 | r,←'CTDefaultAlmostS'desc Assert((1 0)≡≠d1,almostd1S) ⍝ d1 and almostd1S are tolerantly equal 171 | r,←'CTDefaultAlmostB'desc Assert((1 0)≡≠d1,almostd1B) ⍝ d1 and almostd1B are tolerantly equal 172 | :EndIf 173 | :Else ⍝ exact 174 | ⍝ d≠d+1 for all numeric types 175 | r,←'CTZero'desc Assert(((1,1)≡≠d1,d1+1)∨((fr=1)∧case≡'Hfl')) 176 | r,←'CTZeroAlmostS'desc Assert(((1,1)≡≠d1,almostd1S)∨((fr=2)∧1289≡⎕DR d1)) ⍝ due to limited precision of IEEE 745 doubles cmplx is ignored with ⎕fr←1287 177 | r,←'CTZeroAlmostB'desc Assert(((1,1)≡≠d1,almostd1B)∨((fr=2)∧1289≡⎕DR d1)) ⍝ due to limited precision of IEEE 745 doubles cmplx is ignored with ⎕fr←1287 178 | :EndIf 179 | :EndIf 180 | :EndFor 181 | ⍝ Independant tests 182 | case←'independant' 183 | case2←⍬ 184 | desc←testDesc ⍬ 185 | 186 | ⍝ The special case can be hit if we have two 8 bit int numbers in the input: a & b, and a is b-⎕CT. 187 | ⍝ That means, that when we get to element b in the loop, we will find element a and hit the case. 188 | ⍝ Occurrence: same.c.html#L1152 189 | d←i1[?≢i1] 190 | r,←'TCTI1'desc Assert(1 0)≡(≠(d-({fr-1:⎕DCT ⋄ ⎕CT}⍬))d) 191 | :EndFor 192 | :EndFor 193 | ∇ 194 | :EndNamespace 195 | -------------------------------------------------------------------------------- /tests/unique.apln: -------------------------------------------------------------------------------- 1 | :Namespace unique 2 | Assert←#.unittest.Assert 3 | isDyalogClassic←#.utils.isClassic 4 | doSlowTests←#.utils.doSlowTests 5 | ⍝ util functions 6 | shuffle←#.utils.shuffle 7 | intertwine←#.utils.intertwine 8 | hashArray←#.utils.hashArray 9 | 10 | ⍝ modelUnion←{⍺,(∧/⍺≢¨⍵)/⍵} ⍝ model function for union (X∪Y) (used to model unique) 11 | model←{0=≢⍵:⍵ ⋄ ↑,⊃{⍺,(∧/⍺≢¨⍵)/⍵}⍨/⌽⊂¨⊂⍤¯1⊢⍵} ⍝ model function for unique 12 | 13 | ∇ {tRes}←tData RunVariations exp;actualR;actualRE;expectedR;expectedRE;ele;rarg;tID;tCmt;shape;actualRS;shapeW0;actualRSW0;expectedRS;expectedRSW0;actualRSc;expectedRSc 14 | (expectedR rarg)←exp 15 | (tID tCmt)←tData 16 | tRes←⍬ 17 | 18 | ⍝ normal 19 | actualR←∪rarg 20 | tRes,←tData Assert expectedR≡actualR 21 | 22 | ⍝ scalar 23 | ele←(?∘≢⊃⊢)rarg 24 | actualRSc←∪ele 25 | expectedRSc←,ele 26 | tRes,←('Scalar',tID)tCmt Assert expectedRSc≡actualRSc 27 | 28 | ⍝ empty 29 | actualRE←∪0⍴rarg ⍝ 0 in the shape means we have no elements in the array, i.e. it's empty. 30 | expectedRE←0∘⌿expectedR ⍝ empty array along first axis 31 | tRes,←('Empty',tID)tCmt Assert expectedRE≡actualRE ⍝ empty array is expectedR 32 | 33 | ⍝ ⍝ different shapes 34 | shape←?(?4)/4 35 | actualRS←∪(shape⍴rarg) 36 | expectedRS←model shape⍴rarg 37 | tRes,←('Multiple',tID)tCmt Assert expectedRS≡actualRS 38 | 39 | ⍝ different shapes with 0 in shape 40 | shapeW0←(0@(?(≢shape)))shape 41 | actualRSW0←∪shapeW0⍴rarg 42 | expectedRSW0←model shapeW0⍴rarg 43 | tRes,←('ShapeW0',tID)tCmt Assert expectedRSW0≡actualRSW0 44 | ∇ 45 | 46 | ∇ {r}←test_unique;ct_default;dct_default;fr_dbl;fr_decf;bool;i1;char0;char1;char2;i2;char3;i3;ptr;dbl;Hdbl;Sdbl;cmplx;Hcmplx;fl;Hfl;⎕FR;⎕CT;⎕DCT;testDesc;case;case2;desc;ct;fr;data;data2;shuffledData;repetitions;shuffledRepeatedData;d1;almostd1S;almostd1B;d;u;s;x 47 | ct_default←#.utils.ct_default 48 | dct_default←#.utils.dct_default 49 | fr_dbl←#.utils.fr_dbl 50 | fr_decf←#.utils.fr_decf 51 | 52 | ⍝ All data generated is unique 53 | bool←0 1 ⍝ 11: 1 bit Boolean type arrays 54 | i1←¯60+⍳120 ⍝ 83: 8 bits signed integer 55 | i2←{⍵,-⍵}10000+⍳100 ⍝ 163: 16 bits signed integer 56 | i3←{⍵,-⍵}100000+⍳100 ⍝ 323: 32 bits signed integer 57 | char0←⎕AV ⍝ 82: DyalogAPL classic char set 58 | :If ~isDyalogClassic 59 | char1←⎕UCS(100+⍳100) ⍝ 80: 8 bits character 60 | char2←⎕UCS(1000+⍳100) ⍝ 160: 16 bits character 61 | char3←⎕UCS(100000+⍳100) ⍝ 320: 32 bits character 62 | :EndIf 63 | ptr←(13↑⎕A)(13↓⎕A) ⍝ 326: Pointer (32-bit or 64-bit as appropriate) 64 | dbl←{⍵,-⍵}i3+0.1 ⍝ 645: 64 bits Floating 65 | cmplx←{⍵,-⍵}(0J1×⍳100)+⌽⍳100 ⍝ 1289: 128 bits Complex 66 | Hcmplx←{⍵,-⍵}(100000000000000J100000000000000×⍳20) ⍝ 1289 but larger numbers to test for CT value 67 | ⍝ Hdbl is 645 but larger numbers to test for CT value 68 | ⍝ intervals of 2 are chosen because CT for these numbers +1 and -1 69 | ⍝ come under the region of tolerant equality 70 | Hdbl←{⍵,-⍵}100000000000000+(2×⍳50) 71 | 72 | ⍝ This is needed for a case that can be hit if we have a lot of small numbers 73 | ⍝ which produce a hash collision 74 | ⍝ Occurrence: same.c.html#L1153 75 | Sdbl←{⍵,-⍵}(⍳500)÷1000 76 | 77 | ⍝ Hfl is 1287 but larger numbers to test for CT value 78 | ⍝ far intervals are chosen for non overlap 79 | ⍝ with region of tolerant equality 80 | ⎕FR←fr_decf 81 | fl←{⍵,-⍵}i3+0.01 ⍝ 1287: 128 bits Decimal 82 | Hfl←{⍵,-⍵}200000000000000000000000000000+(10000000000000000×⍳10) 83 | ⎕FR←fr_dbl 84 | 85 | r←⍬ 86 | testDesc←{'for ',case,{0∊⍴case2:'',⍵ ⋄ ' , ',case2,⍵},' & ⎕CT ⎕DCT:',⎕CT,⎕DCT,'& ⎕FR:',⎕FR} 87 | 88 | case←⍬ 89 | case2←⍬ 90 | desc←testDesc ⍬ 91 | 92 | :For ct :In 0 1 93 | (⎕CT ⎕DCT)←ct×ct_default dct_default ⍝ set comparison tolerance 94 | 95 | :For fr :In 2 1 96 | ⎕FR←fr⊃fr_dbl fr_decf 97 | 98 | ⍝ Independant code coverage based (more information in decision docs) 99 | :For (u s) :In (2 10)(2 256)(10 10)(10 256)(256 256)(65536 65536) 100 | :If (~doSlowTests)∧(u≡65536) 101 | :Continue ⍝ Skip one case because it takes 4 minutes each when no Slow_QA 102 | :EndIf 103 | case←u s 104 | desc←testDesc ⍬ 105 | x←s 2⍴?u⍴0 106 | r,←'TICC1'desc Assert(model x)≡(∪x) 107 | :EndFor 108 | 109 | :For case :In 'bool' 'i1' 'i2' 'i3' 'char0' 'char1' 'char2' 'char3' 'ptr' 'dbl' 'fl' 'cmplx' 'Hdbl' 'Sdbl' 'Hfl' 'Hcmplx' 110 | :If (isDyalogClassic)∧((case≡'char1')∨(case≡'char2')∨(case≡'char3')) 111 | :Continue ⍝ Skip tests for unicode character sets in DyalogAPL classic 112 | :EndIf 113 | data←⍎case 114 | desc←testDesc ⍬ 115 | 116 | ⍝ General tests to test the basic rules of unique 117 | r,←'TGen1'desc Assert(≢data)≥≢∪data ⍝ unique cannot return a result that is exceding the number of elements than the input 118 | r,←'TGen2'desc Assert(⎕DR data)≡⎕DR∪data intertwine data ⍝ datatype of the data will not change under unique 119 | 120 | :For case2 :In 'i1' 'i2' 'i3' 'char1' 'char2' 'char3' 'ptr' 'dbl' 'fl' 'cmplx' 'Hdbl' 'Hfl' 'Hcmplx' 121 | :If (case≡'char0')∨(isDyalogClassic)∧((case2≡'char1')∨(case2≡'char2')∨(case2≡'char3')) 122 | :Continue ⍝ char0 has overlapping elements with char1 and Skip tests for unicode character sets in DyalogAPL classic 123 | :EndIf 124 | data2←⍎case2 125 | desc←testDesc ⍬ 126 | :If (case≡case2)∨(case≡'bool') ⍝ skipping bool because of overlap with i1 127 | :Continue 128 | :EndIf 129 | r,←'TCross1'desc RunVariations(data,data2)(data,data2) ⍝ all elements are concatenated 130 | r,←'TCross2'desc RunVariations(data intertwine data2)((2/data)intertwine(2/data2)) ⍝ all elements are doubled & perfectly intertwined 131 | r,←'TCross3'desc Assert(model(data data2))≡∪(data data2) ⍝ TCross1 but with ptr arrays 132 | 133 | ⍝ datatype of the data will not change under unique 134 | ⍝ 326 stays 326 135 | ⍝ char + num becomes 326 136 | ⍝ char + char and num + num becomes the greater sized type 137 | r,←'TGen3'desc Assert((data){(⎕DR ⍺){326∊(⍺ ⍵):326 ⋄ 0∊≠0 2∊⍨10|(⍺ ⍵):⍺⌈⍵ ⋄ 326}⎕DR ⍵}(data2))≡⎕DR∪data intertwine data2 138 | :EndFor 139 | 140 | case2←⍬ ⍝ dispose case2 141 | desc←testDesc ⍬ 142 | 143 | r,←'T1'desc RunVariations data data ⍝ all elements of data are unique 144 | r,←'T2'desc RunVariations data(data,data) ⍝ all elements of data are repeated sequentially 145 | r,←'T3'desc RunVariations data(data intertwine data) ⍝ all elements are perfectly intertwined 146 | r,←'T4'desc RunVariations data(hashArray data intertwine data) ⍝ using a pre-hashed array on intertwined data 147 | 148 | shuffledData←↑shuffle data 149 | r,←'T5'desc RunVariations(model shuffledData)shuffledData ⍝ shuffle data without creating duplicate data 150 | 151 | repetitions←?6 152 | shuffledRepeatedData←↑shuffle repetitions/data 153 | r,←'T6'desc RunVariations(model shuffledRepeatedData)shuffledRepeatedData ⍝ duplicate and shuffle 154 | 155 | ⍝ tests with comparison tolerance 156 | :If ~(⎕DR data)∊80 82 160 320 326 ⍝ non-numeric are skipped 157 | d1←(data~0)[?≢data~0] ⍝ 0 interferes with the calculations of almostd1S and almostd1B hence it is removed 158 | almostd1S←d1×1-fr⊃0.01×ct_default dct_default ⍝ infinitesimally close to d1 but smaller 159 | almostd1B←d1×1+fr⊃0.1×ct_default dct_default ⍝ infinitesimally close to d1 but bigger 160 | :If ct ⍝ tolerant 161 | :If (⊂data)∊Hdbl Hfl Hcmplx ⍝ bigger numbers 162 | ⍝ Hdbl=Hdbl+1 with default CT, but not for DECF 163 | r,←'CTDefault1'desc Assert(((,d1)≡∪d1,d1+1)∨((fr=2)∧case≡'Hdbl')) 164 | :Else ⍝ other than bigger numbers 165 | r,←'CTDefault2'desc Assert((d1,d1+1)≡∪d1,d1+1) ⍝ not tolerantly equal for other numbers 166 | r,←'CTDefaultAlmostS'desc Assert((,d1)≡∪d1,almostd1S) ⍝ d1 and almostd1S are tolerantly equal 167 | r,←'CTDefaultAlmostB'desc Assert((,d1)≡∪d1,almostd1B) ⍝ d1 and almostd1B are tolerantly equal 168 | :EndIf 169 | :Else ⍝ exact 170 | ⍝ d≠d+1 for all numeric types 171 | r,←'CTZero'desc Assert(((d1,d1+1)≡∪d1,d1+1)∨((fr=1)∧case≡'Hfl')) 172 | r,←'CTZeroAlmostS'desc Assert(((d1,almostd1S)≡∪d1,almostd1S)∨((fr=2)∧1289≡⎕DR d1)) ⍝ due to limited precision of IEEE 745 doubles cmplx is ignored with ⎕fr←1287 173 | r,←'CTZeroAlmostB'desc Assert(((d1,almostd1B)≡∪d1,almostd1B)∨((fr=2)∧1289≡⎕DR d1)) ⍝ due to limited precision of IEEE 745 doubles cmplx is ignored with ⎕fr←1287 174 | :EndIf 175 | :EndIf 176 | :EndFor 177 | 178 | ⍝ Independant tests 179 | case←'independant' 180 | case2←⍬ 181 | desc←testDesc ⍬ 182 | 183 | ⍝ Generating singleton scalar boolean using ∧/1 0 1 0 and ∧/1 1 1 1 184 | ⍝ 2/ to generate a bool vector that gives one result element when ∪ is applied 185 | r,←'TboolI1'desc Assert(,0)≡∪2/∧/1 0 1 0 186 | r,←'TboolI2'desc Assert(,1)≡∪2/∧/1 1 1 1 187 | 188 | ⍝ The special case can be hit if we have two 8 bit int numbers in the input: a & b, and a is b-⎕CT. 189 | ⍝ That means, that when we get to element b in the loop, we will find element a and hit the case. 190 | ⍝ Occurrence: same.c.html#L1152 191 | d←i1[?≢i1] 192 | r,←'TCTI1'desc Assert(,d-({fr-1:⎕DCT ⋄ ⎕CT}⍬))≡(∪(d-({fr-1:⎕DCT ⋄ ⎕CT}⍬))d) 193 | :EndFor 194 | :EndFor 195 | ∇ 196 | 197 | :EndNamespace 198 | -------------------------------------------------------------------------------- /tests/floor.apln: -------------------------------------------------------------------------------- 1 | :Namespace floor 2 | Assert←#.unittest.Assert 3 | isDyalogClassic←#.utils.isClassic 4 | 5 | ⍝ Generator function for floor 6 | ⍝ Using strings to calculate floor of a number 7 | ⍝ Other approaches included using {⍵-(1|⍵)} but residue uses floor in its derivation so can be conflicting 8 | ⍝ Approach 2 was using binary conversion and stripping decimals similar to the string approach, but the sources use something similar 9 | ⍝ The string approach is good because it deals with floor in a very non-co-related way so it can never be clashing 10 | ⍝ All cases: 11 | ⍝ neg dotPos juststrip 12 | ⍝ 0 1 1 123.32→123 13 | ⍝ 0 0 1 123→123 14 | ⍝ 1 1 0 ¯123.32→¯124 15 | ⍝ 1 0 1 ¯123→¯123 16 | modelFloor←{ 17 | ⎕PP←34 ⍝ set to max as we are using strings, the execute and format primitives round the number to the ⎕pp value 18 | dotPos←⍸,'.'⍷⍕⍵ ⍝ convert num to string and get position of the decimal point 19 | int←⍎(⍕⍵)↑⍨¯1+dotPos ⍝ strip integer based on the decimal point 20 | int-(⍵<0)∧(~0∊⍴dotPos) ⍝ Subtract 1 only when negative+non int component exists. eg: ¯123.32→¯124 21 | } 22 | ⍝ modelFloor←{(⍎(⍕⍵)↑⍨¯1+⍸,'.'⍷(⍕⍵))-(⍵<0)∧(~0∊⍴(⍸,'.'⍷(⍕⍵)))} 23 | 24 | ⍝ Generator function for complex floor 25 | ⍝ interpreted from: https://aplwiki.com/wiki/Complex_floor 26 | modelCmpxFloor←{ 27 | r←9○⍵ 28 | i←11○⍵ 29 | b←(modelFloor r)+0J1×modelFloor i 30 | x←r-modelFloor r 31 | y←i-modelFloor i 32 | 1>x+y:b 33 | x≥y:b+1 34 | b+0J1 35 | } 36 | 37 | 38 | ∇ {r}←test_floor;RunVariations;r;data;dataplus;case;data2;case2;type;zero;bool;i1;i2;i3;dbl;fl;Hdbl;Hfl;Hcmplx;d1;d2;almostd1;halfLen;ct;fr;⎕CT;⎕DCT;⎕FR;ct_default;dct_default;fr_dbl;fr_decf;testDesc;desc;char1;char2;char3;char0;charptr;c1;f;Message 39 | ⍝ use RunVariations operator and modify it for floor 40 | RunVariations←(modelFloor #.testfns._RunVariations_⌊) 41 | 42 | ct_default←#.utils.ct_default 43 | dct_default←#.utils.dct_default 44 | fr_dbl←#.utils.fr_dbl 45 | fr_decf←#.utils.fr_decf 46 | 47 | bool←0 1 ⍝ 11: 1 bit Boolean type arrays 48 | i1←{⍵,0,-⍵}⍳120 ⍝ 83: 8 bits signed integer 49 | i2←{⍵,0,-⍵}10000+⍳1000 ⍝ 163: 16 bits signed integer 50 | i3←{⍵,0,-⍵}100000+⍳100 ⍝ 323: 32 bits signed integer 51 | 52 | dbl←{⍵,0,-⍵}1000.5+⍳100 ⍝ 645: 64 bits Floating 53 | Hdbl←{⍵,-⍵}100000000000000+(2×⍳50) ⍝ Hdbl is 645 closer to the default CT 54 | 55 | ⎕FR←fr_decf ⍝ use ⎕FR=1287 56 | zero←,0 ⍝ DECF 0 is required for a special case at apl/allos/src/arith_su.c#L2875 57 | fl←{⍵,0,-⍵}1000.5+⍳100 ⍝ 1287: 128 bits Decimal 58 | Hfl←{⍵,-⍵}200000000000000000000000000000+(10000000000000000×⍳10) ⍝ Hfl is 1287 closer to the default DCT 59 | ⎕FR←fr_dbl ⍝ revert ⎕FR=645 60 | 61 | char0←⎕AV ⍝ 82: DyalogAPL classic char set 62 | :If ~isDyalogClassic 63 | char1←⎕UCS⍳255 ⍝ 80: 8 bits character 64 | char2←⎕UCS(1000+⍳100) ⍝ 160: 16 bits character 65 | char3←⎕UCS(100000+⍳100) ⍝ 320: 32 bits character 66 | :EndIf 67 | charptr←2,/⎕A ⍝ 326: Pointer (32-bit or 64-bit as appropriate) 68 | 69 | r←⍬ 70 | testDesc←{'for ',case,{0∊⍴case2:'',⍵ ⋄ ' , ',case2,⍵},' & ⎕CT ⎕DCT:',⎕CT,⎕DCT,'& ⎕FR:',⎕FR} 71 | 72 | :For ct :In 0 1 73 | (⎕CT ⎕DCT)←ct×ct_default dct_default ⍝ set comparison tolerance 74 | :For fr :In 2 1 75 | ⎕FR←fr⊃fr_dbl fr_decf ⍝ set type of floating-point computations 76 | 77 | quadparams←⎕CT ⎕DCT ⎕FR ⎕IO ⎕DIV 78 | 79 | :For case :In 'zero' 'bool' 'i1' 'i2' 'i3' 'dbl' 'fl' 'Hdbl' 'Hfl' 80 | data←⍎case 81 | ⍝ Cross type tests 82 | :For case2 :In 'bool' 'i1' 'i2' 'i3' 'dbl' 'fl' 'Hdbl' 'Hfl' 83 | data2←⍎case2 84 | desc←testDesc ⍬ 85 | r,←'TCross1'desc quadparams RunVariations(modelFloor¨data,data2)(data,data2) ⍝ concat data and data2 86 | r,←'TCross2'desc quadparams RunVariations(modelFloor¨data2,data)(data2,data) ⍝ concat data and data2 reversed 87 | r,←'TCross3'desc Assert((modelFloor¨¨data data2)≡(⌊data data2)) ⍝ TCross1 on pointer array 88 | r,←'TCross4'desc Assert((modelFloor¨¨data2 data)≡(⌊data2 data)) ⍝ TCross2 on pointer array 89 | :EndFor 90 | 91 | case2←⍬ ⍝ disposing case2 for testDesc 92 | desc←testDesc ⍬ 93 | 94 | r,←'T1'desc quadparams RunVariations(modelFloor¨data)data ⍝ generator func finds results on array 95 | 96 | dataplus←data+?0⍨¨data ⍝ data plus a number between (0,1) to data 97 | r,←'T2'desc Assert((modelFloor¨dataplus)≡⌊dataplus)∨((fr=1)∧case≡'Hfl') ⍝ ⎕fr=645 and Hfl is skipped because of rounding off 98 | 99 | :If (⊂data)∊i1 i2 i3 100 | r,←'TInt1'desc quadparams RunVariations data data ⍝ floor of integers will always be floor 101 | r,←'TInt2'desc quadparams RunVariations data dataplus ⍝ floor of integers will always be floor 102 | :ElseIf (⊂data)∊dbl fl 103 | halfLen←(¯1+≢data)÷2 104 | r,←'TDbl'desc quadparams RunVariations({(⍵-0.5),0,-0.5+⍵}(halfLen↑data))data ⍝ floor of dbl is removing the 0.5 from the number 105 | :EndIf 106 | 107 | ⍝ tests with comparison tolerance 108 | d1←data[?≢data] 109 | almostd1←d1×1-fr⊃0.01×ct_default dct_default ⍝ infinitesimally close to d1 but smaller 110 | :If ct ⍝ tolerant 111 | :If (⊂data)∊Hdbl Hfl ⍝ bigger numbers 112 | ⍝ Hdbl=Hdbl+1 with default CT, but not for DECF 113 | r,←'CTDefault1'desc Assert(((⌊d1)≡⌊(d1+1))∨((fr=2)∧case≡'Hdbl')) 114 | :Else ⍝ other than bigger numbers 115 | r,←'CTDefault2'desc Assert((⌊d1)≢⌊(d1+1)) ⍝ not tolerantly equal for other numbers 116 | r,←'CTDefaultAlmost'desc Assert(({(⌊=⊢)⍵:⍵ ⋄ ⍵-0.5}d1)≡⌊almostd1) ⍝ d1 and almostd1 are tolerantly equal, condition added to get integer 117 | :EndIf 118 | :Else ⍝ exact 119 | ⍝ d≠d+1 for all numeric types 120 | r,←'CTZero'desc Assert((1+⌊d1)≡⌊d1+1) 121 | r,←'CTZeroAlmost'desc Assert(((d1-{(⌊=⊢)⍵:⍵>0 ⋄ 0.5}d1)≡⌊almostd1)∨((fr=1)∧case≡'Hfl')) ⍝ floor is the integer lesser than the number with no tolerance 122 | :EndIf 123 | case2←⍬ ⍝ disposing case for testDesc 124 | :EndFor 125 | 126 | ⍝ tests for known errors 127 | :For case :In 'char0' 'char1' 'char2' 'char3' 'charptr' 128 | :If (isDyalogClassic)∧(case≢'char0')∧(case≢'charptr') 129 | :Continue ⍝ Skip tests for unicode character sets in DyalogAPL classic 130 | :EndIf 131 | data←⍎case 132 | desc←testDesc ⍬ 133 | c1←data[?≢data] 134 | 135 | f←0 ⍝ flag 136 | :Trap 11 ⍝ 11: Domain error 137 | ⌊c1 138 | :Else 139 | f←1 140 | :EndTrap 141 | r,←'TDomainE1'desc Assert(f∧⎕DMX.Message≡'') 142 | :EndFor 143 | case←⍬ ⍝ disposing case for testDesc 144 | :EndFor 145 | :EndFor 146 | ∇ 147 | 148 | 149 | ∇ {r}←test_cmplx_floor;cmplx;Hcmplx;dataplus;d1;almostd1;case;data;testDesc;desc;ct;fr;ct_default;dct_default;fr_dbl;fr_decf;⎕CT;⎕DCT;⎕FR 150 | ⍝ use RunVariationsCmplx operator and modify it for complex floor 151 | RunVariationsCmplx←(modelCmpxFloor #.testfns._RunVariations_⌊) 152 | 153 | ct_default←1E¯14 154 | dct_default←1E¯28 155 | fr_dbl←645 156 | fr_decf←1287 157 | 158 | cmplx←{(-⍵),⍵,0,(+⍵),(-+⍵)}(0J1×⍳100)+⌽⍳100 ⍝ 1289: 128 bits Complex 159 | Hcmplx←{(-⍵),⍵,(+⍵),(-+⍵)}(100000000000000J100000000000000×⍳20) ⍝ 1289 closer to the default CT 160 | 161 | r←⍬ 162 | testDesc←{'for ',case,' & ⎕CT ⎕DCT:',⎕CT,⎕DCT,'& ⎕FR:',⎕FR} 163 | 164 | :For ct :In 0 1 165 | (⎕CT ⎕DCT)←ct×ct_default dct_default ⍝ set comparison tolerance 166 | :For fr :In 1 2 167 | ⎕FR←fr⊃fr_dbl fr_decf 168 | 169 | quadparams←⎕CT ⎕DCT ⎕FR ⎕IO ⎕DIV 170 | 171 | :For case :In 'cmplx' 'Hcmplx' 172 | data←⍎case 173 | desc←testDesc ⍬ 174 | r,←'T1'desc quadparams RunVariationsCmplx data data ⍝ all of data are whole cmplx numbers 175 | 176 | ⍝ adding a number between (0,1) to data making it a array of cmplx numbers of type xJy ¯xJy xJ¯y ¯xJ¯y 177 | dataplus←(data,(data+2⊃⊣),(data+2⊃⊣),(data+(1⊃⊣)+2⊃⊣))(?0⍨¨data)(¯11○(?0⍨¨data)) 178 | r,←'T2'desc Assert((modelCmpxFloor¨dataplus)≡⌊dataplus)∨((fr=2)∧case≡'Hcmplx') ⍝ DECF Hcmplx is skipped because of rounding off 179 | 180 | d1←data[?≢data] 181 | almostd1←d1×1-fr⊃0.01×ct_default dct_default ⍝ infinitesimally close to d1 but smaller 182 | :If ct∧(fr≡1) ⍝ tolerant 183 | :If (case≡'Hcmplx') ⍝ bigger numbers 184 | ⍝ Hdbl=Hdbl+1 with default CT, but not for DECF (similar for Hcmplx) 185 | r,←'CTDefault1'desc Assert(⌊d1)≡⌊d1+1 186 | r,←'CTDefault2'desc Assert(⌊d1)≡⌊d1+0J1 187 | r,←'CTDefault3'desc Assert(⌊d1)≡⌊d1+1J1 188 | :Else ⍝ other than bigger numbers 189 | r,←'CTDefaultAlmost'desc Assert d1≡⌊almostd1 ⍝ No difference because tolerantly equal 190 | :EndIf 191 | :Else ⍝ exact 192 | ⍝ d≠d+1 for all numeric types with cmplx variations 193 | r,←'CTZero1'desc Assert(1+⌊d1)≡⌊d1+1 194 | r,←'CTZero2'desc Assert(0J1+⌊d1)≡⌊d1+0J1 195 | r,←'CTZero3'desc Assert(1J1+⌊d1)≡⌊d1+1J1 196 | r,←'CTZeroAlmost'desc Assert(d1≡⌊almostd1)∨(fr=1) ⍝ todo: not fully sure if this is the right way 197 | :EndIf 198 | :EndFor 199 | :EndFor 200 | :EndFor 201 | ∇ 202 | 203 | :EndNamespace 204 | -------------------------------------------------------------------------------- /tests/divide.apln: -------------------------------------------------------------------------------- 1 | :Namespace divide 2 | Assert←#.unittest.Assert 3 | stripToSameLen←#.utils.stripToSameLen 4 | isDyalogClassic←#.utils.isClassic 5 | dyalogVersion←#.utils.version 6 | 7 | model←{ 8 | ⍺⌹¨⍵ 9 | } 10 | 11 | 12 | ∇ {r}←test_divide;RunVariations;ct_default;dct_default;fr_dbl;fr_decf;div_0;div_1;bool;i1;i2;i3;char0;char1;char2;char3;charptr;dbl;cmplx;Hcmplx;Sdbl;Hdbl;Hfl;fl;testDesc;case;case2;desc;ct;⎕CT;⎕DCT;fr;⎕FR;div;⎕DIV;data;d1;f;_;d2;data2;Message;data3;case3;c1;c2;almostd1S;almostd1B;almost0 13 | ⍝ use RunVariations operator and modify it for divide 14 | RunVariations←(model #.testfns._RunVariations_÷) 15 | 16 | ct_default←#.utils.ct_default 17 | dct_default←#.utils.dct_default 18 | fr_dbl←#.utils.fr_dbl 19 | fr_decf←#.utils.fr_decf 20 | div_0←#.utils.div_0 21 | div_1←#.utils.div_1 22 | 23 | ⍝ All data generated is unique 24 | bool←0 1 ⍝ 11: 1 bit Boolean type arrays 25 | i1←{⍵,-⍵}⍳120 ⍝ 83: 8 bits signed integer 26 | i2←{⍵,-⍵}10000+⍳100 ⍝ 163: 16 bits signed integer 27 | i3←{⍵,-⍵}100000+⍳100 ⍝ 323: 32 bits signed integer 28 | char0←⎕AV ⍝ 82: DyalogAPL classic char set 29 | :If ~isDyalogClassic 30 | char1←⎕UCS(100+⍳100) ⍝ 80: 8 bits character 31 | char2←⎕UCS(1000+⍳100) ⍝ 160: 16 bits character 32 | char3←⎕UCS(100000+⍳100) ⍝ 320: 32 bits character 33 | :EndIf 34 | charptr←(13↑⎕A)(13↓⎕A) ⍝ 326: Pointer (32-bit or 64-bit as appropriate) 35 | dbl←{⍵,-⍵}i3+0.1 ⍝ 645: 64 bits Floating 36 | cmplx←{⍵,-⍵}(0J1×⍳100)+⌽⍳100 ⍝ 1289: 128 bits Complex 37 | Hcmplx←{⍵,-⍵}(100000000000000J100000000000000×⍳20) ⍝ 1289 but larger numbers to test for CT value 38 | ⍝ Hdbl is 645 but larger numbers to test for CT value 39 | ⍝ intervals of 2 are chosen because CT for these numbers +1 and -1 40 | ⍝ come under the region of tolerant equality 41 | Hdbl←{⍵,-⍵}100000000000000+(2×⍳50) ⍝ 645: large numbers 42 | Sdbl←{⍵,-⍵}(⍳500)÷1000 ⍝ 645: Small numbers 43 | 44 | ⍝ Hfl is 1287 but larger numbers to test for CT value 45 | ⍝ far intervals are chosen for non overlap 46 | ⍝ with region of tolerant equality 47 | ⎕FR←fr_decf 48 | fl←{⍵,-⍵}i3+0.01 ⍝ 1287: 128 bits Decimal 49 | Hfl←{⍵,-⍵}200000000000000000000000000000+(10000000000000000×⍳10) 50 | ⎕FR←fr_dbl 51 | 52 | r←⍬ 53 | testDesc←{'for ',case,{0∊⍴case2:'',⍵ ⋄ ' , ',case2,⍵},' & ⎕CT ⎕DCT:',⎕CT,⎕DCT,'& ⎕FR:',⎕FR,'& ⎕DIV:',⎕DIV} 54 | 55 | r case case2←⍬ ⍬ ⍬ 56 | 57 | :For ct :In 0 1 58 | (⎕CT ⎕DCT)←ct×ct_default dct_default ⍝ set comparison tolerance 59 | 60 | :For fr :In 2 1 61 | ⎕FR←fr⊃fr_dbl fr_decf 62 | 63 | :For div :In 0 1 64 | ⎕DIV←div 65 | 66 | quadparams←⎕CT ⎕DCT ⎕FR ⎕IO ⎕DIV 67 | 68 | case←'independant' 69 | desc←testDesc ⍬ 70 | 71 | r,←'TI1'desc Assert(~div)≡0÷0 72 | r,←'TNull1'desc Assert ⍬≡''÷0 73 | r,←'TNull2'desc Assert ⍬≡⍬÷0 74 | r,←'TNull3'desc Assert ⍬≡0÷'' 75 | r,←'TNull4'desc Assert ⍬≡0÷⍬ 76 | 77 | :For case :In 'bool' 'i1' 'i2' 'i3' 'dbl' 'fl' 'cmplx' 'Hdbl' 'Sdbl' 'Hfl' 'Hcmplx' 78 | data←⍎case 79 | desc←testDesc ⍬ 80 | 81 | ⍝ General tests to test the basic rules of divide 82 | r,←'TGen1'desc Assert(≢data)≡≢data÷data 83 | r,←'TGen2'desc Assert(⎕DR bool)≡⎕DR data÷data 84 | 85 | d1←(data~0)[?≢data~0] 86 | f←1 87 | :Trap 11 88 | _←d1÷0 89 | f←div 90 | :EndTrap 91 | r,←'TI1'desc Assert f 92 | 93 | :If case≢'bool' 94 | r,←'T1'desc quadparams RunVariations(1⍨¨data)data data ⍝ division with the same number gives a 1 95 | d1←data[?≢data] 96 | d2←data[?≢(data~d1)] 97 | r,←'T2'desc quadparams RunVariations(d1 model d2)d1 d2 ⍝ model func finds results on single element 98 | r,←'T3'desc quadparams RunVariations data data 1 ⍝ Identity 99 | :EndIf 100 | 101 | ⍝ Cross type tests 102 | :For case2 :In 'i1' 'i2' 'i3' 'dbl' 'fl' 'cmplx' 'Hdbl' 'Hfl' 'Hcmplx' 103 | data2←⍎case2 104 | data data2←data stripToSameLen data2 105 | desc←testDesc ⍬ 106 | :If (case≡case2) 107 | :Continue 108 | :EndIf 109 | 110 | r,←'TGen3'desc Assert(({1289∊⎕DR data,data2:1289 ⋄ ⎕FR}⍬)≡⎕DR data÷data2) ⍝ data type test 111 | 112 | r,←'TCross1'desc quadparams RunVariations(data model data2)data data2 ⍝ check result of different datatypes using model 113 | 114 | :If case≡'bool' 115 | f←1 ⍝ flag 116 | :Trap 11 ⍝ 11: DOMAIN ERROR: Divide by zero 117 | _←data2÷data 118 | :Else 119 | f←~div 120 | r,←'TDomainE1'desc Assert(((f)∧(⎕DMX.Message≡'Divide by zero'))∨((dyalogVersion≤19)∧1289≡⎕DR data2)) ⍝ check DMX message for divide by 0 121 | :EndTrap 122 | :Else 123 | r,←'TCross2'desc quadparams RunVariations(data2 model data)data2 data ⍝ reverse of TCross1 without any div by 0 case 124 | r,←'TCross3'desc quadparams RunVariations((data2,data)model(data,data2))(data2,data)(data,data2) ⍝ concat 2 different types 125 | r,←'TCross4'desc Assert(((data2 data)model¨(data data2))≡(data2 data)÷(data data2)) ⍝ merge two different arrays creating a pointer array 126 | :EndIf 127 | 128 | d1←data[?≢data] 129 | d2←data2[?≢(data2~d1)] 130 | r,←'TCross5'desc quadparams RunVariations(d1 model d2)d1 d2 ⍝ model finds results on single element 131 | :EndFor 132 | case2←⍬ ⍝ dispose case2 133 | 134 | ⍝ tests for known errors 135 | :For case3 :In 'char1' 'char2' 'char3' 'char0' 'charptr' 136 | :If (isDyalogClassic)∧(case≢'char0')∧(case≢'ptr') 137 | :Continue ⍝ Skip tests for unicode character sets in DyalogAPL classic 138 | :EndIf 139 | data3←⍎case3 140 | desc←testDesc ⍬ 141 | c1←data3[?≢data3] 142 | c2←(data3~c1)[?¯1+≢data3] 143 | 144 | f←0 ⍝ flag 145 | :Trap 11 ⍝ 11: Domain error 146 | c1÷c2 ⍝ N/A type ÷ N/A type 147 | :Else 148 | f←1 149 | r,←'TDomainE2'desc Assert(f∧⎕DMX.Message≡'') ⍝ check for error and dmx message 150 | :EndTrap 151 | 152 | f←0 ⍝ flag 153 | :Trap 11 ⍝ 11: Domain error 154 | d1÷c2 ⍝ Number type ÷ N/A type 155 | :Else 156 | f←1 157 | r,←'TDomainE3'desc Assert(f∧⎕DMX.Message≡'') ⍝ check for error and dmx message 158 | :EndTrap 159 | 160 | f←0 ⍝ flag 161 | :Trap 11 ⍝ 11: Domain error 162 | c1÷d1 ⍝ N/A type ÷ number type 163 | :Else 164 | f←1 165 | r,←'TDomainE4'desc Assert(f∧⎕DMX.Message≡'') ⍝ check for error and dmx message 166 | :EndTrap 167 | :EndFor 168 | 169 | ⍝ tests with comparison tolerance 170 | :If 1289≡⎕DR data ⍝ skipping ct tests for complex because complex division works in a different way 171 | :Continue 172 | :EndIf 173 | d1←(data~0)[?≢data~0] ⍝ 0 interferes with the calculations of almostd1S and almostd1B hence it is removed 174 | almostd1S←d1×1-fr⊃0.01×ct_default dct_default ⍝ infinitesimally close to d1 but smaller 175 | almostd1B←d1×1+fr⊃0.1×ct_default dct_default ⍝ infinitesimally close to d1 but bigger 176 | :If ct ⍝ tolerant 177 | :If (⊂d1)∊Hdbl,Hfl ⍝ bigger numbers 178 | ⍝ Hdbl=Hdbl+1 with default CT, but not for DECF 179 | r,←'CTDefault1'desc Assert(((1≡d1÷d1+1)∨((fr=2)∧case≡'Hdbl'))) 180 | :Else ⍝ other than bigger numbers 181 | r,←'CTDefault2'desc Assert(1≢d1÷d1+1) ⍝ not tolerantly equal for other numbers 182 | r,←'CTDefaultAlmostS'desc Assert(1≡d1÷almostd1S) ⍝ d1 and almostd1S are tolerantly equal 183 | r,←'CTDefaultAlmostB'desc Assert(1≡d1÷almostd1B) ⍝ d1 and almostd1B are tolerantly equal 184 | :EndIf 185 | :Else ⍝ exact 186 | ⍝ d≠d+1 for all numeric types 187 | r,←'CTZero'desc Assert((1≢d1÷d1+1)∨((fr=1)∧case≡'Hfl')) 188 | r,←'CTZeroAlmostS'desc Assert(1≢d1÷almostd1S) 189 | r,←'CTZeroAlmostB'desc Assert(1≢d1÷almostd1B) 190 | :EndIf 191 | :EndFor 192 | 193 | ⍝ improper ⎕DMX messages are ignored here 194 | :If 0≡div 195 | f←0 ⍝ flag 196 | :Trap 11 ⍝ 11: Domain error 197 | :If 1≡fr 198 | _←1÷1E¯309 ⍝ getting a infinite result with a non 0 number 199 | :Else 200 | _←1÷0 ⍝ for ⎕fr=1287 201 | :EndIf 202 | :Else 203 | f←1 204 | :EndTrap 205 | r,←'Tborder1'desc Assert f 206 | :Else 207 | r,←'Tborder2'desc Assert 0≡1÷({⍵-1:0 ⋄ 1E¯309}fr) ⍝ testing for border values 208 | :EndIf 209 | 210 | ⍝ infinitesimally small divided by 0 211 | :If ~(div≡0)∧(fr≡2)∧ct≡1 ⍝ we don't want to test for divide by 0 here 212 | almost0←((?0)×fr⊃⎕CT ⎕DCT) 213 | r,←'almost0Div0'desc Assert(~div)≡almost0÷0 214 | :EndIf 215 | :EndFor 216 | :EndFor 217 | :EndFor 218 | ∇ 219 | 220 | :EndNamespace 221 | -------------------------------------------------------------------------------- /docs/how-to-add-tests.md: -------------------------------------------------------------------------------- 1 | # How to add tests 2 | 3 | ### Make a namespace 4 | 5 | Make a namespace titled the primitive being tested 6 | 7 | Eg: uniquemask 8 | 9 | ```APL 10 | :Namespace uniquemask 11 | ⍝ ... 12 | :EndNamespace 13 | ``` 14 | 15 | ### Main function 16 | 17 | Start with making the main function titled `test_functionname` like `test_uniquemask`. Here `test_` is important because the [`./unittest.apln`](../unittest.apln) recognises the main function of the test suite of the primitive with the `test_` keyword. 18 | 19 | ### Initialise variables 20 | 21 | Primitives depend on ⎕CT/⎕DCT, ⎕FR, ⎕DIV and ⎕IO, so all default values of these can be initialised: 22 | 23 | ```APL 24 | ct_default←#.utils.ct_default 25 | dct_default←#.utils.dct_default 26 | fr_dbl←#.utils.fr_dbl 27 | fr_decf←#.utils.fr_decf 28 | io_default←#.utils.io_default 29 | io_0←#.utils.io_0 30 | div_0←#.utils.div_0 31 | div_1←#.utils.div_1 32 | ``` 33 | 34 | Then we need to get some specific data that we can manipulate to give us expected results to some testcases to logically/mathematically check the correct output. This is meant as a very basic fallback for testing with model functions fail. 35 | 36 | This can look something like this: 37 | 38 | #### Example 1: [old way] Using manually created data 39 | 40 | This is an example from [unique mask](../tests/uniquemask.apln) (≠). These values can be changed according to what you want the fundamental tests to do but general layout should remain the same covering all the data types possible. 41 | 42 | ```APL 43 | ⍝ All data generated is unique 44 | bool←0 1 ⍝ 11: 1 bit Boolean type arrays 45 | i1←¯60+⍳120 ⍝ 83: 8 bits signed integer 46 | char1←⎕UCS (100+⍳100) ⍝ 80: 8 bits character 47 | char2←⎕UCS (1000+⍳100) ⍝ 160: 16 bits character 48 | i2←{⍵,-⍵}10000+⍳100 ⍝ 163: 16 bits signed integer 49 | char3←⎕UCS (100000+⍳100) ⍝ 320: 32 bits character 50 | i3←{⍵,-⍵}100000+⍳100 ⍝ 323: 32 bits signed integer 51 | ptr←(13↑⎕a) (13↓⎕a) ⍝ 326: Pointer (32-bit or 64-bit as appropriate) 52 | dbl←{⍵,-⍵}i3+0.1 ⍝ 645: 64 bits Floating 53 | cmplx←{⍵,-⍵}(0J1×⍳100)+⌽⍳100 ⍝ 1289: 128 bits Complex 54 | Hcmplx←{⍵,-⍵}(1E14J1E14×⍳20) ⍝ 1289 but larger numbers to test for CT value 55 | ⍝ Hdbl is 645 but larger numbers to test for CT value 56 | ⍝ intervals of 2 are chosen because CT for these numbers +1 and -1 57 | ⍝ come under the region of tolerant equality 58 | Hdbl←{⍵,-⍵}1E14+(2×⍳50) 59 | 60 | ⍝ This is needed for a case that can be hit if we have a lot of small numbers 61 | ⍝ which produce a hash collision 62 | ⍝ Occurrence: same.c.html#L1153 63 | Sdbl←{⍵,-⍵}(⍳500)÷1000 64 | 65 | ⍝ Hfl is 1287 but larger numbers to test for CT value 66 | ⍝ far intervals are chosen for non overlap 67 | ⍝ with region of tolerant equality 68 | ⎕FR←fr_decf 69 | fl←{⍵,-⍵}i3+0.01 ⍝ 1287: 128 bits Decimal 70 | Hfl←{⍵,-⍵}2E29+(1E16×⍳10) 71 | ⎕FR←fr_dbl 72 | ``` 73 | 74 | #### Example 2: Using utility functions 75 | 76 | This is an example from [union_and_intersection.apln](../tests/union_and_intersection.apln) (∪ and ∩). Here we use utility functions from [random.apln](../random.apln) like `Ints` to generate integer data and `Chars` for character data. We also dynamically create variables for different lengths. 77 | 78 | ```APL 79 | data_single_bool_0←∧/1 0 1 0 ⍝ singleton boolean 80 | data_single_bool_1←∧/1 1 1 1 ⍝ singleton boolean 81 | data_bool←1 0 82 | data_i1←100 #.random.Ints 8 ⍝ 100 random 8-bit integers 83 | data_i2←100 #.random.Ints 16 ⍝ 100 random 16-bit integers 84 | data_i4←100 #.random.Ints 32 ⍝ 100 random 32-bit integers 85 | 86 | ⍝ Dynamically create variables for different lengths 87 | :For len :In 8 16 32 64 128 88 | ⍎'data_i1_',⍕len'←len #.random.Ints 8' 89 | ⍎'data_i2_',⍕len'←len #.random.Ints 16' 90 | ⍎'data_i4_',⍕len'←len #.random.Ints 32' 91 | :EndFor 92 | 93 | data_char0←⎕AV ⍝ 82: DyalogAPL classic char set 94 | :If ~#.utils.isClassic 95 | data_char1←100 #.random.Chars 8 ⍝ 80: 8 bits character 96 | data_char2←100 #.random.Chars 16 ⍝ 160: 16 bits character 97 | data_char3←100 #.random.Chars 32 ⍝ 320: 32 bits character 98 | data_char_ptr←data_char1 data_char2 data_char3⍝ 326: Pointer 99 | :EndIf 100 | data_ptr←data_i1 data_i2 data_i4 ⍝ 326: Pointer 101 | data_dbl←{⍵,-⍵}data_i4+0.1 ⍝ 645: 64 bits Floating 102 | data_cmplx←{⍵,-⍵}(0J1×⍳100)+⌽⍳100 ⍝ 1289: 128 bits Complex 103 | data_Hcmplx←{⍵,-⍵}(1E14J1E14×⍝20) ⍝ 1289 but larger numbers to test for CT value 104 | data_Hdbl←{⍵,-⍵}1E14+(2×⍳50) ⍝ 645 but larger numbers to test for CT value 105 | data_Sdbl←{⍵,-⍵}(⍳500)÷1000 ⍝ Small doubles for hash collision testing 106 | 107 | ⎕FR←#.utils.fr_decf 108 | data_fl←{⍵,-⍵}data_i4+0.01 ⍝ 1287: 128 bits Decimal 109 | data_Hfl←{⍵,-⍵}2E29+(1E16×⍳10) 110 | ⎕FR←#.utils.fr_dbl 111 | ``` 112 | 113 | Note: The `Ints` and `Chars` functions are defined in [random.apln](../random.apln) and generate random integers and characters respectively of the specified bit size. 114 | 115 | ### Initialise test description 116 | 117 | Test description gives information about the `testID`, datatypes being tested on, the [test variation](todo: add link to variation section), and the different setting values. 118 | 119 | Example from [union_and_intersection.apln](../tests/union_and_intersection.apln): 120 | 121 | ```APL 122 | ∇ r←testDesc 123 | r←'for ',case,{0∊⍴case2:'',⍵ ⋄ ' , ',case2,⍵},' & ⎕CT ⎕DCT ⎕FR:',⍕⎕CT ⎕DCT ⎕FR 124 | ∇ 125 | ``` 126 | 127 | Or as a dfn (alternative example): 128 | 129 | ```APL 130 | testDesc←{'for ',case,{0∊⍴case2:'',⍵⋄' , ', case2,⍵},' & ⎕CT ⎕DCT:',⎕CT,⎕DCT, '& ⎕FR:', ⎕FR, '& ⎕IO:', ⎕IO} 131 | ``` 132 | 133 | ### Testing functions 134 | 135 | #### `Assert` 136 | 137 | Assert is a function described in [`./unittest.apln`](../unittest.apln) that takes in a test expression that gives a boolean result and evaluates the output of the result and gives the instructions to pretty print the result based on the user settings of the test suite. 138 | 139 | #### `RunVariations` 140 | 141 | RunVariations is a function described in [testfns.apln](../testfns.apln) which takes the expressions to be evaluated and does the following: 142 | - tests using the standard form it comes in 143 | - tests a scalar element from the data it gets 144 | - tests an empty array derived from the input 145 | - applies a different shape to the input and evaluates 146 | - creates a different shape that has a 0 in the shape of the input 147 | - tests the input with the model function to double check the result 148 | - RandModelTest takes the datatype and the boundary values of the expressions and generates a random array of the same datatype to increase the amount of data we have. 149 | 150 | #### Model function 151 | 152 | A model function replicates the behavior of an existing function by employing alternative primitives or computational steps. Model functions are used to test outputs of tests that can give not very intuitively computable results. Model functions here try to use primitives that are least related to the primitive being tested(this is mainly related so that it can be easily pin pointed which primitive is failing because shared code can be difficult to deal with). 153 | 154 | Examples from [union_and_intersection.apln](../tests/union_and_intersection.apln): 155 | 156 | ```APL 157 | modelUnion←{⍺,⍵~⍺} 158 | modelIntersection←{(⍺∊⍵)/⍺} 159 | ``` 160 | 161 | Other examples: 162 | 163 | ```APL 164 | modelMagnitude←{⍵×(¯1@(∊∘0)(⍵>0))} 165 | modelUnique←{0=≢⍵:⍵ ⋄ ↑,⊃{⍺,(∧/⍺≢¨⍵)/⍵}⍨/⌽⊂¨⊂⍤¯1⊢⍵} 166 | ``` 167 | 168 | ### The tests 169 | 170 | All tests should run with all types of ⎕CT/⎕DCT, ⎕FR, ⎕DIV and ⎕IO values depending on which settings are implicit arguments of the primitive, ie. all of the settings that they depend on. 171 | 172 | #### Example 1: Basic loop structure 173 | 174 | ```APL 175 | :For io :In io_default io_0 176 | ⎕IO←io 177 | 178 | :For ct :In 1 0 179 | (⎕CT ⎕DCT)←ct × ct_default dct_default ⍝ set comparison tolerance 180 | 181 | :For fr :In fr_dbl fr_decf 182 | ⍝ ... 183 | :EndFor 184 | :EndFor 185 | :EndFor 186 | ``` 187 | 188 | #### Example 2: Testing multiple operators with varied CT values 189 | 190 | From [union_and_intersection.apln](../tests/union_and_intersection.apln) - shows testing multiple operators (∪ and ∩) with more varied comparison tolerance values: 191 | 192 | ```APL 193 | :For op :In '∪' '∩' 194 | :If op≡'∪' 195 | RunVariations←modelUnion #.testfns._RunVariationsWithModel_(⍎op) 196 | :Else 197 | RunVariations←modelIntersection #.testfns._RunVariationsWithModel_(⍎op) 198 | :EndIf 199 | 200 | :For ct :In 0 1 10 0.1 ⍝ Test with 0, default, 10× default, and 0.1× default 201 | (⎕CT ⎕DCT)←ct×#.utils.(ct_default dct_default) 202 | 203 | :For fr :In 1 2 204 | ⎕FR←fr⊃#.utils.(fr_dbl fr_decf) 205 | ⎕IO←1 206 | 207 | quadparams←⎕CT ⎕DCT ⎕FR ⎕IO ⎕DIV 208 | 209 | ⍝ ... tests here ... 210 | :EndFor 211 | :EndFor 212 | :EndFor 213 | ``` 214 | 215 | #### Types of tests 216 | 217 | The general structure followed with all tests is as follows: 218 | 219 | ##### General tests 220 | 221 | General tests are tests that test information other than if the primitive gives the correct output. 222 | 223 | Examples from [uniquemask](../tests/uniquemask.apln): 224 | 225 | - uniquemask cannot return a result that exceeds the number of elements of the input 226 | ```APL 227 | r,← 'TGen1' desc Assert (≢data)≥≢≠data 228 | ``` 229 | 230 | - datatype of the result will always be boolean in nature 231 | ```APL 232 | r,← 'TGen2' desc Assert 11≡⎕dr ≠data intertwine data ⍝ intertwine is a util function that intertwines the data like (1 1 1 1) intertwine (0 0 0 0) gives 1 0 1 0 1 0 1 0 233 | ``` 234 | 235 | Examples from [union_and_intersection.apln](../tests/union_and_intersection.apln): 236 | 237 | - union returns a result that has at least the number of elements of the input 238 | ```APL 239 | r,← 'Union (∪) Gen1' desc Assert (≢data)≤≢data∪data 240 | ``` 241 | 242 | - intersection returns a result that does not exceed the number of elements of the input 243 | ```APL 244 | r,← 'Intersection (∩) Gen1' desc Assert (≢data)≥≢data∩data 245 | ``` 246 | 247 | - datatype of the data will not change under union or intersection 248 | ```APL 249 | r,← 'Union (∪) Gen2' desc Assert (⎕DR data)≡⎕DR data∪data 250 | r,← 'Intersection (∩) Gen2' desc Assert (⎕DR data)≡⎕DR data∩data 251 | ``` 252 | 253 | ##### Namespace tests 254 | 255 | When primitives can work with namespaces, test them explicitly: 256 | 257 | ```APL 258 | ⍝ Example from union_and_intersection.apln 259 | desc←testDesc 260 | r,← 'Union (∪) ns' desc Assert ((#)modelUnion(# ⎕SE))≡(#)∪(# ⎕SE) 261 | ``` 262 | 263 | ##### Logical/mathematical tests 264 | 265 | These are tests that evaluate the result of the primitive with a very logical straightforward approach and try to depend on as few primitives as possible to reduce the number of false failures if the dependent primitives fail. Some examples of subtract: 266 | 267 | - substraction with the same number gives 0 268 | ```APL 269 | r,← 'T1' desc quadparams RunVariations ((0⍨¨data) data data) 270 | ``` 271 | 272 | ##### Cross datatype tests 273 | 274 | Cross data type tests deal with the primitive handling 2 datatypes at a time in the same input. Each datatype must be tested with every other datatype for a more accurate result. 275 | 276 | ##### comparison tolerance tests 277 | 278 | Comparison tolerance tests deal with the primitive getting inputs which are believed to be in the tolerance range of numbers. The inputs are generally numbers slightly bigger and smaller than the original number that is treated to be equal at default ⎕CT and ⎕DCT values and should be treated differently when ⎕CT and ⎕DCT are zero. 279 | 280 | More information about comparison tolerance here: https://help.dyalog.com/latest/Content/Language/System%20Functions/ct.htm 281 | 282 | and here: https://www.dyalog.com/uploads/documents/Papers/tolerant_comparison/tolerant_comparison.htm 283 | 284 | ##### Independent tests 285 | 286 | Independent tests are tests for special cases that either have optimisations in the sources or have a special need that cannot be covered in general data types and only work on certain specific values. 287 | 288 | Examples: 289 | 290 | - The special case can be hit if we have two 8 bit int numbers in the input: a & b, and a is b-⎕CT. That means, that when we get to element b in the loop, we will find element a and hit the case. 291 | Occurrence: same.c.html#L1152 292 | ```APL 293 | d←i1[?≢i1] 294 | r,←'TCTI1' desc Assert (1 0)≡(≠ (d-({fr-1:⎕dct⋄⎕ct}⍬)) d) 295 | ``` 296 | 297 | - Testing hash collisions with specially prepared data and `1500⌶` (from [union_and_intersection.apln](../tests/union_and_intersection.apln)): 298 | ```APL 299 | ⍝ Test with hashed arrays to check hash collision handling 300 | r,← 'Union (∪) Hash1' desc quadparams RunVariations data (#.utils.hashArray data) 301 | ``` 302 | 303 | ## Misc useful information 304 | 305 | Interesting things: 306 | - dyalogVersion ← DyalogAPL version from `]version` 307 | - isDyalog32 ← 0 or 1 for if the interpreter 64-bit ot 32-bit? 308 | - isDyalogClassic ← 0 or 1 for if the interpreter classic or unicode 309 | - [utils.apln](../utils.apln) ← This file has some widely used manipulation functions 310 | - [random.apln](../random.apln) ← Contains `Ints` and `Chars` functions for generating random test data 311 | --------------------------------------------------------------------------------