leak-check.0rx

/* -----------------------------------------------------------------------------
Copyright 2021-2022 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- */

// Author: Kevin P. Barry [ta0kira@gmail.com]

concrete LeakCheck {
  @type run () -> ()
}

define LeakCheck {
  @value Vector<Int> memory

  run () {
    if (Argv.global().size() != 2) {
      \ message()
    } elif (Argv.global().readAt(1) == "race") {
      \ runWith(1000, 0)
      \ BasicOutput.stderr().writeNow("no race conditions this time\n")
    } elif (Argv.global().readAt(1) == "leak") {
      \ runWith(100, 0)
    } elif (Argv.global().readAt(1) == "forever") {
      \ runWith(10000000, 1024*1024)
    } else {
      \ message()
    }
  }

  @type message () -> ()
  message () {
    fail(Argv.global().readAt(0) + " [race | leak | forever]")
  }

  @type runWith (Int, Int) -> ()
  runWith (iterations, size) {
    Int threads <- Ranges:max(3, $ExprLookup[CPU_CORE_COUNT]$-1)
    ReadAt<BarrierWait> barriers <- EnumeratedBarrier.new(threads+1)
    traverse (Counter.zeroIndexed(iterations) -> Int i) {
      \ doIteration<LastReference>(i, size, barriers)
      \ doIteration<Chaos>(i, size, barriers)
    }
  }

  @type doIteration<#f>
    #f defines ThreadFactory
  (Int, Int, ReadAt<BarrierWait>) -> ()
  doIteration (i, size, barriers) {
    \ BasicOutput.stderr()
        .write(typename<#f>())
        .write(": iteration ")
        .write(i)
        .write("\n")
        .flush()

    optional LeakCheck original <- LeakCheck{ Vector:createSize<Int>(size) }
    weak LeakCheck checkedValue <- original
    $ReadOnly[checkedValue]$

    scoped {
      Vector<Thread> threads <- Vector<Thread>.new()
    } in {
      traverse (Counter.zeroIndexed(barriers.size()-1) -> Int j) {
        \ threads.push(ProcessThread.from(#f.create(original, barriers.readAt(j+1))).start())
      }

      \ barriers.readAt(0).wait()
      original <- empty

      traverse (threads.defaultOrder() -> Thread thread) {
        \ thread.join()
      }
    }

    // Make sure that threads are out of scope before validating.
    $ValidateRefs[checkedValue]$
  }
}

@type interface ThreadFactory {
  create (optional LeakCheck, BarrierWait) -> (Routine)
}

concrete LastReference {
  defines ThreadFactory
}

define LastReference {
  $ReadOnlyExcept[]$

  refines Routine

  @value weak LeakCheck copy
  @value BarrierWait barrier

  create (copy, barrier) {
    return LastReference{ copy, barrier }
  }

  run ()  {
    \ barrier.wait()
    \ strong(copy)
  }
}

concrete Chaos {
  defines ThreadFactory
}

define Chaos {
  $ReadOnly[barrier]$

  refines Routine

  @value weak LeakCheck copy
  @value BarrierWait barrier

  create (copy, barrier) {
    return Chaos{ copy, barrier }
  }

  run ()  {
    weak LeakCheck copy1 <- empty
    weak LeakCheck copy2 <- empty
    weak LeakCheck copy3 <- empty
    weak LeakCheck copy4 <- empty
    weak LeakCheck copy5 <- empty
    \ barrier.wait()
    copy1 <- copy
    copy2 <- copy1
    copy3 <- copy1
    copy3 <-> copy1
    copy1 <-> copy1
    copy2 <-> copy1
    copy <- empty
    copy4 <- strong(copy2)
    copy1 <- strong(copy3)
    copy2 <- empty
    copy3 <- empty
  }
}