diff --git a/tests/modified_assignment.apln b/tests/modified_assignment.apln new file mode 100644 index 0000000..ecd8d0f --- /dev/null +++ b/tests/modified_assignment.apln @@ -0,0 +1,141 @@ +:Namespace modified_assignment + Assert←#.unittest.Assert + model←{ + ⍺ ⍺⍺ ⍵ + } + + ∇ r←testDesc + r←'for ',case,' & ⎕CT ⎕DCT ⎕FR:',⍕⎕CT ⎕DCT ⎕FR + ∇ + + ∇ {r}←test_modified_assignment;Ints;Chars;f;case;quadparams;desc;a;b;case2;data_bool;data_i1;data_i2;data_i4;data_char0;data_char1;data_char2;data_char3;data_dbl;data_cmplx;data_Hcmplx;data_Hdbl;data_Sdbl;data_fl;data_Hfl;fr;caselist;a1;b1;data;len;c;data2;flag;m + r←⍬ + Ints←#.random.Ints + Chars←#.random.Chars + ⎕DIV←1 + ⎕IO←1 + + ⍝ data + case←⍬ + case2←⍬ + data_bool←1 0 + data_i1←100 Ints 8 + data_i2←100 Ints 16 + data_i4←100 Ints 32 + + ⍝ data_ptr←data_i1 data_i2 data_i4 ⍝ 326: Pointer (32-bit or 64-bit as appropriate) + data_dbl←{⍵,-⍵}data_i4+0.1 ⍝ 645: 64 bits Floating + data_cmplx←{⍵,-⍵}(0J1×⍳100)+⌽⍳100 ⍝ 1289: 128 bits Complex + data_Hcmplx←{⍵,-⍵}(100000000000000J100000000000000×⍳20) ⍝ 1289 but larger numbers to test for CT value + ⍝ Hdbl is 645 but larger numbers to test for CT value + ⍝ intervals of 2 are chosen because CT for these numbers +1 and -1 + ⍝ come under the region of tolerant equality + data_Hdbl←{⍵,-⍵}100000000000000+(2×⍳50) + + data_Sdbl←{⍵,-⍵}(⍳500)÷1000 + + ⍝ Hfl is 1287 but larger numbers to test for CT value + ⍝ far intervals are chosen for non overlap + ⍝ with region of tolerant equality + ⎕FR←#.utils.fr_decf + data_fl←{⍵,-⍵}data_i4+0.01 ⍝ 1287: 128 bits Decimal + data_Hfl←{⍵,-⍵}200000000000000000000000000000+(10000000000000000×⍳10) + ⎕FR←#.utils.fr_dbl + + caselist←⎕NL ¯2 + caselist←caselist⌿⍨{'data_'⊃⍤⍷⍵}¨caselist + :For fr :In 1 2 + ⎕FR←fr⊃#.utils.(fr_dbl fr_decf) + + + :For f :In '+' '-' '×' '÷' ',' + :For case :In caselist + data←⍎case + desc←testDesc + + b←a←(?≢data)⊃data + c←(?≢data)⊃data + + ⍝ uses model to test modified assignment on all of the functions + r,←('T1',f)desc Assert 3⊃(a(⍎f)←c ⋄ b←b(⍎f)model c ⋄ a≡b) + + b←a←data + r,←('T2',f)desc Assert 3⊃(a(⍎f)←c ⋄ b←b(⍎f)model c ⋄ a≡b) + :For case2 :In caselist~case + data2←⍎case + desc←testDesc + + b←a←(?≢data)⊃data + c←(?≢data2)⊃data2 + + ⍝ uses model to test modified assignment on all of the functions + r,←('TCross1',f)desc Assert 3⊃(a(⍎f)←c ⋄ b←b(⍎f)model c ⋄ a≡b) + ⍝ array w scalar + b←a←data + r,←('TCross2',f)desc Assert 3⊃(a(⍎f)←c ⋄ b←b(⍎f)model c ⋄ a≡b) + + ⍝ array w array of same length + data data2←data(#.utils.stripToSameLen)data2 + b←a←data + c←data2 + r,←('TCross3',f)desc Assert 3⊃(a(⍎f)←c ⋄ b←b(⍎f)model c ⋄ a≡b) + :EndFor + + ⍝ array w array of different shape and length - should error + :If f≡',' + :Continue + :EndIf + len←(1+?≢data) + a←len↑data + c←(len+2)↑data + + flag←0 ⍝ flag + :Trap 5 ⍝ 5: Length error + a(⍎f)←c + :Else + flag←1 + m←⎕DMX.Message + :EndTrap + r,←'TE1'desc Assert(flag∧m≡'Mismatched left and right argument shapes') + :EndFor + :EndFor + :EndFor + + ⍝ test character data separately as only , is allowed + data_char0←⎕AV ⍝ 82: DyalogAPL classic char set + :If ~#.utils.isClassic + data_char1←100 Chars 8 ⍝ 80: 8 bits character + data_char2←100 Chars 16 ⍝ 160: 16 bits character + data_char3←100 Chars 32 ⍝ 320: 32 bits character + ⍝ data_char_ptr←data_char1 data_char2 data_char3⍝ 326: Pointer (32-bit or 64-bit as appropriate) + :EndIf + + caselist←⎕NL ¯2 + caselist←caselist⌿⍨{'data_char'⊃⍤⍷⍵}¨caselist + :For case :In caselist + data←⍎case + desc←testDesc + b←a←(?≢data)⊃data + c←(?≢data2)⊃data2 + + ⍝ scalars + r,←('TCharCross1',f)desc Assert 3⊃(a,←c ⋄ b←b,model c ⋄ a≡b) + + ⍝ array w scalar + b←a←data + r,←('TCharCross2',f)desc Assert 3⊃(a,←c ⋄ b←b,model c ⋄ a≡b) + + ⍝ array w array of same length + data data2←data(#.utils.stripToSameLen)data2 + b←a←data + c←data2 + r,←('TCharCross3',f)desc Assert 3⊃(a,←c ⋄ b←b,model c ⋄ a≡b) + + ⍝ array w array of different shape and length - should error + len←(1+?≢data) + b←a←len↑data + c←(len+2)↑data + r,←('TCharCross4',f)desc Assert 3⊃(a,←c ⋄ b←b,model c ⋄ a≡b) + :EndFor + ∇ +:EndNamespace