diff --git a/README.md b/README.md index 3772c12..c06cfa9 100644 --- a/README.md +++ b/README.md @@ -212,6 +212,41 @@ originating from tasks on the dispatcher queue. It is however possible that `Defect` that happen in tasks bubble up through `poll` as these are not caught by the transformation. +#### Checked exceptions + +By specifying a `asyncraises` list to an async procedure, you can check which +exceptions can be thrown by it. +```nim +proc p1(): Future[void] {.async, asyncraises: [IOError].} = + assert not (compiles do: raise newException(ValueError, "uh-uh")) + raise newException(IOError, "works") # Or any child of IOError +``` + +Under the hood, the return type of `p1` will be rewritten to another type, +which will convey raises informations to await. + +```nim +proc p2(): Future[void] {.async, asyncraises: [IOError].} = + await p1() # Works, because await knows that p1 + # can only raise IOError +``` + +The hidden type (`RaiseTrackingFuture`) is implicitely convertible into a Future. +However, it may causes issues when creating callback or methods +```nim +proc p3(): Future[void] {.async, asyncraises: [IOError].} = + let fut: Future[void] = p1() # works + assert not compiles(await fut) # await lost informations about raises, + # so it can raise anything + # Callbacks + assert not(compiles do: let cb1: proc(): Future[void] = p1) # doesn't work + let cb2: proc(): Future[void] {.async, asyncraises: [IOError].} = p1 # works + assert not(compiles do: + type c = proc(): Future[void] {.async, asyncraises: [IOError, ValueError].} + let cb3: c = p1 # doesn't work, the raises must match _exactly_ + ) +``` + ### Platform independence Several functions in `chronos` are backed by the operating system, such as diff --git a/chronos.nimble b/chronos.nimble index e9c1b11..f9e2617 100644 --- a/chronos.nimble +++ b/chronos.nimble @@ -7,7 +7,7 @@ description = "Networking framework with async/await support" license = "MIT or Apache License 2.0" skipDirs = @["tests"] -requires "nim >= 1.2.0", +requires "nim >= 1.6.0", "stew", "bearssl", "httputils", diff --git a/chronos/asyncfutures2.nim b/chronos/asyncfutures2.nim index 9674888..5a1383a 100644 --- a/chronos/asyncfutures2.nim +++ b/chronos/asyncfutures2.nim @@ -8,7 +8,7 @@ # Apache License, version 2.0, (LICENSE-APACHEv2) # MIT license (LICENSE-MIT) -import std/sequtils +import std/[sequtils, macros] import stew/base10 when chronosStackTrace: @@ -35,6 +35,12 @@ func `[]`*(loc: array[LocationKind, ptr SrcLoc], v: int): ptr SrcLoc {. else: raiseAssert("Unknown source location " & $v) type + InternalRaisesFuture*[T, E] = ref object of Future[T] + ## Future with a tuple of possible exception types + ## eg InternalRaisesFuture[void, (ValueError, OSError)] + ## Will be injected by `asyncraises`, should generally + ## not be used manually + FutureStr*[T] = ref object of Future[T] ## Future to hold GC strings gcholder*: string @@ -59,6 +65,11 @@ proc newFutureImpl[T](loc: ptr SrcLoc, flags: FutureFlags): Future[T] = internalInitFutureBase(fut, loc, FutureState.Pending, flags) fut +proc newInternalRaisesFutureImpl[T, E](loc: ptr SrcLoc): InternalRaisesFuture[T, E] = + let fut = InternalRaisesFuture[T, E]() + internalInitFutureBase(fut, loc, FutureState.Pending, {}) + fut + proc newFutureSeqImpl[A, B](loc: ptr SrcLoc): FutureSeq[A, B] = let fut = FutureSeq[A, B]() internalInitFutureBase(fut, loc, FutureState.Pending, {}) @@ -70,12 +81,28 @@ proc newFutureStrImpl[T](loc: ptr SrcLoc): FutureStr[T] = fut template newFuture*[T](fromProc: static[string] = "", - flags: static[FutureFlags] = {}): Future[T] = + flags: static[FutureFlags] = {}): auto = ## Creates a new future. ## ## Specifying ``fromProc``, which is a string specifying the name of the proc ## that this future belongs to, is a good habit as it helps with debugging. - newFutureImpl[T](getSrcLocation(fromProc), flags) + when declared(InternalRaisesFutureRaises): # injected by `asyncraises` + newInternalRaisesFutureImpl[T, InternalRaisesFutureRaises](getSrcLocation(fromProc)) + else: + newFutureImpl[T](getSrcLocation(fromProc), flags) + +macro getFutureExceptions(T: typedesc): untyped = + if getTypeInst(T)[1].len > 2: + getTypeInst(T)[1][2] + else: + ident"void" + +template newInternalRaisesFuture*[T](fromProc: static[string] = ""): auto = + ## Creates a new future. + ## + ## Specifying ``fromProc``, which is a string specifying the name of the proc + ## that this future belongs to, is a good habit as it helps with debugging. + newInternalRaisesFutureImpl[T, getFutureExceptions(typeof(result))](getSrcLocation(fromProc)) template newFutureSeq*[A, B](fromProc: static[string] = ""): FutureSeq[A, B] = ## Create a new future which can hold/preserve GC sequence until future will @@ -188,6 +215,49 @@ template fail*(future: FutureBase, error: ref CatchableError) = ## Completes ``future`` with ``error``. fail(future, error, getSrcLocation()) +macro checkFailureType(future, error: typed): untyped = + let e = getTypeInst(future)[2] + let types = getType(e) + + if types.eqIdent("void"): + error("Can't raise exceptions on this Future") + + expectKind(types, nnkBracketExpr) + expectKind(types[0], nnkSym) + assert types[0].strVal == "tuple" + assert types.len > 1 + + expectKind(getTypeInst(error), nnkRefTy) + let toMatch = getTypeInst(error)[0] + + # Can't find a way to check `is` in the macro. (sameType doesn't + # work for inherited objects). Dirty hack here, for [IOError, OSError], + # this will generate: + # + # static: + # if not((`toMatch` is IOError) or (`toMatch` is OSError) + # or (`toMatch` is CancelledError) or false): + # raiseAssert("Can't fail with `toMatch`, only [IOError, OSError] is allowed") + var typeChecker = ident"false" + + for errorType in types[1..^1]: + typeChecker = newCall("or", typeChecker, newCall("is", toMatch, errorType)) + typeChecker = newCall( + "or", typeChecker, + newCall("is", toMatch, ident"CancelledError")) + + let errorMsg = "Can't fail with " & repr(toMatch) & ". Only " & repr(types[1..^1]) & " allowed" + + result = nnkStaticStmt.newNimNode(lineInfoFrom=error).add( + quote do: + if not(`typeChecker`): + raiseAssert(`errorMsg`) + ) + +template fail*[T, E](future: InternalRaisesFuture[T, E], error: ref CatchableError) = + checkFailureType(future, error) + fail(future, error, getSrcLocation()) + template newCancelledError(): ref CancelledError = (ref CancelledError)(msg: "Future operation cancelled!") @@ -429,6 +499,53 @@ proc internalCheckComplete*(fut: FutureBase) {.raises: [CatchableError].} = injectStacktrace(fut.internalError) raise fut.internalError +macro internalCheckComplete*(f: InternalRaisesFuture): untyped = + # For InternalRaisesFuture[void, (ValueError, OSError), will do: + # {.cast(raises: [ValueError, OSError]).}: + # if isNil(f.error): discard + # else: raise f.error + let e = getTypeInst(f)[2] + let types = getType(e) + + if types.eqIdent("void"): + return quote do: + if not(isNil(`f`.internalError)): + raiseAssert("Unhandled future exception: " & `f`.error.msg) + + expectKind(types, nnkBracketExpr) + expectKind(types[0], nnkSym) + assert types[0].strVal == "tuple" + assert types.len > 1 + + let ifRaise = nnkIfExpr.newTree( + nnkElifExpr.newTree( + quote do: isNil(`f`.internalError), + quote do: discard + ), + nnkElseExpr.newTree( + nnkRaiseStmt.newNimNode(lineInfoFrom=f).add( + quote do: (`f`.internalError) + ) + ) + ) + + nnkPragmaBlock.newTree( + nnkPragma.newTree( + nnkCast.newTree( + newEmptyNode(), + nnkExprColonExpr.newTree( + ident"raises", + block: + var res = nnkBracket.newTree() + for r in types[1..^1]: + res.add(r) + res + ) + ), + ), + ifRaise + ) + proc read*[T: not void](future: Future[T] ): lent T {.raises: [CatchableError].} = ## Retrieves the value of ``future``. Future must be finished otherwise ## this function will fail with a ``ValueError`` exception. @@ -452,6 +569,29 @@ proc read*(future: Future[void] ) {.raises: [CatchableError].} = # TODO: Make a custom exception type for this? raise newException(ValueError, "Future still in progress.") +proc read*[T: not void, E](future: InternalRaisesFuture[T, E] ): lent T = + ## Retrieves the value of ``future``. Future must be finished otherwise + ## this function will fail with a ``ValueError`` exception. + ## + ## If the result of the future is an error then that error will be raised. + if not future.finished(): + # TODO: Make a custom exception type for this? + raise newException(ValueError, "Future still in progress.") + + internalCheckComplete(future) + future.internalValue + +proc read*[E](future: InternalRaisesFuture[void, E]) = + ## Retrieves the value of ``future``. Future must be finished otherwise + ## this function will fail with a ``ValueError`` exception. + ## + ## If the result of the future is an error then that error will be raised. + if future.finished(): + internalCheckComplete(future) + else: + # TODO: Make a custom exception type for this? + raise newException(ValueError, "Future still in progress.") + proc readError*(future: FutureBase): ref CatchableError {.raises: [ValueError].} = ## Retrieves the exception stored in ``future``. ## diff --git a/chronos/asyncmacro2.nim b/chronos/asyncmacro2.nim index d059404..499f847 100644 --- a/chronos/asyncmacro2.nim +++ b/chronos/asyncmacro2.nim @@ -2,108 +2,144 @@ # # Nim's Runtime Library # (c) Copyright 2015 Dominik Picheta +# (c) Copyright 2018-Present Status Research & Development GmbH # # See the file "copying.txt", included in this # distribution, for details about the copyright. # -import std/[macros] +import std/algorithm proc processBody(node, setResultSym, baseType: NimNode): NimNode {.compileTime.} = - #echo(node.treeRepr) case node.kind of nnkReturnStmt: + # `return ...` -> `setResult(...); return` let res = newNimNode(nnkStmtList, node) if node[0].kind != nnkEmpty: res.add newCall(setResultSym, processBody(node[0], setResultSym, baseType)) - res.add newNimNode(nnkReturnStmt, node).add(newNilLit()) + res.add newNimNode(nnkReturnStmt, node).add(newEmptyNode()) res of RoutineNodes-{nnkTemplateDef}: - # skip all the nested procedure definitions + # Skip nested routines since they have their own return value distinct from + # the Future we inject node else: for i in 0 ..< node.len: - # We must not transform nested procedures of any form, since their - # returns are not meant for our futures node[i] = processBody(node[i], setResultSym, baseType) node -proc wrapInTryFinally(fut, baseType, body: NimNode): NimNode {.compileTime.} = +proc wrapInTryFinally(fut, baseType, body, raisesTuple: NimNode): NimNode {.compileTime.} = # creates: - # var closureSucceeded = true # try: `body` - # except CancelledError: closureSucceeded = false; `castFutureSym`.cancelAndSchedule() - # except CatchableError as exc: closureSucceeded = false; `castFutureSym`.fail(exc) - # except Defect as exc: - # closureSucceeded = false - # raise exc + # [for raise in raisesTuple]: + # except `raise`: closureSucceeded = false; `castFutureSym`.fail(exc) # finally: # if closureSucceeded: # `castFutureSym`.complete(result) + # + # Calling `complete` inside `finally` ensures that all success paths + # (including early returns and code inside nested finally statements and + # defer) are completed with the final contents of `result` + let + closureSucceeded = genSym(nskVar, "closureSucceeded") + nTry = nnkTryStmt.newTree(body) + excName = ident"exc" - # we are completing inside finally to make sure the completion happens even - # after a `return` - let closureSucceeded = genSym(nskVar, "closureSucceeded") - var nTry = nnkTryStmt.newTree(body) - nTry.add nnkExceptBranch.newTree( - ident"CancelledError", + # Depending on the exception type, we must have at most one of each of these + # "special" exception handlers that are needed to implement cancellation and + # Defect propagation + var + hasDefect = false + hasCancelledError = false + hasCatchableError = false + + template addDefect = + if not hasDefect: + hasDefect = true + # When a Defect is raised, the program is in an undefined state and + # continuing running other tasks while the Future completion sits on the + # callback queue may lead to further damage so we re-raise them eagerly. + nTry.add nnkExceptBranch.newTree( + nnkInfix.newTree(ident"as", ident"Defect", excName), nnkStmtList.newTree( nnkAsgn.newTree(closureSucceeded, ident"false"), - newCall(ident "cancelAndSchedule", fut) + nnkRaiseStmt.newTree(excName) ) ) - - nTry.add nnkExceptBranch.newTree( - nnkInfix.newTree(ident"as", ident"CatchableError", ident"exc"), - nnkStmtList.newTree( - nnkAsgn.newTree(closureSucceeded, ident"false"), - newCall(ident "fail", fut, ident"exc") - ) - ) - - nTry.add nnkExceptBranch.newTree( - nnkInfix.newTree(ident"as", ident"Defect", ident"exc"), - nnkStmtList.newTree( - nnkAsgn.newTree(closureSucceeded, ident"false"), - nnkRaiseStmt.newTree(ident"exc") - ) - ) - - when not chronosStrictException: - # adds - # except Exception as exc: - # closureSucceeded = false - # fut.fail((ref ValueError)(msg: exc.msg, parent: exc)) - let excName = ident"exc" - - nTry.add nnkExceptBranch.newTree( - nnkInfix.newTree(ident"as", ident"Exception", ident"exc"), - nnkStmtList.newTree( - nnkAsgn.newTree(closureSucceeded, ident"false"), - newCall(ident "fail", fut, - quote do: (ref ValueError)(msg: `excName`.msg, parent: `excName`)), - ) - ) - - nTry.add nnkFinally.newTree( - nnkIfStmt.newTree( - nnkElifBranch.newTree( - closureSucceeded, - nnkWhenStmt.newTree( - nnkElifExpr.newTree( - nnkInfix.newTree(ident "is", baseType, ident "void"), - newCall(ident "complete", fut) - ), - nnkElseExpr.newTree( - newCall(ident "complete", fut, ident "result") - ) + template addCancelledError = + if not hasCancelledError: + hasCancelledError = true + nTry.add nnkExceptBranch.newTree( + ident"CancelledError", + nnkStmtList.newTree( + nnkAsgn.newTree(closureSucceeded, ident"false"), + newCall(ident "cancelAndSchedule", fut) ) ) + + template addCatchableError = + if not hasCatchableError: + hasCatchableError = true + nTry.add nnkExceptBranch.newTree( + nnkInfix.newTree(ident"as", ident"CatchableError", excName), + nnkStmtList.newTree( + nnkAsgn.newTree(closureSucceeded, ident"false"), + newCall(ident "fail", fut, excName) + )) + + for exc in raisesTuple: + if exc.eqIdent("Exception"): + addCancelledError + addCatchableError + addDefect + + # Because we store `CatchableError` in the Future, we cannot re-raise the + # original exception + nTry.add nnkExceptBranch.newTree( + nnkInfix.newTree(ident"as", ident"Exception", excName), + newCall(ident "fail", fut, + nnkStmtList.newTree( + nnkAsgn.newTree(closureSucceeded, ident"false"), + quote do: (ref ValueError)(msg: `excName`.msg, parent: `excName`))) + ) + elif exc.eqIdent("CancelledError"): + addCancelledError + elif exc.eqIdent("CatchableError"): + # Ensure cancellations are re-routed to the cancellation handler even if + # not explicitly specified in the raises list + addCancelledError + addCatchableError + else: + nTry.add nnkExceptBranch.newTree( + nnkInfix.newTree(ident"as", exc, excName), + nnkStmtList.newTree( + nnkAsgn.newTree(closureSucceeded, ident"false"), + newCall(ident "fail", fut, excName) + )) + + nTry.add nnkFinally.newTree( + nnkIfStmt.newTree( + nnkElifBranch.newTree( + closureSucceeded, + if baseType.eqIdent("void"): # shortcut for non-generic void + newCall(ident "complete", fut) + else: + nnkWhenStmt.newTree( + nnkElifExpr.newTree( + nnkInfix.newTree(ident "is", baseType, ident "void"), + newCall(ident "complete", fut) + ), + nnkElseExpr.newTree( + newCall(ident "complete", fut, ident "result") ) ) - return nnkStmtList.newTree( + ) + ) + ) + + nnkStmtList.newTree( newVarStmt(closureSucceeded, ident"true"), nTry ) @@ -144,6 +180,54 @@ proc cleanupOpenSymChoice(node: NimNode): NimNode {.compileTime.} = for child in node: result.add(cleanupOpenSymChoice(child)) +proc getAsyncCfg(prc: NimNode): tuple[raises: bool, async: bool, raisesTuple: NimNode] = + # reads the pragmas to extract the useful data + # and removes them + var + foundRaises = -1 + foundAsync = -1 + + for index, pragma in pragma(prc): + if pragma.kind == nnkExprColonExpr and pragma[0] == ident "asyncraises": + foundRaises = index + elif pragma.eqIdent("async"): + foundAsync = index + elif pragma.kind == nnkExprColonExpr and pragma[0] == ident "raises": + warning("The raises pragma doesn't work on async procedure. " & + "Please remove it or use asyncraises instead") + + result.raises = foundRaises >= 0 + result.async = foundAsync >= 0 + result.raisesTuple = nnkTupleConstr.newTree() + + if foundRaises >= 0: + for possibleRaise in pragma(prc)[foundRaises][1]: + result.raisesTuple.add(possibleRaise) + if result.raisesTuple.len == 0: + result.raisesTuple = ident("void") + else: + when defined(chronosWarnMissingRaises): + warning("Async proc miss asyncraises") + const defaultException = + when defined(chronosStrictException): "CatchableError" + else: "Exception" + result.raisesTuple.add(ident(defaultException)) + + let toRemoveList = @[foundRaises, foundAsync].filterIt(it >= 0).sorted().reversed() + for toRemove in toRemoveList: + pragma(prc).del(toRemove) + +proc isEmpty(n: NimNode): bool {.compileTime.} = + # true iff node recursively contains only comments or empties + case n.kind + of nnkEmpty, nnkCommentStmt: true + of nnkStmtList: + for child in n: + if not isEmpty(child): return false + true + else: + false + proc asyncSingleProc(prc: NimNode): NimNode {.compileTime.} = ## This macro transforms a single procedure into a closure iterator. ## The ``async`` macro supports a stmtList holding multiple async procedures. @@ -158,7 +242,8 @@ proc asyncSingleProc(prc: NimNode): NimNode {.compileTime.} = if returnType.kind == nnkEmpty: ident "void" elif not ( - returnType.kind == nnkBracketExpr and eqIdent(returnType[0], "Future")): + returnType.kind == nnkBracketExpr and + (eqIdent(returnType[0], "Future") or eqIdent(returnType[0], "InternalRaisesFuture"))): error( "Expected return type of 'Future' got '" & repr(returnType) & "'", prc) return @@ -168,77 +253,111 @@ proc asyncSingleProc(prc: NimNode): NimNode {.compileTime.} = let baseTypeIsVoid = baseType.eqIdent("void") futureVoidType = nnkBracketExpr.newTree(ident "Future", ident "void") + (hasRaises, isAsync, raisesTuple) = getAsyncCfg(prc) - if prc.kind in {nnkProcDef, nnkLambda, nnkMethodDef, nnkDo}: + if hasRaises: + # Store `asyncraises` types in InternalRaisesFuture + prc.params2[0] = nnkBracketExpr.newTree( + newIdentNode("InternalRaisesFuture"), + baseType, + raisesTuple + ) + elif baseTypeIsVoid: + # Adds the implicit Future[void] + prc.params2[0] = + newNimNode(nnkBracketExpr, prc). + add(newIdentNode("Future")). + add(newIdentNode("void")) + + if prc.kind notin {nnkProcTy, nnkLambda}: # TODO: Nim bug? + prc.addPragma(newColonExpr(ident "stackTrace", ident "off")) + + # The proc itself doesn't raise + prc.addPragma( + nnkExprColonExpr.newTree(newIdentNode("raises"), nnkBracket.newTree())) + + # `gcsafe` isn't deduced even though we require async code to be gcsafe + # https://github.com/nim-lang/RFCs/issues/435 + prc.addPragma(newIdentNode("gcsafe")) + + if isAsync == false: # `asyncraises` without `async` + # type InternalRaisesFutureRaises = `raisesTuple` + # `body` + prc.body = nnkStmtList.newTree( + nnkTypeSection.newTree( + nnkTypeDef.newTree( + ident"InternalRaisesFutureRaises", + newEmptyNode(), + raisesTuple + ) + ), + prc.body + ) + + return prc + + if prc.kind in {nnkProcDef, nnkLambda, nnkMethodDef, nnkDo} and + not isEmpty(prc.body): + # don't do anything with forward bodies (empty) let prcName = prc.name.getName - outerProcBody = newNimNode(nnkStmtList, prc.body) - - # Copy comment for nimdoc - if prc.body.len > 0 and prc.body[0].kind == nnkCommentStmt: - outerProcBody.add(prc.body[0]) - - let + setResultSym = ident "setResult" + procBody = prc.body.processBody(setResultSym, baseType) internalFutureSym = ident "chronosInternalRetFuture" internalFutureType = if baseTypeIsVoid: futureVoidType else: returnType castFutureSym = nnkCast.newTree(internalFutureType, internalFutureSym) - setResultSym = ident"setResult" + resultIdent = ident "result" - procBody = prc.body.processBody(setResultSym, baseType) - - # don't do anything with forward bodies (empty) - if procBody.kind != nnkEmpty: - let - # fix #13899, `defer` should not escape its original scope - procBodyBlck = nnkBlockStmt.newTree(newEmptyNode(), procBody) - - resultDecl = nnkWhenStmt.newTree( - # when `baseType` is void: - nnkElifExpr.newTree( - nnkInfix.newTree(ident "is", baseType, ident "void"), - quote do: - template result: auto {.used.} = - {.fatal: "You should not reference the `result` variable inside" & - " a void async proc".} - ), - # else: - nnkElseExpr.newTree( - newStmtList( - quote do: {.push warning[resultshadowed]: off.}, - # var result {.used.}: `baseType` - # In the proc body, result may or may not end up being used - # depending on how the body is written - with implicit returns / - # expressions in particular, it is likely but not guaranteed that - # it is not used. Ideally, we would avoid emitting it in this - # case to avoid the default initializaiton. {.used.} typically - # works better than {.push.} which has a tendency to leak out of - # scope. - # TODO figure out if there's a way to detect `result` usage in - # the proc body _after_ template exapnsion, and therefore - # avoid creating this variable - one option is to create an - # addtional when branch witha fake `result` and check - # `compiles(procBody)` - this is not without cost though - nnkVarSection.newTree(nnkIdentDefs.newTree( - nnkPragmaExpr.newTree( - ident "result", - nnkPragma.newTree(ident "used")), - baseType, newEmptyNode()) - ), - quote do: {.pop.}, - ) + resultDecl = nnkWhenStmt.newTree( + # when `baseType` is void: + nnkElifExpr.newTree( + nnkInfix.newTree(ident "is", baseType, ident "void"), + quote do: + template result: auto {.used.} = + {.fatal: "You should not reference the `result` variable inside" & + " a void async proc".} + ), + # else: + nnkElseExpr.newTree( + newStmtList( + quote do: {.push warning[resultshadowed]: off.}, + # var result {.used.}: `baseType` + # In the proc body, result may or may not end up being used + # depending on how the body is written - with implicit returns / + # expressions in particular, it is likely but not guaranteed that + # it is not used. Ideally, we would avoid emitting it in this + # case to avoid the default initializaiton. {.used.} typically + # works better than {.push.} which has a tendency to leak out of + # scope. + # TODO figure out if there's a way to detect `result` usage in + # the proc body _after_ template exapnsion, and therefore + # avoid creating this variable - one option is to create an + # addtional when branch witha fake `result` and check + # `compiles(procBody)` - this is not without cost though + nnkVarSection.newTree(nnkIdentDefs.newTree( + nnkPragmaExpr.newTree( + resultIdent, + nnkPragma.newTree(ident "used")), + baseType, newEmptyNode()) + ), + quote do: {.pop.}, ) ) + ) - # generates: - # template `setResultSym`(code: untyped) {.used.} = - # when typeof(code) is void: code - # else: result = code - # - # this is useful to handle implicit returns, but also - # to bind the `result` to the one we declare here - setResultDecl = + # generates: + # template `setResultSym`(code: untyped) {.used.} = + # when typeof(code) is void: code + # else: `resultIdent` = code + # + # this is useful to handle implicit returns, but also + # to bind the `result` to the one we declare here + setResultDecl = + if baseTypeIsVoid: # shortcut for non-generic void + newEmptyNode() + else: nnkTemplateDef.newTree( setResultSym, newEmptyNode(), newEmptyNode(), @@ -254,107 +373,91 @@ proc asyncSingleProc(prc: NimNode): NimNode {.compileTime.} = newEmptyNode(), nnkWhenStmt.newTree( nnkElifBranch.newTree( - nnkInfix.newTree(ident"is", nnkTypeOfExpr.newTree(ident"code"), ident"void"), + nnkInfix.newTree( + ident"is", nnkTypeOfExpr.newTree(ident"code"), ident"void"), ident"code" ), nnkElse.newTree( - newAssignment(ident"result", ident"code") + newAssignment(resultIdent, ident"code") ) ) ) - completeDecl = wrapInTryFinally( - castFutureSym, baseType, - newCall(setResultSym, procBodyBlck) - ) - - closureBody = newStmtList(resultDecl, setResultDecl, completeDecl) - - internalFutureParameter = nnkIdentDefs.newTree( - internalFutureSym, newIdentNode("FutureBase"), newEmptyNode()) - iteratorNameSym = genSym(nskIterator, $prcName) - closureIterator = newProc( - iteratorNameSym, - [newIdentNode("FutureBase"), internalFutureParameter], - closureBody, nnkIteratorDef) - - iteratorNameSym.copyLineInfo(prc) - - closureIterator.pragma = newNimNode(nnkPragma, lineInfoFrom=prc.body) - closureIterator.addPragma(newIdentNode("closure")) - - # `async` code must be gcsafe - closureIterator.addPragma(newIdentNode("gcsafe")) - - # TODO when push raises is active in a module, the iterator here inherits - # that annotation - here we explicitly disable it again which goes - # against the spirit of the raises annotation - one should investigate - # here the possibility of transporting more specific error types here - # for example by casting exceptions coming out of `await`.. - let raises = nnkBracket.newTree() - - closureIterator.addPragma(nnkExprColonExpr.newTree( - newIdentNode("raises"), - raises - )) - - # If proc has an explicit gcsafe pragma, we add it to iterator as well. - # TODO if these lines are not here, srcloc tests fail (!) - if prc.pragma.findChild(it.kind in {nnkSym, nnkIdent} and - it.strVal == "gcsafe") != nil: - closureIterator.addPragma(newIdentNode("gcsafe")) - - outerProcBody.add(closureIterator) - - # -> let resultFuture = newFuture[T]() - # declared at the end to be sure that the closure - # doesn't reference it, avoid cyclic ref (#203) - let - retFutureSym = ident "resultFuture" - retFutureSym.copyLineInfo(prc) - # Do not change this code to `quote do` version because `instantiationInfo` - # will be broken for `newFuture()` call. - outerProcBody.add( - newLetStmt( - retFutureSym, - newCall(newTree(nnkBracketExpr, ident "newFuture", baseType), - newLit(prcName)) - ) - ) - # -> resultFuture.internalClosure = iterator - outerProcBody.add( - newAssignment( - newDotExpr(retFutureSym, newIdentNode("internalClosure")), - iteratorNameSym) + # Wrapping in try/finally ensures that early returns are handled properly + # and that `defer` is processed in the right scope + completeDecl = wrapInTryFinally( + castFutureSym, baseType, + if baseTypeIsVoid: procBody # shortcut for non-generic `void` + else: newCall(setResultSym, procBody), + raisesTuple ) - # -> futureContinue(resultFuture)) - outerProcBody.add( - newCall(newIdentNode("futureContinue"), retFutureSym) + closureBody = newStmtList(resultDecl, setResultDecl, completeDecl) + + internalFutureParameter = nnkIdentDefs.newTree( + internalFutureSym, newIdentNode("FutureBase"), newEmptyNode()) + iteratorNameSym = genSym(nskIterator, $prcName) + closureIterator = newProc( + iteratorNameSym, + [newIdentNode("FutureBase"), internalFutureParameter], + closureBody, nnkIteratorDef) + + outerProcBody = newNimNode(nnkStmtList, prc.body) + + # Copy comment for nimdoc + if prc.body.len > 0 and prc.body[0].kind == nnkCommentStmt: + outerProcBody.add(prc.body[0]) + + iteratorNameSym.copyLineInfo(prc) + + closureIterator.pragma = newNimNode(nnkPragma, lineInfoFrom=prc.body) + closureIterator.addPragma(newIdentNode("closure")) + + # `async` code must be gcsafe + closureIterator.addPragma(newIdentNode("gcsafe")) + + # Exceptions are caught inside the iterator and stored in the future + closureIterator.addPragma(nnkExprColonExpr.newTree( + newIdentNode("raises"), + nnkBracket.newTree() + )) + + outerProcBody.add(closureIterator) + + # -> let resultFuture = newInternalRaisesFuture[T]() + # declared at the end to be sure that the closure + # doesn't reference it, avoid cyclic ref (#203) + let + retFutureSym = ident "resultFuture" + retFutureSym.copyLineInfo(prc) + # Do not change this code to `quote do` version because `instantiationInfo` + # will be broken for `newFuture()` call. + outerProcBody.add( + newLetStmt( + retFutureSym, + newCall(newTree(nnkBracketExpr, ident "newInternalRaisesFuture", baseType), + newLit(prcName)) ) + ) + # -> resultFuture.internalClosure = iterator + outerProcBody.add( + newAssignment( + newDotExpr(retFutureSym, newIdentNode("internalClosure")), + iteratorNameSym) + ) - # -> return resultFuture - outerProcBody.add newNimNode(nnkReturnStmt, prc.body[^1]).add(retFutureSym) + # -> futureContinue(resultFuture)) + outerProcBody.add( + newCall(newIdentNode("futureContinue"), retFutureSym) + ) - prc.body = outerProcBody + # -> return resultFuture + outerProcBody.add newNimNode(nnkReturnStmt, prc.body[^1]).add(retFutureSym) - if prc.kind notin {nnkProcTy, nnkLambda}: # TODO: Nim bug? - prc.addPragma(newColonExpr(ident "stackTrace", ident "off")) - - # See **Remark 435** in this file. - # https://github.com/nim-lang/RFCs/issues/435 - prc.addPragma(newIdentNode("gcsafe")) - - prc.addPragma(nnkExprColonExpr.newTree( - newIdentNode("raises"), - nnkBracket.newTree() - )) - - if baseTypeIsVoid: - if returnType.kind == nnkEmpty: - # Add Future[void] - prc.params2[0] = futureVoidType + prc.body = outerProcBody + when chronosDumpAsync: + echo repr prc prc template await*[T](f: Future[T]): untyped = @@ -365,7 +468,8 @@ template await*[T](f: Future[T]): untyped = # responsible for resuming execution once the yielded future is finished yield chronosInternalRetFuture.internalChild # `child` released by `futureContinue` - chronosInternalRetFuture.internalChild.internalCheckComplete() + cast[type(f)](chronosInternalRetFuture.internalChild).internalCheckComplete() + when T isnot void: cast[type(f)](chronosInternalRetFuture.internalChild).value() else: @@ -385,8 +489,26 @@ macro async*(prc: untyped): untyped = if prc.kind == nnkStmtList: result = newStmtList() for oneProc in prc: + oneProc.addPragma(ident"async") result.add asyncSingleProc(oneProc) else: + prc.addPragma(ident"async") + result = asyncSingleProc(prc) + +macro asyncraises*(possibleExceptions, prc: untyped): untyped = + # Add back the pragma and let asyncSingleProc handle it + # Exerimental / subject to change and/or removal + if prc.kind == nnkStmtList: + result = newStmtList() + for oneProc in prc: + oneProc.addPragma(nnkExprColonExpr.newTree( + ident"asyncraises", + possibleExceptions + )) + result.add asyncSingleProc(oneProc) + else: + prc.addPragma(nnkExprColonExpr.newTree( + ident"asyncraises", + possibleExceptions + )) result = asyncSingleProc(prc) - when chronosDumpAsync: - echo repr result diff --git a/tests/testfut.nim b/tests/testfut.nim index bc61594..fc9d482 100644 --- a/tests/testfut.nim +++ b/tests/testfut.nim @@ -1223,11 +1223,11 @@ suite "Future[T] behavior test suite": test "location test": # WARNING: This test is very sensitive to line numbers and module name. - proc macroFuture() {.async.} = # LINE POSITION 1 - let someVar {.used.} = 5 # LINE POSITION 2 + proc macroFuture() {.async.} = + let someVar {.used.} = 5 # LINE POSITION 1 let someOtherVar {.used.} = 4 if true: - let otherVar {.used.} = 3 + let otherVar {.used.} = 3 # LINE POSITION 2 template templateFuture(): untyped = newFuture[void]("template") @@ -1260,8 +1260,8 @@ suite "Future[T] behavior test suite": (loc.procedure == procedure) check: - chk(loc10, "testfut.nim", 1226, "macroFuture") - chk(loc11, "testfut.nim", 1227, "") + chk(loc10, "testfut.nim", 1227, "macroFuture") + chk(loc11, "testfut.nim", 1230, "") chk(loc20, "testfut.nim", 1239, "template") chk(loc21, "testfut.nim", 1242, "") chk(loc30, "testfut.nim", 1236, "procedure") diff --git a/tests/testmacro.nim b/tests/testmacro.nim index bd53078..2d95a7f 100644 --- a/tests/testmacro.nim +++ b/tests/testmacro.nim @@ -151,6 +151,10 @@ suite "Macro transformations test suite": check waitFor(nr()) == 42 +# There are a few unreacheable statements to ensure that we don't regress in +# generated code +{.push warning[UnreachableCode]: off.} + suite "Macro transformations - completions": test "Run closure to completion on return": # issue #415 var x = 0 @@ -203,6 +207,21 @@ suite "Macro transformations - completions": testWeirdCase() == waitFor(testWeirdCaseAsync()) testWeirdCase() == 55 + test "Correct return value with result assignment in defer": + proc testWeirdCase: int = + defer: + result = 55 + result = 33 + proc testWeirdCaseAsync: Future[int] {.async.} = + defer: + result = 55 + await sleepAsync(1.milliseconds) + return 33 + + check: + testWeirdCase() == waitFor(testWeirdCaseAsync()) + testWeirdCase() == 55 + test "Generic & finally calling async": proc testGeneric(T: type): Future[T] {.async.} = try: @@ -264,6 +283,7 @@ suite "Macro transformations - completions": result = 12 result = await a2() check waitFor(asyncInAsync()) == 12 +{.pop.} suite "Macro transformations - implicit returns": test "Implicit return": @@ -362,3 +382,98 @@ suite "Closure iterator's exception transformation issues": waitFor(x()) +suite "Exceptions tracking": + template checkNotCompiles(body: untyped) = + check (not compiles(body)) + test "Can raise valid exception": + proc test1 {.async.} = raise newException(ValueError, "hey") + proc test2 {.async, asyncraises: [ValueError].} = raise newException(ValueError, "hey") + proc test3 {.async, asyncraises: [IOError, ValueError].} = + if 1 == 2: + raise newException(ValueError, "hey") + else: + raise newException(IOError, "hey") + + proc test4 {.async, asyncraises: [], used.} = raise newException(Defect, "hey") + proc test5 {.async, asyncraises: [].} = discard + proc test6 {.async, asyncraises: [].} = await test5() + + expect(ValueError): waitFor test1() + expect(ValueError): waitFor test2() + expect(IOError): waitFor test3() + waitFor test6() + + test "Cannot raise invalid exception": + checkNotCompiles: + proc test3 {.async, asyncraises: [IOError].} = raise newException(ValueError, "hey") + + test "Explicit return in non-raising proc": + proc test(): Future[int] {.async, asyncraises: [].} = return 12 + check: + waitFor(test()) == 12 + + test "Non-raising compatibility": + proc test1 {.async, asyncraises: [ValueError].} = raise newException(ValueError, "hey") + let testVar: Future[void] = test1() + + proc test2 {.async.} = raise newException(ValueError, "hey") + let testVar2: proc: Future[void] = test2 + + # Doesn't work unfortunately + #let testVar3: proc: Future[void] = test1 + + test "Cannot store invalid future types": + proc test1 {.async, asyncraises: [ValueError].} = raise newException(ValueError, "hey") + proc test2 {.async, asyncraises: [IOError].} = raise newException(IOError, "hey") + + var a = test1() + checkNotCompiles: + a = test2() + + test "Await raises the correct types": + proc test1 {.async, asyncraises: [ValueError].} = raise newException(ValueError, "hey") + proc test2 {.async, asyncraises: [ValueError, CancelledError].} = await test1() + checkNotCompiles: + proc test3 {.async, asyncraises: [CancelledError].} = await test1() + + test "Can create callbacks": + proc test1 {.async, asyncraises: [ValueError].} = raise newException(ValueError, "hey") + let callback: proc() {.async, asyncraises: [ValueError].} = test1 + + test "Can return values": + proc test1: Future[int] {.async, asyncraises: [ValueError].} = + if 1 == 0: raise newException(ValueError, "hey") + return 12 + proc test2: Future[int] {.async, asyncraises: [ValueError, IOError, CancelledError].} = + return await test1() + + checkNotCompiles: + proc test3: Future[int] {.async, asyncraises: [CancelledError].} = await test1() + + check waitFor(test2()) == 12 + + test "Manual tracking": + proc test1: Future[int] {.asyncraises: [ValueError].} = + result = newFuture[int]() + result.complete(12) + check waitFor(test1()) == 12 + + proc test2: Future[int] {.asyncraises: [IOError, OSError].} = + result = newFuture[int]() + result.fail(newException(IOError, "fail")) + result.fail(newException(OSError, "fail")) + checkNotCompiles: + result.fail(newException(ValueError, "fail")) + + proc test3: Future[void] {.asyncraises: [].} = + checkNotCompiles: + result.fail(newException(ValueError, "fail")) + + # Inheritance + proc test4: Future[void] {.asyncraises: [CatchableError].} = + result.fail(newException(IOError, "fail")) + + test "Reversed async, asyncraises": + proc test44 {.asyncraises: [ValueError], async.} = raise newException(ValueError, "hey") + checkNotCompiles: + proc test33 {.asyncraises: [IOError], async.} = raise newException(ValueError, "hey")