zeolite-lang-0.3.0.0: tests/scoped.0rt

/* -----------------------------------------------------------------------------
Copyright 2020 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]

testcase "scoped unconditional" {
  success Test$run()
}

@value interface Value {}

define Test {
  run () {
    scoped {
      Int x <- 1
    } in {
      x <- 2
    }
  }
}

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


testcase "unconditional has scoping" {
  error
  require "x"
}

@value interface Value {}

define Test {
  run () {
    scoped {
    } in {
      Int x <- 1
    }
    x <- 2
  }
}

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


testcase "return inside scope" {
  success Test$run()
}


@value interface Value {}

define Test {
  @value process () -> (optional Value)
  process () {
    scoped {
      return empty
    } in \ empty
  }

  run () {}
}

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


testcase "return from scoped" {
  success Test$run()
}

@value interface Value {}

define Test {
  @value process () -> (optional Value)
  process () {
    scoped {
    } in return empty
  }

  run () {}
}

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


testcase "update clashes with scoped" {
  error
  require "x"
}

define Test {
  run () {
    scoped {
      Int x <- 2
    } in while (false) {
    } update {
      Int x <- 1
    }
  }
}

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


testcase "assign inside scope" {
  success Test$run()
}

@value interface Value {}

define Test {
  @value process () -> (optional Value)
  process () (value) {
    scoped {
      value <- empty
    } in \ empty
  }

  run () {}
}

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


testcase "assign from scoped" {
  success Test$run()
}

@value interface Value {}

define Test {
  @value process () -> (optional Value)
  process () (value) {
    scoped {
    } in value <- empty
  }

  run () {}
}

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


testcase "simple cleanup" {
  success Test$run()
}

define Test {
  run () {
    Int value <- 0
    scoped {
      value <- 1
    } cleanup {
      value <- 2
    } in value <- 3
    if (value != 2) {
      fail(value)
    }
  }
}

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


testcase "name clash in cleanup" {
  error
  require "value.+already defined"
}

define Test {
  run () {
    scoped {
      Int value <- 1
    } cleanup {
      Int value <- 2
    } in \ empty
  }
}

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


testcase "cleanup before return" {
  success Test$run()
}

concrete Value {
  @type create () -> (Value)
  @value call () -> (Int)
  @value get () -> (Int)
}

define Value {
  @value Int value

  create () {
    return Value{ 0 }
  }

  call () {
    value <- 1
    scoped {
      value <- 2
    } cleanup {
      value <- 3
    } in return value
  }

  get () {
    return value
  }
}

define Test {
  run () {
    Value value <- Value$create()
    Int value1 <- value.call()
    if (value1 != 2) {
      fail(value1)
    }
    Int value2 <- value.get()
    if (value2 != 3) {
      fail(value2)
    }
  }
}

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


testcase "cleanup initializes named return" {
  success Test$run()
}

define Test {
  @type get () -> (Int)
  get () (value) {
    scoped {
    } cleanup {
      value <- 1
    } in return _
  }

  run () {
    Int value <- get()
    if (value != 1) {
      fail(value)
    }
  }
}

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


testcase "cleanup overrides named return" {
  success Test$run()
}

define Test {
  @type get () -> (Int)
  get () (value) {
    value <- 1
    scoped {
    } cleanup {
      value <- 2
    } in return _
  }

  run () {
    Int value <- get()
    if (value != 2) {
      fail(value)
    }
  }
}

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


testcase "cannot refer to cleanup variables" {
  error
  require "value.+not defined"
}

define Test {
  @type get () -> (Int)
  get () (value) {
    scoped {
    } cleanup {
      Int value2 <- 1
    } in return value2
  }

  run () {
    \ get()
  }
}

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


testcase "cleanup skipped in scoped return" {
  success Test$run()
}

define Test {
  @type get () -> (Int)
  get () {
    Int value <- 0
    scoped {
      value <- 1
      return value
    } cleanup {
      value <- 2
    } in return 3
  }

  run () {
    Int value <- get()
    if (value != 1) {
      fail(value)
    }
  }
}

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


testcase "no infinite loop in cleanup return" {
  success Test$run()
}

define Test {
  @type get () -> (Int)
  get () {
    Int value <- 0
    scoped {
      value <- 1
    } cleanup {
      value <- 2
      return value
    } in return 3
  }

  run () {
    Int value <- get()
    if (value != 2) {
      fail(value)
    }
  }
}

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


testcase "multiple cleanup" {
  success Test$run()
}

define Test {
  run () {
    Int value1 <- 0
    Int value2 <- 0
    Int value3 <- 0
    scoped {
    } cleanup {
      value1 <- 1
      value2 <- 1
    } in scoped {
    } cleanup {
      value2 <- 2
      value3 <- 2
    } in \ empty
    if (value1 != 1) {
      fail(value1)
    }
    if (value2 != 1) {
      fail(value2)
    }
    if (value3 != 2) {
      fail(value3)
    }
  }
}

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


testcase "multiple cleanup with return" {
  success Test$run()
}

concrete Value {
  @type create () -> (Value)
  @value call () -> (Int,Int,Int)
  @value get () -> (Int,Int,Int)
}

define Value {
  @value Int value1
  @value Int value2
  @value Int value3

  create () {
    return Value{ 0, 0, 0 }
  }

  call () {
    value1 <- 1
    value2 <- 1
    value3 <- 1
    scoped {
    } cleanup {
      value1 <- 2
      value2 <- 2
    } in scoped {
    } cleanup {
      value2 <- 3
      value3 <- 3
    } in return value1, value2, value3
  }

  get () {
    return value1, value2, value3
  }
}

define Test {
  run () {
    Value value <- Value$create()
    Int value1, Int value2, Int value3 <- value.call()
    if (value1 != 1) {
      fail(value1)
    }
    if (value2 != 1) {
      fail(value2)
    }
    if (value3 != 1) {
      fail(value3)
    }
    value1, value2, value3 <- value.get()
    if (value1 != 2) {
      fail(value1)
    }
    if (value2 != 2) {
      fail(value2)
    }
    if (value3 != 3) {
      fail(value3)
    }
  }
}

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


testcase "cleanup cannot refer to later variables" {
  error
  require "value.+not defined"
}

define Test {
  run () {
    scoped {
    } cleanup {
      value <- 1
    } in Int value <- 2
  }
}

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


testcase "cleanup not merged" {
  error
  require "value.+not defined"
}

define Test {
  run () {
    scoped {
    } cleanup {
      Int value <- 0
    } in scoped {
    } cleanup {
      value <- 1
    } in \ empty
  }
}

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


testcase "no name clash in nested scope with return" {
  success Test$run()
}

define Test {
  run () {
    scoped {
    } cleanup {
      Int value <- 0
    } in scoped {
    } cleanup {
      Int value <- 1
    } in return _
  }
}

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


testcase "cleanup skipped for fail" {
  crash Test$run()
  require "scoped"
}

define Test {
  run () {
    scoped {
      String message <- "scoped"
    } cleanup {
      message <- "cleanup"
    } in fail(message)
  }
}

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


testcase "cleanup not applied to returns outside of scope" {
  success Test$run()
}

define Test {
  run () {
    Int value <- 0
    scoped {
    } cleanup {
      if (value != 0) {
        fail(value)
      }
    } in \ empty

    value <- 1
    return _
  }
}

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


testcase "cleanup unconditional" {
  success Test$run()
}

@value interface Value {}

define Test {
  run () {
    scoped {
      Int x <- 1
    } in {
      \ x
    }
  }
}

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


testcase "scoped empty blocks" {
  success Test$run()
}

@value interface Value {}

define Test {
  run () {
    scoped {
      // empty
    } cleanup {
      // empty
    } in {
      // empty
    }
  }
}

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


testcase "just cleanup" {
  success Test$run()
}

concrete Value {
  @type create () -> (Value)
  @value postIncrement () -> (Int)
  @value get () -> (Int)
}

define Value {
  @value Int value

  create () {
    return Value{ 0 }
  }

  postIncrement () {
    cleanup {
      value <- value+1
    } in return value
  }

  get () {
    return value
  }
}

define Test {
  run () {
    Value value <- Value$create()
    Int value1 <- value.postIncrement()
    if (value1 != 0) {
      fail(value1)
    }
    Int value2 <- value.get()
    if (value2 != 1) {
      fail(value2)
    }
  }
}

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


testcase "separate trace context for cleanup" {
  crash Test$run()
  require "Failed"
  require "cleanup block"
  require "Test\.run"
  exclude "Failed.+Test\.run"
  exclude "Test\.run.+Failed"
}

define Test {
  run () {
    cleanup {
      fail("Failed")
    } in return _
  }
}

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