modified_assignment.apln

: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