Tests for modified assignment

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