diff options
45 files changed, 1300 insertions, 507 deletions
diff --git a/changelog.md b/changelog.md index 85e06112b..9382a194f 100644 --- a/changelog.md +++ b/changelog.md @@ -124,6 +124,8 @@ proc enumToString*(enums: openArray[enum]): string = - Added `xmltree.toXmlAttributes`. +- Added `Rusage`, `getrusage`, `wait4` to posix interface. + ### Library changes diff --git a/compiler/ast.nim b/compiler/ast.nim index 24891d6d3..fc470b7a8 100644 --- a/compiler/ast.nim +++ b/compiler/ast.nim @@ -1352,7 +1352,6 @@ proc copySym*(s: PSym): PSym = result = newSym(s.kind, s.name, s.owner, s.info, s.options) #result.ast = nil # BUGFIX; was: s.ast which made problems result.typ = s.typ - result.id = getID() when debugIds: registerId(result) result.flags = s.flags result.magic = s.magic diff --git a/compiler/ccgexprs.nim b/compiler/ccgexprs.nim index ed6255004..5bcbcda1c 100644 --- a/compiler/ccgexprs.nim +++ b/compiler/ccgexprs.nim @@ -460,7 +460,7 @@ proc binaryStmtAddr(p: BProc, e: PNode, d: var TLoc, frmt: string) = if d.k != locNone: internalError(p.config, e.info, "binaryStmtAddr") initLocExpr(p, e.sons[1], a) initLocExpr(p, e.sons[2], b) - lineCg(p, cpsStmts, frmt, addrLoc(p.config, a), rdLoc(b)) + lineCg(p, cpsStmts, frmt, byRefLoc(p, a), rdLoc(b)) proc unaryStmt(p: BProc, e: PNode, d: var TLoc, frmt: string) = var a: TLoc @@ -1028,7 +1028,7 @@ proc gcUsage(conf: ConfigRef; n: PNode) = proc strLoc(p: BProc; d: TLoc): Rope = if p.config.selectedGc == gcDestructors: - result = addrLoc(p.config, d) + result = byRefLoc(p, d) else: result = rdLoc(d) @@ -1110,7 +1110,7 @@ proc genStrAppend(p: BProc, e: PNode, d: var TLoc) = strLoc(p, dest), rdLoc(a))) if p.config.selectedGC == gcDestructors: linefmt(p, cpsStmts, "#prepareAdd($1, $2$3);$n", - addrLoc(p.config, dest), lens, rope(L)) + byRefLoc(p, dest), lens, rope(L)) else: initLoc(call, locCall, e, OnHeap) call.r = ropecg(p.module, "#resizeString($1, $2$3)", [rdLoc(dest), lens, rope(L)]) diff --git a/compiler/cgen.nim b/compiler/cgen.nim index 2d9814621..d020b1bd7 100644 --- a/compiler/cgen.nim +++ b/compiler/cgen.nim @@ -264,6 +264,12 @@ proc addrLoc(conf: ConfigRef; a: TLoc): Rope = if lfIndirect notin a.flags and mapType(conf, a.t) != ctArray: result = "(&" & result & ")" +proc byRefLoc(p: BProc; a: TLoc): Rope = + result = a.r + if lfIndirect notin a.flags and mapType(p.config, a.t) != ctArray and not + p.module.compileToCpp: + result = "(&" & result & ")" + proc rdCharLoc(a: TLoc): Rope = # read a location that may need a char-cast: result = rdLoc(a) diff --git a/compiler/destroyer.nim b/compiler/destroyer.nim index e21d532ea..22ace3634 100644 --- a/compiler/destroyer.nim +++ b/compiler/destroyer.nim @@ -244,7 +244,10 @@ proc patchHead(n: PNode) = proc patchHead(s: PSym) = if sfFromGeneric in s.flags: - patchHead(s.ast[bodyPos]) + # do not patch the builtin type bound operators for seqs: + let dest = s.typ.sons[1].skipTypes(abstractVar) + if dest.kind != tySequence: + patchHead(s.ast[bodyPos]) proc checkForErrorPragma(c: Con; t: PType; ri: PNode; opname: string) = var m = "'" & opname & "' is not available for type <" & typeToString(t) & ">" @@ -267,7 +270,8 @@ template genOp(opr, opname, ri) = globalError(c.graph.config, dest.info, "internal error: '" & opname & "' operator not found for type " & typeToString(t)) elif op.ast[genericParamsPos].kind != nkEmpty: - globalError(c.graph.config, dest.info, "internal error: '" & opname & "' operator is generic") + globalError(c.graph.config, dest.info, "internal error: '" & opname & + "' operator is generic") patchHead op if sfError in op.flags: checkForErrorPragma(c, t, ri, opname) let addrExp = newNodeIT(nkHiddenAddr, dest.info, makePtrType(c, dest.typ)) @@ -275,6 +279,12 @@ template genOp(opr, opname, ri) = result = newTree(nkCall, newSymNode(op), addrExp) proc genSink(c: Con; t: PType; dest, ri: PNode): PNode = + when false: + if t.kind != tyString: + echo "this one ", c.graph.config$dest.info, " for ", typeToString(t, preferDesc) + debug t.sink.typ.sons[2] + echo t.sink.id, " owner ", t.id + quit 1 let t = t.skipTypes({tyGenericInst, tyAlias, tySink}) genOp(if t.sink != nil: t.sink else: t.assignment, "=sink", ri) diff --git a/compiler/docgen.nim b/compiler/docgen.nim index a7f7d77b5..b70561a1d 100644 --- a/compiler/docgen.nim +++ b/compiler/docgen.nim @@ -149,14 +149,16 @@ proc newDocumentor*(filename: AbsoluteFile; cache: IdentCache; conf: ConfigRef, if filename.len == 0: inc(d.id) let nameOnly = splitFile(d.filename).name - let subdir = getNimcacheDir(conf) / RelativeDir(nameOnly) - createDir(subdir) - outp = subdir / RelativeFile(nameOnly & "_snippet_" & $d.id & ".nim") + outp = getNimcacheDir(conf) / RelativeDir(nameOnly) / + RelativeFile(nameOnly & "_snippet_" & $d.id & ".nim") elif isAbsolute(filename): - outp = AbsoluteFile filename + outp = AbsoluteFile(filename) else: # Nim's convention: every path is relative to the file it was written in: - outp = splitFile(d.filename).dir.AbsoluteDir / RelativeFile(filename) + let nameOnly = splitFile(d.filename).name + outp = AbsoluteDir(nameOnly) / RelativeFile(filename) + # Make sure the destination directory exists + createDir(outp.splitFile.dir) # Include the current file if we're parsing a nim file let importStmt = if d.isPureRst: "" else: "import \"$1\"\n" % [d.filename] writeFile(outp, importStmt & content) @@ -244,7 +246,7 @@ proc genComment(d: PDoc, n: PNode): string = result = "" var dummyHasToc: bool if n.comment.len > 0: - renderRstToOut(d[], parseRst(n.comment, toFilename(d.conf, n.info), + renderRstToOut(d[], parseRst(n.comment, toFullPath(d.conf, n.info), toLinenumber(n.info), toColumn(n.info), dummyHasToc, d.options, d.conf), result) diff --git a/compiler/lambdalifting.nim b/compiler/lambdalifting.nim index ddde1be31..ba67f0d4e 100644 --- a/compiler/lambdalifting.nim +++ b/compiler/lambdalifting.nim @@ -320,17 +320,30 @@ proc getEnvTypeForOwner(c: var DetectionPass; owner: PSym; rawAddSon(result, obj) c.ownerToType[owner.id] = result +proc getEnvTypeForOwnerUp(c: var DetectionPass; owner: PSym; + info: TLineInfo): PType = + var r = c.getEnvTypeForOwner(owner, info) + result = newType(tyPtr, owner) + rawAddSon(result, r.base) + proc createUpField(c: var DetectionPass; dest, dep: PSym; info: TLineInfo) = let refObj = c.getEnvTypeForOwner(dest, info) # getHiddenParam(dest).typ let obj = refObj.lastSon - let fieldType = c.getEnvTypeForOwner(dep, info) #getHiddenParam(dep).typ + # The assumption here is that gcDestructors means we cannot deal + # with cycles properly, so it's better to produce a weak ref (=ptr) here. + # This seems to be generally correct but since it's a bit risky it's only + # enabled for gcDestructors. + let fieldType = if c.graph.config.selectedGc == gcDestructors: + c.getEnvTypeForOwnerUp(dep, info) #getHiddenParam(dep).typ + else: + c.getEnvTypeForOwner(dep, info) if refObj == fieldType: localError(c.graph.config, dep.info, "internal error: invalid up reference computed") let upIdent = getIdent(c.graph.cache, upName) let upField = lookupInRecord(obj.n, upIdent) if upField != nil: - if upField.typ != fieldType: + if upField.typ.base != fieldType.base: localError(c.graph.config, dep.info, "internal error: up references do not agree") else: let result = newSym(skField, upIdent, obj.owner, obj.owner.info) @@ -555,7 +568,7 @@ proc rawClosureCreation(owner: PSym; let upField = lookupInRecord(env.typ.lastSon.n, getIdent(d.graph.cache, upName)) if upField != nil: let up = getUpViaParam(d.graph, owner) - if up != nil and upField.typ == up.typ: + if up != nil and upField.typ.base == up.typ.base: result.add(newAsgnStmt(rawIndirectAccess(env, upField, env.info), up, env.info)) #elif oldenv != nil and oldenv.typ == upField.typ: @@ -586,7 +599,7 @@ proc closureCreationForIter(iter: PNode; let upField = lookupInRecord(v.typ.lastSon.n, getIdent(d.graph.cache, upName)) if upField != nil: let u = setupEnvVar(owner, d, c) - if u.typ == upField.typ: + if u.typ.base == upField.typ.base: result.add(newAsgnStmt(rawIndirectAccess(vnode, upField, iter.info), u, iter.info)) else: diff --git a/compiler/modulepaths.nim b/compiler/modulepaths.nim index 9e27a2d7d..129f719e2 100644 --- a/compiler/modulepaths.nim +++ b/compiler/modulepaths.nim @@ -114,7 +114,6 @@ proc getModuleName*(conf: ConfigRef; n: PNode): string = try: result = pathSubs(conf, n.strVal, toFullPath(conf, n.info).splitFile().dir) - .replace(" ") except ValueError: localError(conf, n.info, "invalid path: " & n.strVal) result = n.strVal diff --git a/compiler/parser.nim b/compiler/parser.nim index c9626c527..01a3ce4d0 100644 --- a/compiler/parser.nim +++ b/compiler/parser.nim @@ -724,6 +724,14 @@ const tkTypeClasses = {tkRef, tkPtr, tkVar, tkStatic, tkType, tkEnum, tkTuple, tkObject, tkProc} +proc commandExpr(p: var TParser; r: PNode; mode: TPrimaryMode): PNode = + result = newNodeP(nkCommand, p) + addSon(result, r) + var isFirstParam = true + # progress NOT guaranteed + p.hasProgress = false + addSon result, commandParam(p, isFirstParam, mode) + proc primarySuffix(p: var TParser, r: PNode, baseIndent: int, mode: TPrimaryMode): PNode = #| primarySuffix = '(' (exprColonEqExpr comma?)* ')' doBlocks? @@ -734,8 +742,6 @@ proc primarySuffix(p: var TParser, r: PNode, #| | &( '`'|IDENT|literal|'cast'|'addr'|'type') expr # command syntax result = r - template somePar() = - if p.tok.strongSpaceA > 0: break # progress guaranteed while p.tok.indent < 0 or (p.tok.tokType == tkDot and p.tok.indent >= baseIndent): @@ -749,6 +755,8 @@ proc primarySuffix(p: var TParser, r: PNode, result = newNodeP(nkCommand, p) result.addSon r result.addSon primary(p, pmNormal) + else: + result = commandExpr(p, result, mode) break result = namedParams(p, result, nkCall, tkParRi) if result.len > 1 and result.sons[1].kind == nkExprColonExpr: @@ -759,39 +767,27 @@ proc primarySuffix(p: var TParser, r: PNode, result = parseGStrLit(p, result) of tkBracketLe: # progress guaranteed - somePar() + if p.tok.strongSpaceA > 0: + result = commandExpr(p, result, mode) + break result = namedParams(p, result, nkBracketExpr, tkBracketRi) of tkCurlyLe: # progress guaranteed - somePar() + if p.tok.strongSpaceA > 0: + result = commandExpr(p, result, mode) + break result = namedParams(p, result, nkCurlyExpr, tkCurlyRi) of tkSymbol, tkAccent, tkIntLit..tkCharLit, tkNil, tkCast, tkOpr, tkDotDot, tkTypeClasses - {tkRef, tkPtr}: - # XXX: In type sections we allow the free application of the - # command syntax, with the exception of expressions such as - # `foo ref` or `foo ptr`. Unfortunately, these two are also - # used as infix operators for the memory regions feature and - # the current parsing rules don't play well here. + # XXX: In type sections we allow the free application of the + # command syntax, with the exception of expressions such as + # `foo ref` or `foo ptr`. Unfortunately, these two are also + # used as infix operators for the memory regions feature and + # the current parsing rules don't play well here. if p.inPragma == 0 and (isUnary(p) or p.tok.tokType notin {tkOpr, tkDotDot}): # actually parsing {.push hints:off.} as {.push(hints:off).} is a sweet # solution, but pragmas.nim can't handle that - let a = result - result = newNodeP(nkCommand, p) - addSon(result, a) - var isFirstParam = true - when true: - # progress NOT guaranteed - p.hasProgress = false - addSon result, commandParam(p, isFirstParam, mode) - if not p.hasProgress: break - else: - while p.tok.tokType != tkEof: - let x = parseExpr(p) - addSon(result, x) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, x) - result = postExprBlocks(p, result) + result = commandExpr(p, result, mode) break else: break diff --git a/compiler/semasgn.nim b/compiler/semasgn.nim index 9f1ef313b..41b0879e6 100644 --- a/compiler/semasgn.nim +++ b/compiler/semasgn.nim @@ -316,6 +316,11 @@ proc liftBody(g: ModuleGraph; typ: PType; kind: TTypeAttachedOp; info: TLineInfo): PSym = if typ.kind == tyDistinct: return liftBodyDistinctType(g, typ, kind, info) + when false: + var typ = typ + if c.config.selectedGC == gcDestructors and typ.kind == tySequence: + # use the canonical type to access the =sink and =destroy etc. + typ = c.graph.sysTypes[tySequence] var a: TLiftCtx a.info = info diff --git a/compiler/semstmts.nim b/compiler/semstmts.nim index 5e9d5d9c5..f1778e816 100644 --- a/compiler/semstmts.nim +++ b/compiler/semstmts.nim @@ -168,7 +168,7 @@ proc semIf(c: PContext, n: PNode; flags: TExprFlags): PNode = else: illFormedAst(it, c.config) if isEmptyType(typ) or typ.kind in {tyNil, tyExpr} or (not hasElse and efInTypeof notin flags): - for it in n: + for it in n: it.sons[^1] = discardCheck(c, it.sons[^1], flags) result.kind = nkIfStmt # propagate any enforced VoidContext: @@ -1563,6 +1563,7 @@ proc semOverride(c: PContext, s: PSym, n: PNode) = if obj.kind in {tyObject, tyDistinct, tySequence, tyString} and sameType(obj, objB): # attach these ops to the canonical tySequence obj = canonType(c, obj) + #echo "ATTACHING TO ", obj.id, " ", s.name.s, " ", cast[int](obj) let opr = if s.name.s == "=": addr(obj.assignment) else: addr(obj.sink) if opr[].isNil: opr[] = s diff --git a/compiler/semtypes.nim b/compiler/semtypes.nim index fbf363834..744746323 100644 --- a/compiler/semtypes.nim +++ b/compiler/semtypes.nim @@ -1159,7 +1159,7 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, # compiler only checks for 'nil': if skipTypes(r, {tyGenericInst, tyAlias, tySink}).kind != tyVoid: if kind notin {skMacro, skTemplate} and r.kind in {tyStmt, tyExpr}: - localError(c.config, n.sons[0].info, "return type '" & typeToString(r) & + localError(c.config, n.sons[0].info, "return type '" & typeToString(r) & "' is only valid for macros and templates") # 'auto' as a return type does not imply a generic: elif r.kind == tyAnything: @@ -1577,11 +1577,16 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = assert s != nil assert prev == nil result = copyType(s, s.owner, keepId=false) - # XXX figure out why this has children already... + # Remove the 'T' parameter from tySequence: result.sons.setLen 0 result.n = nil result.flags = {tfHasAsgn} semContainerArg(c, n, "seq", result) + if result.len > 0: + var base = result[0] + if base.kind in {tyGenericInst, tyAlias, tySink}: base = lastSon(base) + if base.kind != tyGenericParam: + c.typesWithOps.add((result, result)) else: result = semContainer(c, n, tySequence, "seq", prev) if c.config.selectedGc == gcDestructors: @@ -1714,11 +1719,9 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = result = newOrPrevType(tyError, prev, c) n.typ = result dec c.inTypeContext - if c.inTypeContext == 0: instAllTypeBoundOp(c, n.info) - -when false: - proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = - result = semTypeNodeInner(c, n, prev) + if c.inTypeContext == 0: + #if $n == "var seq[StackTraceEntry]": + # echo "begin ", n instAllTypeBoundOp(c, n.info) proc setMagicType(conf: ConfigRef; m: PSym, kind: TTypeKind, size: int) = diff --git a/compiler/semtypinst.nim b/compiler/semtypinst.nim index 027ffd4aa..ebe822cdf 100644 --- a/compiler/semtypinst.nim +++ b/compiler/semtypinst.nim @@ -297,12 +297,6 @@ proc instCopyType*(cl: var TReplTypeVars, t: PType): PType = #result.destructor = nil result.sink = nil -template typeBound(c, newty, oldty, field, info) = - let opr = newty.field - if opr != nil and sfFromGeneric notin opr.flags: - # '=' needs to be instantiated for generics when the type is constructed: - newty.field = c.instTypeBoundOp(c, opr, oldty, info, attachedAsgn, 1) - proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = # tyGenericInvocation[A, tyGenericInvocation[A, B]] # is difficult to handle: @@ -317,7 +311,10 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = else: result = searchInstTypes(t) - if result != nil and eqFlags*result.flags == eqFlags*t.flags: return + if result != nil and eqFlags*result.flags == eqFlags*t.flags: + when defined(reportCacheHits): + echo "Generic instantiation cached ", typeToString(result), " for ", typeToString(t) + return for i in countup(1, sonsLen(t) - 1): var x = t.sons[i] if x.kind in {tyGenericParam}: @@ -332,7 +329,11 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = if header != t: # search again after first pass: result = searchInstTypes(header) - if result != nil and eqFlags*result.flags == eqFlags*t.flags: return + if result != nil and eqFlags*result.flags == eqFlags*t.flags: + when defined(reportCacheHits): + echo "Generic instantiation cached ", typeToString(result), " for ", + typeToString(t), " header ", typeToString(header) + return else: header = instCopyType(cl, t) @@ -384,7 +385,7 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = rawAddSon(result, newbody) checkPartialConstructedType(cl.c.config, cl.info, newbody) let dc = newbody.deepCopy - if cl.allowMetaTypes == false: + if not cl.allowMetaTypes: if dc != nil and sfFromGeneric notin newbody.deepCopy.flags: # 'deepCopy' needs to be instantiated for # generics *when the type is constructed*: @@ -402,6 +403,11 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = discard else: newbody.lastSon.typeInst = result + # DESTROY: adding object|opt for opt[topttree.Tree] + # sigmatch: Formal opt[=destroy.T] real opt[topttree.Tree] + # adding myseq for myseq[system.int] + # sigmatch: Formal myseq[=destroy.T] real myseq[system.int] + #echo "DESTROY: adding ", typeToString(newbody), " for ", typeToString(result, preferDesc) cl.c.typesWithOps.add((newbody, result)) let mm = skipTypes(bbody, abstractPtrs) if tfFromGeneric notin mm.flags: @@ -432,7 +438,7 @@ proc eraseVoidParams*(t: PType) = inc pos setLen t.sons, pos setLen t.n.sons, pos - return + break proc skipIntLiteralParams*(t: PType) = for i in 0 ..< t.sonsLen: @@ -561,9 +567,7 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = for i in countup(0, sonsLen(result) - 1): if result.sons[i] != nil: if result.sons[i].kind == tyGenericBody: - localError( - cl.c.config, - t.sym.info, + localError(cl.c.config, t.sym.info, "cannot instantiate '" & typeToString(result.sons[i], preferDesc) & "' inside of type definition: '" & @@ -603,6 +607,13 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = result.size = -1 result.n = replaceObjBranches(cl, result.n) +template typeBound(c, newty, oldty, field, info) = + let opr = newty.field + if opr != nil and sfFromGeneric notin opr.flags: + # '=' needs to be instantiated for generics when the type is constructed: + #echo "DESTROY: instantiating ", astToStr(field), " for ", typeToString(oldty) + newty.field = c.instTypeBoundOp(c, opr, oldty, info, attachedAsgn, 1) + proc instAllTypeBoundOp*(c: PContext, info: TLineInfo) = var i = 0 while i < c.typesWithOps.len: diff --git a/compiler/sigmatch.nim b/compiler/sigmatch.nim index fa4ab3703..3eaac06e5 100644 --- a/compiler/sigmatch.nim +++ b/compiler/sigmatch.nim @@ -2505,6 +2505,11 @@ proc instTypeBoundOp*(c: PContext; dc: PSym; t: PType; info: TLineInfo; if f.kind in {tyRef, tyPtr}: f = f.lastSon else: if f.kind == tyVar: f = f.lastSon + #if c.config.selectedGC == gcDestructors and f.kind == tySequence: + # use the canonical type to access the =sink and =destroy etc. + # f = c.graph.sysTypes[tySequence] + #echo "YUP_---------Formal ", typeToString(f, preferDesc), " real ", typeToString(t, preferDesc), " ", f.id, " ", t.id + if typeRel(m, f, t) == isNone: localError(c.config, info, "cannot instantiate: '" & dc.name.s & "'") else: diff --git a/config/nim.cfg b/config/nim.cfg index 2a118c5cf..c3e0823b6 100644 --- a/config/nim.cfg +++ b/config/nim.cfg @@ -290,13 +290,16 @@ tcc.options.always = "-w" # Configuration for the Genode toolchain @if genode: + noCppExceptions # avoid std C++ + tlsEmulation:on # no TLS segment register magic gcc.path = "/usr/local/genode-gcc/bin" - gcc.cpp.options.always = "-D__GENODE__ -fno-stack-protector" @if i386 or amd64: gcc.exe = "genode-x86-gcc" gcc.cpp.exe = "genode-x86-g++" + gcc.cpp.linkerexe = "genode-x86-ld" @elif arm: gcc.exe = "genode-arm-gcc" gcc.cpp.exe = "genode-arm-g++" + gcc.cpp.linkerexe = "genode-arm-ld" @end @end diff --git a/doc/manual.rst b/doc/manual.rst index 09265d3c8..170f0d550 100644 --- a/doc/manual.rst +++ b/doc/manual.rst @@ -285,6 +285,10 @@ Another advantage is that it frees the programmer from remembering the exact spelling of an identifier. The exception with respect to the first letter allows common code like ``var foo: Foo`` to be parsed unambiguously. +Note that this rule also applies to keywords, meaning that ``notin`` is +the same as ``notIn`` and ``not_in`` (all-lowercase version (``notin``, ``isnot``) +is the preferred way of writing keywords). + Historically, Nim was a fully `style-insensitive`:idx: language. This meant that it was not case-sensitive and underscores were ignored and there was not even a distinction between ``foo`` and ``Foo``. diff --git a/doc/regexprs.txt b/doc/regexprs.txt index 5c6d37e89..83dbd2eeb 100644 --- a/doc/regexprs.txt +++ b/doc/regexprs.txt @@ -80,13 +80,13 @@ meta character meaning ``|`` start of alternative branch ``(`` start subpattern ``)`` end subpattern -``?`` extends the meaning of ``(`` - also 0 or 1 quantifier - also quantifier minimizer -``*`` 0 or more quantifier -``+`` 1 or more quantifier - also "possessive quantifier" ``{`` start min/max quantifier +``?`` extends the meaning of ``(`` + | also 0 or 1 quantifier (equal to ``{0,1}``) + | also quantifier minimizer +``*`` 0 or more quantifier (equal to ``{0,}``) +``+`` 1 or more quantifier (equal to ``{1,}``) + | also "possessive quantifier" ============== ============================================================ diff --git a/lib/core/seqs.nim b/lib/core/seqs.nim index 977b23b26..1a81b89ea 100644 --- a/lib/core/seqs.nim +++ b/lib/core/seqs.nim @@ -15,7 +15,7 @@ proc supportsCopyMem(t: typedesc): bool {.magic: "TypeTrait".} ## Default seq implementation used by Nim's core. type - NimSeqPayload {.core.}[T] = object + NimSeqPayload[T] = object cap: int region: Allocator data: UncheckedArray[T] @@ -40,6 +40,7 @@ proc `=destroy`[T](s: var seq[T]) = var x = cast[ptr NimSeqV2[T]](addr s) var p = x.p if p != nil: + mixin `=destroy` when not supportsCopyMem(T): for i in 0..<x.len: `=destroy`(p.data[i]) p.region.dealloc(p.region, p, payloadSize(p.cap)) @@ -47,11 +48,12 @@ proc `=destroy`[T](s: var seq[T]) = x.len = 0 proc `=`[T](x: var seq[T]; y: seq[T]) = + mixin `=destroy` var a = cast[ptr NimSeqV2[T]](addr x) var b = cast[ptr NimSeqV2[T]](unsafeAddr y) if a.p == b.p: return - `=destroy`(a) + `=destroy`(x) a.len = b.len if b.p != nil: a.p = cast[type(a.p)](alloc(payloadSize(a.len))) @@ -63,10 +65,11 @@ proc `=`[T](x: var seq[T]; y: seq[T]) = a.p.data[i] = b.p.data[i] proc `=sink`[T](x: var seq[T]; y: seq[T]) = + mixin `=destroy` var a = cast[ptr NimSeqV2[T]](addr x) var b = cast[ptr NimSeqV2[T]](unsafeAddr y) if a.p != nil and a.p != b.p: - `=destroy`(a) + `=destroy`(x) a.len = b.len a.p = b.p @@ -109,6 +112,7 @@ proc prepareSeqAdd(len: int; p: pointer; addlen, elemSize: int): pointer {. result = q proc shrink*[T](x: var seq[T]; newLen: Natural) = + mixin `=destroy` sysAssert newLen <= x.len, "invalid newLen parameter for 'shrink'" when not supportsCopyMem(T): for i in countdown(x.len - 1, newLen - 1): diff --git a/lib/core/strs.nim b/lib/core/strs.nim index 186add52a..ccbde76fe 100644 --- a/lib/core/strs.nim +++ b/lib/core/strs.nim @@ -51,15 +51,12 @@ proc `=destroy`(s: var string) = a.len = 0 a.p = nil -template lose(a) = - frees(a) - proc `=sink`(x: var string, y: string) = var a = cast[ptr NimStringV2](addr x) var b = cast[ptr NimStringV2](unsafeAddr y) # we hope this is optimized away for not yet alive objects: if unlikely(a.p == b.p): return - lose(a) + frees(a) a.len = b.len a.p = b.p @@ -67,13 +64,13 @@ proc `=`(x: var string, y: string) = var a = cast[ptr NimStringV2](addr x) var b = cast[ptr NimStringV2](unsafeAddr y) if unlikely(a.p == b.p): return - lose(a) + frees(a) a.len = b.len if isLiteral(b): # we can shallow copy literals: a.p = b.p else: - let region = if a.p.region != nil: a.p.region else: getLocalAllocator() + let region = if a.p != nil and a.p.region != nil: a.p.region else: getLocalAllocator() # we have to allocate the 'cap' here, consider # 'let y = newStringOfCap(); var x = y' # on the other hand... These get turned into moves now. @@ -136,6 +133,7 @@ proc appendString(dest: var NimStringV2; src: NimStringV2) {.compilerproc, inlin if src.len > 0: # also copy the \0 terminator: copyMem(unsafeAddr dest.p.data[dest.len], unsafeAddr src.p.data[0], src.len+1) + inc dest.len, src.len proc appendChar(dest: var NimStringV2; c: char) {.compilerproc, inline.} = dest.p.data[dest.len] = c @@ -166,7 +164,6 @@ proc mnewString(len: int): NimStringV2 {.compilerProc.} = proc setLengthStrV2(s: var NimStringV2, newLen: int) {.compilerRtl.} = if newLen > s.len: prepareAdd(s, newLen - s.len) - else: - s.len = newLen - # this also only works because the destructor - # looks at s.p and not s.len + s.len = newLen + # this also only works because the destructor + # looks at s.p and not s.len diff --git a/lib/impure/rdstdin.nim b/lib/impure/rdstdin.nim index 54bab82f0..ac38addba 100644 --- a/lib/impure/rdstdin.nim +++ b/lib/impure/rdstdin.nim @@ -73,6 +73,15 @@ when defined(Windows): discard readConsoleInputW(hStdin, irInputRecord, 1, dwEventsRead) return result +elif defined(genode): + proc readLineFromStdin*(prompt: string): TaintedString {. + tags: [ReadIOEffect, WriteIOEffect].} = + stdin.readLine() + + proc readLineFromStdin*(prompt: string, line: var TaintedString): bool {. + tags: [ReadIOEffect, WriteIOEffect].} = + stdin.readLine(line) + else: import linenoise, termios diff --git a/lib/posix/posix.nim b/lib/posix/posix.nim index 175f6a61d..800188b8f 100644 --- a/lib/posix/posix.nim +++ b/lib/posix/posix.nim @@ -663,6 +663,26 @@ proc waitid*(a1: cint, a2: Id, a3: var SigInfo, a4: cint): cint {. proc waitpid*(a1: Pid, a2: var cint, a3: cint): Pid {. importc, header: "<sys/wait.h>".} +type Rusage* {.importc: "struct rusage", header: "<sys/resource.h>", + bycopy.} = object + ru_utime*, ru_stime*: Timeval # User and system time + ru_maxrss*, ru_ixrss*, ru_idrss*, ru_isrss*, # memory sizes + ru_minflt*, ru_majflt*, ru_nswap*, # paging activity + ru_inblock*, ru_oublock*, ru_msgsnd*, ru_msgrcv*, # IO activity + ru_nsignals*, ru_nvcsw*, ru_nivcsw*: clong # switching activity + +proc wait4*(pid: Pid, status: ptr cint, options: cint, rusage: ptr Rusage): Pid + {.importc, header: "<sys/wait.h>".} + +const + RUSAGE_SELF* = cint(0) + RUSAGE_CHILDREN* = cint(-1) + RUSAGE_THREAD* = cint(1) # This one is less std; Linux, BSD agree though. + +# This can only fail if `who` is invalid or `rusage` ptr is invalid. +proc getrusage*(who: cint, rusage: ptr Rusage): cint + {.importc, header: "<sys/resource.h>", discardable.} + proc bsd_signal*(a1: cint, a2: proc (x: pointer) {.noconv.}) {. importc, header: "<signal.h>".} proc kill*(a1: Pid, a2: cint): cint {.importc, header: "<signal.h>".} diff --git a/lib/pure/distros.nim b/lib/pure/distros.nim index 0f1ffb1ab..4c531a779 100644 --- a/lib/pure/distros.nim +++ b/lib/pure/distros.nim @@ -232,7 +232,7 @@ proc foreignDepInstallCmd*(foreignPackageName: string): (string, bool) = elif defined(haiku): result = ("pkgman install " & p, true) else: - result = ("brew install " & p, false) + result = ("brew install " & p, true) proc foreignDep*(foreignPackageName: string) = ## Registers 'foreignPackageName' to the internal list of foreign deps. diff --git a/lib/pure/fenv.nim b/lib/pure/fenv.nim index 0725973ca..ab47da08e 100644 --- a/lib/pure/fenv.nim +++ b/lib/pure/fenv.nim @@ -12,7 +12,7 @@ {.deadCodeElim: on.} # dce option deprecated -when defined(Posix): +when defined(Posix) and not defined(genode): {.passl: "-lm".} var diff --git a/lib/pure/includes/osenv.nim b/lib/pure/includes/osenv.nim index 945555540..f9c076158 100644 --- a/lib/pure/includes/osenv.nim +++ b/lib/pure/includes/osenv.nim @@ -102,9 +102,18 @@ proc findEnvVar(key: string): int = proc getEnv*(key: string, default = ""): TaintedString {.tags: [ReadEnvEffect].} = ## Returns the value of the `environment variable`:idx: named `key`. ## - ## If the variable does not exist, "" is returned. To distinguish - ## whether a variable exists or it's value is just "", call - ## `existsEnv(key)`. + ## If the variable does not exist, `""` is returned. To distinguish + ## whether a variable exists or it's value is just `""`, call + ## `existsEnv(key) proc <#existsEnv,string>`_. + ## + ## See also: + ## * `existsEnv proc <#existsEnv,string>`_ + ## * `putEnv proc <#putEnv,string,string>`_ + ## * `envPairs iterator <#envPairs.i>`_ + runnableExamples: + assert getEnv("unknownEnv") == "" + assert getEnv("unknownEnv", "doesn't exist") == "doesn't exist" + when nimvm: discard "built into the compiler" else: @@ -119,6 +128,14 @@ proc getEnv*(key: string, default = ""): TaintedString {.tags: [ReadEnvEffect].} proc existsEnv*(key: string): bool {.tags: [ReadEnvEffect].} = ## Checks whether the environment variable named `key` exists. ## Returns true if it exists, false otherwise. + ## + ## See also: + ## * `getEnv proc <#getEnv,string,string>`_ + ## * `putEnv proc <#putEnv,string,string>`_ + ## * `envPairs iterator <#envPairs.i>`_ + runnableExamples: + assert not existsEnv("unknownEnv") + when nimvm: discard "built into the compiler" else: @@ -127,7 +144,12 @@ proc existsEnv*(key: string): bool {.tags: [ReadEnvEffect].} = proc putEnv*(key, val: string) {.tags: [WriteEnvEffect].} = ## Sets the value of the `environment variable`:idx: named `key` to `val`. - ## If an error occurs, `EInvalidEnvVar` is raised. + ## If an error occurs, `OSError` is raised. + ## + ## See also: + ## * `getEnv proc <#getEnv,string,string>`_ + ## * `existsEnv proc <#existsEnv,string>`_ + ## * `envPairs iterator <#envPairs.i>`_ # Note: by storing the string in the environment sequence, # we guarantee that we don't free the memory before the program @@ -154,9 +176,15 @@ proc putEnv*(key, val: string) {.tags: [WriteEnvEffect].} = raiseOSError(osLastError()) iterator envPairs*(): tuple[key, value: TaintedString] {.tags: [ReadEnvEffect].} = - ## Iterate over all `environments variables`:idx:. In the first component - ## of the tuple is the name of the current variable stored, in the second - ## its value. + ## Iterate over all `environments variables`:idx:. + ## + ## In the first component of the tuple is the name of the current variable stored, + ## in the second its value. + ## + ## See also: + ## * `getEnv proc <#getEnv,string,string>`_ + ## * `existsEnv proc <#existsEnv,string>`_ + ## * `putEnv proc <#putEnv,string,string>`_ getEnvVarsC() for i in 0..high(environment): var p = find(environment[i], '=') diff --git a/lib/pure/includes/oserr.nim b/lib/pure/includes/oserr.nim index db7d84c1e..25e221d3b 100644 --- a/lib/pure/includes/oserr.nim +++ b/lib/pure/includes/oserr.nim @@ -18,7 +18,7 @@ proc `$`*(err: OSErrorCode): string {.borrow.} proc osErrorMsg*(errorCode: OSErrorCode): string = ## Converts an OS error code into a human readable string. ## - ## The error code can be retrieved using the ``osLastError`` proc. + ## The error code can be retrieved using the `osLastError proc <#osLastError>`_. ## ## If conversion fails, or ``errorCode`` is ``0`` then ``""`` will be ## returned. @@ -26,6 +26,16 @@ proc osErrorMsg*(errorCode: OSErrorCode): string = ## On Windows, the ``-d:useWinAnsi`` compilation flag can be used to ## make this procedure use the non-unicode Win API calls to retrieve the ## message. + ## + ## See also: + ## * `raiseOSError proc <#raiseOSError,OSErrorCode,string>`_ + ## * `osLastError proc <#osLastError>`_ + runnableExamples: + when defined(posix): + assert osErrorMsg(OSErrorCode(0)) == "" + assert osErrorMsg(OSErrorCode(1)) == "Operation not permitted" + assert osErrorMsg(OSErrorCode(2)) == "No such file or directory" + result = "" when defined(nimscript): discard @@ -48,13 +58,21 @@ proc osErrorMsg*(errorCode: OSErrorCode): string = result = $c_strerror(errorCode.int32) proc raiseOSError*(errorCode: OSErrorCode; additionalInfo = "") {.noinline.} = - ## Raises an ``OSError`` exception. The ``errorCode`` will determine the - ## message, ``osErrorMsg`` will be used to get this message. + ## Raises an `OSError exception <system.html#OSError>`_. + ## + ## The ``errorCode`` will determine the + ## message, `osErrorMsg proc <#osErrorMsg,OSErrorCode>`_ will be used + ## to get this message. ## - ## The error code can be retrieved using the ``osLastError`` proc. + ## The error code can be retrieved using the `osLastError proc + ## <#osLastError>`_. ## ## If the error code is ``0`` or an error message could not be retrieved, ## the message ``unknown OS error`` will be used. + ## + ## See also: + ## * `osErrorMsg proc <#osErrorMsg,OSErrorCode>`_ + ## * `osLastError proc <#osLastError>`_ var e: ref OSError; new(e) e.errorCode = errorCode.int32 e.msg = osErrorMsg(errorCode) @@ -80,6 +98,10 @@ proc osLastError*(): OSErrorCode {.sideEffect.} = ## On Windows some OS calls can reset the error code to ``0`` causing this ## procedure to return ``0``. It is therefore advised to call this procedure ## immediately after an OS call fails. On POSIX systems this is not a problem. + ## + ## See also: + ## * `osErrorMsg proc <#osErrorMsg,OSErrorCode>`_ + ## * `raiseOSError proc <#raiseOSError,OSErrorCode,string>`_ when defined(nimscript): discard elif defined(windows): diff --git a/lib/pure/includes/osseps.nim b/lib/pure/includes/osseps.nim index 944ad123e..859722f6a 100644 --- a/lib/pure/includes/osseps.nim +++ b/lib/pure/includes/osseps.nim @@ -7,44 +7,44 @@ const when defined(Nimdoc): # only for proper documentation: const CurDir* = '.' - ## The constant string used by the operating system to refer to the + ## The constant character used by the operating system to refer to the ## current directory. ## - ## For example: '.' for POSIX or ':' for the classic Macintosh. + ## For example: `'.'` for POSIX or `':'` for the classic Macintosh. ParDir* = ".." ## The constant string used by the operating system to refer to the ## parent directory. ## - ## For example: ".." for POSIX or "::" for the classic Macintosh. + ## For example: `".."` for POSIX or `"::"` for the classic Macintosh. DirSep* = '/' ## The character used by the operating system to separate pathname - ## components, for example, '/' for POSIX or ':' for the classic - ## Macintosh. + ## components, for example: `'/'` for POSIX, `':'` for the classic + ## Macintosh, and `'\\'` on Windows. AltSep* = '/' ## An alternative character used by the operating system to separate - ## pathname components, or the same as `DirSep` if only one separator - ## character exists. This is set to '/' on Windows systems - ## where `DirSep` is a backslash. + ## pathname components, or the same as `DirSep <#DirSep>`_ if only one separator + ## character exists. This is set to `'/'` on Windows systems + ## where `DirSep <#DirSep>`_ is a backslash (`'\\'`). PathSep* = ':' ## The character conventionally used by the operating system to separate - ## search patch components (as in PATH), such as ':' for POSIX - ## or ';' for Windows. + ## search patch components (as in PATH), such as `':'` for POSIX + ## or `';'` for Windows. FileSystemCaseSensitive* = true - ## true if the file system is case sensitive, false otherwise. Used by - ## `cmpPaths` to compare filenames properly. + ## True if the file system is case sensitive, false otherwise. Used by + ## `cmpPaths proc <#cmpPaths,string,string>`_ to compare filenames properly. ExeExt* = "" ## The file extension of native executables. For example: - ## "" for POSIX, "exe" on Windows. + ## `""` for POSIX, `"exe"` on Windows (without a dot). ScriptExt* = "" - ## The file extension of a script file. For example: "" for POSIX, - ## "bat" on Windows. + ## The file extension of a script file. For example: `""` for POSIX, + ## `"bat"` on Windows. DynlibFormat* = "lib$1.so" ## The format string to turn a filename into a `DLL`:idx: file (also @@ -127,4 +127,4 @@ else: # UNIX-like operating system const ExtSep* = '.' ## The character which separates the base filename from the extension; - ## for example, the '.' in ``os.nim``. + ## for example, the `'.'` in ``os.nim``. diff --git a/lib/pure/json.nim b/lib/pure/json.nim index ffb8f4f35..176da1d9d 100644 --- a/lib/pure/json.nim +++ b/lib/pure/json.nim @@ -130,9 +130,9 @@ ## { "name": "Susan", "age": herAge } ## ] ## -## var j2 = %* {"name": "Isaac", "books": ["Robot Dreams"]} -## j2["details"] = %* {"age":35, "pi":3.1415} -## echo j2 +## var j2 = %* {"name": "Isaac", "books": ["Robot Dreams"]} +## j2["details"] = %* {"age":35, "pi":3.1415} +## echo j2 runnableExamples: ## Note: for JObject, key ordering is preserved, unlike in some languages, @@ -708,6 +708,22 @@ proc toPretty(result: var string, node: JsonNode, indent = 2, ml = true, proc pretty*(node: JsonNode, indent = 2): string = ## Returns a JSON Representation of `node`, with indentation and ## on multiple lines. + ## + ## Similar to prettyprint in Python. + runnableExamples: + let j = %* {"name": "Isaac", "books": ["Robot Dreams"], + "details": {"age":35, "pi":3.1415}} + doAssert pretty(j) == """ +{ + "name": "Isaac", + "books": [ + "Robot Dreams" + ], + "details": { + "age": 35, + "pi": 3.1415 + } +}""" result = "" toPretty(result, node, indent) diff --git a/lib/pure/math.nim b/lib/pure/math.nim index 460be1cd0..526ddbbb2 100644 --- a/lib/pure/math.nim +++ b/lib/pure/math.nim @@ -95,7 +95,7 @@ proc fac*(n: int): int = {.push checks:off, line_dir:off, stack_trace:off.} -when defined(Posix): +when defined(Posix) and not defined(genode): {.passl: "-lm".} const diff --git a/lib/pure/net.nim b/lib/pure/net.nim index a5bdf3ce6..43284f872 100644 --- a/lib/pure/net.nim +++ b/lib/pure/net.nim @@ -1295,7 +1295,7 @@ proc recvFrom*(socket: Socket, data: var string, length: int, if result != -1: data.setLen(result) - address = $inet_ntoa(sockAddress.sin_addr) + address = getAddrString(cast[ptr SockAddr](addr(sockAddress))) port = ntohs(sockAddress.sin_port).Port else: raiseOSError(osLastError()) diff --git a/lib/pure/oids.nim b/lib/pure/oids.nim index d6369b5f9..3aee3941d 100644 --- a/lib/pure/oids.nim +++ b/lib/pure/oids.nim @@ -60,23 +60,21 @@ proc `$`*(oid: Oid): string = result = newString(24) oidToString(oid, result) +proc rand(): cint {.importc: "rand", header: "<stdlib.h>", nodecl.} +proc srand(seed: cint) {.importc: "srand", header: "<stdlib.h>", nodecl.} + +var t = getTime().toUnix.int32 +srand(t) + var - incr: int - fuzz: int32 + incr: int = rand() + fuzz: int32 = rand() proc genOid*(): Oid = ## generates a new OID. - proc rand(): cint {.importc: "rand", header: "<stdlib.h>", nodecl.} - proc srand(seed: cint) {.importc: "srand", header: "<stdlib.h>", nodecl.} - - var t = getTime().toUnix.int32 - + t = getTime().toUnix.int32 var i = int32(atomicInc(incr)) - if fuzz == 0: - # racy, but fine semantically: - srand(t) - fuzz = rand() bigEndian32(addr result.time, addr(t)) result.fuzz = fuzz bigEndian32(addr result.count, addr(i)) diff --git a/lib/pure/os.nim b/lib/pure/os.nim index 181bc5728..53bf880b6 100644 --- a/lib/pure/os.nim +++ b/lib/pure/os.nim @@ -10,6 +10,36 @@ ## This module contains basic operating system facilities like ## retrieving environment variables, reading command line arguments, ## working with directories, running shell commands, etc. +## +## .. code-block:: +## import os +## +## let myFile = "/path/to/my/file.nim" +## +## let splittedPath = splitPath(myFile) +## assert splittedPath.head == "/path/to/my" +## assert splittedPath.tail == "file.nim" +## +## assert parentDir(myFile) == "/path/to/my" +## +## let splittedFile = splitFile(myFile) +## assert splittedFile.dir == "/path/to/my" +## assert splittedFile.name == "file" +## assert splittedFile.ext == ".nim" +## +## assert myFile.changeFileExt("c") == "/path/to/my/file.c" +## +## +## **See also:** +## * `osproc module <osproc.html>`_ for process communication beyond +## `execShellCmd proc <#execShellCmd,string>`_ +## * `parseopt module <parseopt.html>`_ for command-line parser beyond +## `parseCmdLine proc <#parseCmdLine,string>`_ +## * `distros module <distros.html>`_ +## * `dynlib module <dynlib.html>`_ +## * `streams module <streams.html>`_ + + {.deadCodeElim: on.} # dce option deprecated {.push debugger: off.} @@ -39,24 +69,24 @@ else: {.pragma: noNimScript.} type - ReadEnvEffect* = object of ReadIOEffect ## effect that denotes a read - ## from an environment variable - WriteEnvEffect* = object of WriteIOEffect ## effect that denotes a write - ## to an environment variable + ReadEnvEffect* = object of ReadIOEffect ## Effect that denotes a read + ## from an environment variable. + WriteEnvEffect* = object of WriteIOEffect ## Effect that denotes a write + ## to an environment variable. - ReadDirEffect* = object of ReadIOEffect ## effect that denotes a read + ReadDirEffect* = object of ReadIOEffect ## Effect that denotes a read ## operation from the directory - ## structure - WriteDirEffect* = object of WriteIOEffect ## effect that denotes a write + ## structure. + WriteDirEffect* = object of WriteIOEffect ## Effect that denotes a write ## operation to - ## the directory structure + ## the directory structure. OSErrorCode* = distinct int32 ## Specifies an OS Error Code. include "includes/osseps" proc normalizePathEnd(path: var string, trailingSep = false) = - ## ensures ``path`` has exactly 0 or 1 trailing `DirSep`, depending on + ## Ensures ``path`` has exactly 0 or 1 trailing `DirSep`, depending on ## ``trailingSep``, and taking care of edge cases: it preservers whether ## a path is absolute or relative, and makes sure trailing sep is `DirSep`, ## not `AltSep`. @@ -83,27 +113,24 @@ proc joinPath*(head, tail: string): string {. noSideEffect, rtl, extern: "nos$1".} = ## Joins two directory names to one. ## - ## For example on Unix: - ## - ## .. code-block:: nim - ## joinPath("usr", "lib") - ## - ## results in: + ## If `head` is the empty string, `tail` is returned. If `tail` is the empty + ## string, `head` is returned with a trailing path separator. If `tail` starts + ## with a path separator it will be removed when concatenated to `head`. Other + ## path separators not located on boundaries won't be modified. ## - ## .. code-block:: nim - ## "usr/lib" - ## - ## If head is the empty string, tail is returned. If tail is the empty - ## string, head is returned with a trailing path separator. If tail starts - ## with a path separator it will be removed when concatenated to head. Other - ## path separators not located on boundaries won't be modified. More - ## examples on Unix: - ## - ## .. code-block:: nim - ## assert joinPath("usr", "") == "usr/" - ## assert joinPath("", "lib") == "lib" - ## assert joinPath("", "/lib") == "/lib" - ## assert joinPath("usr/", "/lib") == "usr/lib" + ## See also: + ## * `joinPath(varargs) proc <#joinPath,varargs[string]>`_ + ## * `/ proc <#/,string,string>`_ + ## * `splitPath proc <#splitPath,string>`_ + runnableExamples: + when defined(posix): + assert joinPath("usr", "lib") == "usr/lib" + assert joinPath("usr", "") == "usr/" + assert joinPath("", "lib") == "lib" + assert joinPath("", "/lib") == "/lib" + assert joinPath("usr/", "/lib") == "usr/lib" + assert joinPath("usr/lib", "../bin") == "usr/bin" + result = newStringOfCap(head.len + tail.len) var state = 0 addNormalizePath(head, result, state, DirSep) @@ -127,9 +154,23 @@ proc joinPath*(head, tail: string): string {. proc joinPath*(parts: varargs[string]): string {.noSideEffect, rtl, extern: "nos$1OpenArray".} = - ## The same as `joinPath(head, tail)`, but works with any number of - ## directory parts. You need to pass at least one element or the proc + ## The same as `joinPath(head, tail) proc <#joinPath,string,string>`_, + ## but works with any number of directory parts. + ## + ## You need to pass at least one element or the proc ## will assert in debug builds and crash on release builds. + ## + ## See also: + ## * `joinPath(head, tail) proc <#joinPath,string,string>`_ + ## * `/ proc <#/,string,string>`_ + ## * `/../ proc <#/../,string,string>`_ + ## * `splitPath proc <#splitPath,string>`_ + runnableExamples: + when defined(posix): + assert joinPath("a") == "a" + assert joinPath("a", "b", "c") == "a/b/c" + assert joinPath("usr/lib", "../../var", "log") == "var/log" + var estimatedLen = 0 for p in parts: estimatedLen += p.len result = newStringOfCap(estimatedLen) @@ -138,30 +179,41 @@ proc joinPath*(parts: varargs[string]): string {.noSideEffect, addNormalizePath(parts[i], result, state, DirSep) proc `/`*(head, tail: string): string {.noSideEffect.} = - ## The same as ``joinPath(head, tail)`` + ## The same as `joinPath(head, tail) proc <#joinPath,string,string>`_. ## - ## Here are some examples for Unix: - ## - ## .. code-block:: nim - ## assert "usr" / "" == "usr/" - ## assert "" / "lib" == "lib" - ## assert "" / "/lib" == "/lib" - ## assert "usr/" / "/lib" == "usr/lib" + ## See also: + ## * `/../ proc <#/../,string,string>`_ + ## * `joinPath(head, tail) proc <#joinPath,string,string>`_ + ## * `joinPath(varargs) proc <#joinPath,varargs[string]>`_ + ## * `splitPath proc <#splitPath,string>`_ + runnableExamples: + when defined(posix): + assert "usr" / "" == "usr/" + assert "" / "lib" == "lib" + assert "" / "/lib" == "/lib" + assert "usr/" / "/lib" == "usr/lib" + assert "usr" / "lib" / "../bin" == "usr/bin" + return joinPath(head, tail) proc splitPath*(path: string): tuple[head, tail: string] {. noSideEffect, rtl, extern: "nos$1".} = - ## Splits a directory into (head, tail), so that + ## Splits a directory into `(head, tail)` tuple, so that ## ``head / tail == path`` (except for edge cases like "/usr"). ## - ## Examples: - ## - ## .. code-block:: nim - ## splitPath("usr/local/bin") -> ("usr/local", "bin") - ## splitPath("usr/local/bin/") -> ("usr/local/bin", "") - ## splitPath("bin") -> ("", "bin") - ## splitPath("/bin") -> ("", "bin") - ## splitPath("") -> ("", "") + ## See also: + ## * `joinPath(head, tail) proc <#joinPath,string,string>`_ + ## * `joinPath(varargs) proc <#joinPath,varargs[string]>`_ + ## * `/ proc <#/,string,string>`_ + ## * `/../ proc <#/../,string,string>`_ + ## * `relativePath proc <#relativePath,string,string>`_ + runnableExamples: + assert splitPath("usr/local/bin") == ("usr/local", "bin") + assert splitPath("usr/local/bin/") == ("usr/local/bin", "") + assert splitPath("bin") == ("", "bin") + assert splitPath("/bin") == ("", "bin") + assert splitPath("") == ("", "") + var sepPos = -1 for i in countdown(len(path)-1, 0): if path[i] in {DirSep, AltSep}: @@ -182,16 +234,21 @@ else: proc relativePath*(path, base: string; sep = DirSep): string {. noSideEffect, rtl, extern: "nos$1", raises: [].} = ## Converts `path` to a path relative to `base`. - ## The `sep` is used for the path normalizations, this can be useful to - ## ensure the relative path only contains '/' so that it can be used for - ## URL constructions. + ## + ## The `sep` (default: `DirSep <#DirSep>`_) is used for the path normalizations, + ## this can be useful to ensure the relative path only contains `'/'` + ## so that it can be used for URL constructions. + ## + ## See also: + ## * `splitPath proc <#splitPath,string>`_ + ## * `parentDir proc <#parentDir,string>`_ + ## * `tailDir proc <#tailDir,string>`_ runnableExamples: - doAssert relativePath("/Users/me/bar/z.nim", "/Users/other/bad", '/') == "../../me/bar/z.nim" - doAssert relativePath("/Users/me/bar/z.nim", "/Users/other", '/') == "../me/bar/z.nim" - doAssert relativePath("/Users///me/bar//z.nim", "//Users/", '/') == "me/bar/z.nim" - doAssert relativePath("/Users/me/bar/z.nim", "/Users/me", '/') == "bar/z.nim" - doAssert relativePath("", "/users/moo", '/') == "" - + assert relativePath("/Users/me/bar/z.nim", "/Users/other/bad", '/') == "../../me/bar/z.nim" + assert relativePath("/Users/me/bar/z.nim", "/Users/other", '/') == "../me/bar/z.nim" + assert relativePath("/Users///me/bar//z.nim", "//Users/", '/') == "me/bar/z.nim" + assert relativePath("/Users/me/bar/z.nim", "/Users/me", '/') == "bar/z.nim" + assert relativePath("", "/users/moo", '/') == "" # Todo: If on Windows, path and base do not agree on the drive letter, # return `path` as is. @@ -252,12 +309,21 @@ proc parentDir*(path: string): string {. ## ## This is the same as ``splitPath(path).head`` when ``path`` doesn't end ## in a dir separator. - ## The remainder can be obtained with ``lastPathPart(path)`` + ## The remainder can be obtained with `lastPathPart(path) proc + ## <#lastPathPart,string>`_. + ## + ## See also: + ## * `relativePath proc <#relativePath,string,string>`_ + ## * `splitPath proc <#splitPath,string>`_ + ## * `tailDir proc <#tailDir,string>`_ + ## * `parentDirs iterator <#parentDirs.i,string>`_ runnableExamples: - doAssert parentDir("") == "" + assert parentDir("") == "" when defined(posix): - doAssert parentDir("/usr/local/bin") == "/usr/local" - doAssert parentDir("foo/bar/") == "foo" + assert parentDir("/usr/local/bin") == "/usr/local" + assert parentDir("foo/bar/") == "foo" + assert parentDir("./foo") == "." + assert parentDir("/foo") == "" let sepPos = parentDirPos(path) if sepPos >= 0: @@ -267,11 +333,18 @@ proc parentDir*(path: string): string {. proc tailDir*(path: string): string {. noSideEffect, rtl, extern: "nos$1".} = - ## Returns the tail part of `path`.. + ## Returns the tail part of `path`. ## - ## | Example: ``tailDir("/usr/local/bin") == "local/bin"``. - ## | Example: ``tailDir("usr/local/bin/") == "local/bin"``. - ## | Example: ``tailDir("bin") == ""``. + ## See also: + ## * `relativePath proc <#relativePath,string,string>`_ + ## * `splitPath proc <#splitPath,string>`_ + ## * `parentDir proc <#parentDir,string>`_ + runnableExamples: + assert tailDir("/bin") == "bin" + assert tailDir("bin") == "" + assert tailDir("/usr/local/bin") == "usr/local/bin" + assert tailDir("usr/local/bin") == "local/bin" + var q = 1 if len(path) >= 1 and path[len(path)-1] in {DirSep, AltSep}: q = 2 for i in 0..len(path)-q: @@ -281,18 +354,53 @@ proc tailDir*(path: string): string {. proc isRootDir*(path: string): bool {. noSideEffect, rtl, extern: "nos$1".} = - ## Checks whether a given `path` is a root directory + ## Checks whether a given `path` is a root directory. + runnableExamples: + assert isRootDir("") + assert isRootDir(".") + assert isRootDir("/") + assert isRootDir("a") + assert not isRootDir("/a") + assert not isRootDir("a/b/c") + result = parentDirPos(path) < 0 iterator parentDirs*(path: string, fromRoot=false, inclusive=true): string = - ## Walks over all parent directories of a given `path` + ## Walks over all parent directories of a given `path`. ## - ## If `fromRoot` is set, the traversal will start from the file system root - ## diretory. If `inclusive` is set, the original argument will be included + ## If `fromRoot` is true (default: false), the traversal will start from + ## the file system root diretory. + ## If `inclusive` is true (default), the original argument will be included ## in the traversal. ## - ## Relative paths won't be expanded by this proc. Instead, it will traverse + ## Relative paths won't be expanded by this iterator. Instead, it will traverse ## only the directories appearing in the relative path. + ## + ## See also: + ## * `parentDir proc <#parentDir,string>`_ + ## + ## **Examples:** + ## + ## .. code-block:: + ## let g = "a/b/c" + ## + ## for p in g.parentDirs: + ## echo p + ## # a/b/c + ## # a/b + ## # a + ## + ## for p in g.parentDirs(fromRoot=true): + ## echo p + ## # a/ + ## # a/b/ + ## # a/b/c + ## + ## for p in g.parentDirs(inclusive=false): + ## echo p + ## # a/b + ## # a + if not fromRoot: var current = path if inclusive: yield path @@ -310,8 +418,16 @@ iterator parentDirs*(path: string, fromRoot=false, inclusive=true): string = if inclusive: yield path proc `/../`*(head, tail: string): string {.noSideEffect.} = - ## The same as ``parentDir(head) / tail`` unless there is no parent + ## The same as ``parentDir(head) / tail``, unless there is no parent ## directory. Then ``head / tail`` is performed instead. + ## + ## See also: + ## * `/ proc <#/,string,string>`_ + ## * `parentDir proc <#parentDir,string>`_ + runnableExamples: + assert "a/b/c" /../ "d/e" == "a/b/d/e" + assert "a" /../ "d/e" == "a/d/e" + let sepPos = parentDirPos(head) if sepPos >= 0: result = substr(head, 0, sepPos-1) / tail @@ -323,8 +439,21 @@ proc normExt(ext: string): string = else: result = ExtSep & ext proc searchExtPos*(path: string): int = - ## Returns index of the '.' char in `path` if it signifies the beginning + ## Returns index of the `'.'` char in `path` if it signifies the beginning ## of extension. Returns -1 otherwise. + ## + ## See also: + ## * `splitFile proc <#splitFile,string>`_ + ## * `extractFilename proc <#extractFilename,string>`_ + ## * `lastPathPart proc <#lastPathPart,string>`_ + ## * `changeFileExt proc <#changeFileExt,string,string>`_ + ## * `addFileExt proc <#addFileExt,string,string>`_ + runnableExamples: + assert searchExtPos("a/b/c") == -1 + assert searchExtPos("c.nim") == 1 + assert searchExtPos("a/b/c.nim") == 5 + assert searchExtPos("a.b.c.nim") == 5 + # BUGFIX: do not search until 0! .DS_Store is no file extension! result = -1 for i in countdown(len(path)-1, 1): @@ -336,21 +465,35 @@ proc searchExtPos*(path: string): int = proc splitFile*(path: string): tuple[dir, name, ext: string] {. noSideEffect, rtl, extern: "nos$1".} = - ## Splits a filename into (dir, name, extension). - ## `dir` does not end in `DirSep`. - ## `extension` includes the leading dot. - ## - ## Example: + ## Splits a filename into `(dir, name, extension)` tuple. ## - ## .. code-block:: nim - ## var (dir, name, ext) = splitFile("usr/local/nimc.html") - ## assert dir == "usr/local" - ## assert name == "nimc" - ## assert ext == ".html" + ## `dir` does not end in `DirSep <#DirSep>`_. + ## `extension` includes the leading dot. ## ## If `path` has no extension, `ext` is the empty string. ## If `path` has no directory component, `dir` is the empty string. ## If `path` has no filename component, `name` and `ext` are empty strings. + ## + ## See also: + ## * `searchExtPos proc <#searchExtPos,string>`_ + ## * `extractFilename proc <#extractFilename,string>`_ + ## * `lastPathPart proc <#lastPathPart,string>`_ + ## * `changeFileExt proc <#changeFileExt,string,string>`_ + ## * `addFileExt proc <#addFileExt,string,string>`_ + runnableExamples: + var (dir, name, ext) = splitFile("usr/local/nimc.html") + assert dir == "usr/local" + assert name == "nimc" + assert ext == ".html" + (dir, name, ext) = splitFile("/usr/local/os") + assert dir == "/usr/local" + assert name == "os" + assert ext == "" + (dir, name, ext) = splitFile("/usr/local/") + assert dir == "/usr/local" + assert name == "" + assert ext == "" + if path.len == 0: result = ("", "", "") elif path[^1] in {DirSep, AltSep}: @@ -380,12 +523,22 @@ proc splitFile*(path: string): tuple[dir, name, ext: string] {. proc extractFilename*(path: string): string {. noSideEffect, rtl, extern: "nos$1".} = - ## Extracts the filename of a given `path`. This is the same as - ## ``name & ext`` from ``splitFile(path)``. See also ``lastPathPart``. + ## Extracts the filename of a given `path`. + ## + ## This is the same as ``name & ext`` from `splitFile(path) proc + ## <#splitFile,string>`_. + ## + ## See also: + ## * `searchExtPos proc <#searchExtPos,string>`_ + ## * `splitFile proc <#splitFile,string>`_ + ## * `lastPathPart proc <#lastPathPart,string>`_ + ## * `changeFileExt proc <#changeFileExt,string,string>`_ + ## * `addFileExt proc <#addFileExt,string,string>`_ runnableExamples: - when defined(posix): - doAssert extractFilename("foo/bar/") == "" - doAssert extractFilename("foo/bar") == "bar" + assert extractFilename("foo/bar/") == "" + assert extractFilename("foo/bar") == "bar" + assert extractFilename("foo/bar.baz") == "bar.baz" + if path.len == 0 or path[path.len-1] in {DirSep, AltSep}: result = "" else: @@ -393,11 +546,19 @@ proc extractFilename*(path: string): string {. proc lastPathPart*(path: string): string {. noSideEffect, rtl, extern: "nos$1".} = - ## like ``extractFilename``, but ignores trailing dir separator; aka: `baseName`:idx: - ## in some other languages. + ## Like `extractFilename proc <#extractFilename,string>`_, but ignores + ## trailing dir separator; aka: `baseName`:idx: in some other languages. + ## + ## See also: + ## * `searchExtPos proc <#searchExtPos,string>`_ + ## * `splitFile proc <#splitFile,string>`_ + ## * `extractFilename proc <#extractFilename,string>`_ + ## * `changeFileExt proc <#changeFileExt,string,string>`_ + ## * `addFileExt proc <#addFileExt,string,string>`_ runnableExamples: - when defined(posix): - doAssert lastPathPart("foo/bar/") == "bar" + assert lastPathPart("foo/bar/") == "bar" + assert lastPathPart("foo/bar") == "bar" + let path = path.normalizePathEnd(trailingSep = false) result = extractFilename(path) @@ -407,9 +568,22 @@ proc changeFileExt*(filename, ext: string): string {. ## ## If the `filename` has no extension, `ext` will be added. ## If `ext` == "" then any extension is removed. - ## `Ext` should be given without the leading '.', because some + ## + ## `Ext` should be given without the leading `'.'`, because some ## filesystems may use a different character. (Although I know ## of none such beast.) + ## + ## See also: + ## * `searchExtPos proc <#searchExtPos,string>`_ + ## * `splitFile proc <#splitFile,string>`_ + ## * `extractFilename proc <#extractFilename,string>`_ + ## * `lastPathPart proc <#lastPathPart,string>`_ + ## * `addFileExt proc <#addFileExt,string,string>`_ + runnableExamples: + assert changeFileExt("foo.bar", "baz") == "foo.baz" + assert changeFileExt("foo.bar", "") == "foo" + assert changeFileExt("foo", "baz") == "foo.baz" + var extPos = searchExtPos(filename) if extPos < 0: result = filename & normExt(ext) else: result = substr(filename, 0, extPos-1) & normExt(ext) @@ -419,9 +593,21 @@ proc addFileExt*(filename, ext: string): string {. ## Adds the file extension `ext` to `filename`, unless ## `filename` already has an extension. ## - ## `Ext` should be given without the leading '.', because some + ## `Ext` should be given without the leading `'.'`, because some ## filesystems may use a different character. ## (Although I know of none such beast.) + ## + ## See also: + ## * `searchExtPos proc <#searchExtPos,string>`_ + ## * `splitFile proc <#splitFile,string>`_ + ## * `extractFilename proc <#extractFilename,string>`_ + ## * `lastPathPart proc <#lastPathPart,string>`_ + ## * `changeFileExt proc <#changeFileExt,string,string>`_ + runnableExamples: + assert addFileExt("foo.bar", "baz") == "foo.bar" + assert addFileExt("foo.bar", "") == "foo.bar" + assert addFileExt("foo", "baz") == "foo.baz" + var extPos = searchExtPos(filename) if extPos < 0: result = filename & normExt(ext) else: result = filename @@ -438,9 +624,9 @@ proc cmpPaths*(pathA, pathB: string): int {. ## | > 0 iff pathA > pathB runnableExamples: when defined(macosx): - doAssert cmpPaths("foo", "Foo") == 0 + assert cmpPaths("foo", "Foo") == 0 elif defined(posix): - doAssert cmpPaths("foo", "Foo") > 0 + assert cmpPaths("foo", "Foo") > 0 let a = normalizePath(pathA) let b = normalizePath(pathB) @@ -458,11 +644,12 @@ proc isAbsolute*(path: string): bool {.rtl, noSideEffect, extern: "nos$1".} = ## ## On Windows, network paths are considered absolute too. runnableExamples: - doAssert(not "".isAbsolute) - doAssert(not ".".isAbsolute) + assert not "".isAbsolute + assert not ".".isAbsolute when defined(posix): - doAssert "/".isAbsolute - doAssert(not "a/".isAbsolute) + assert "/".isAbsolute + assert not "a/".isAbsolute + assert "/a/".isAbsolute if len(path) == 0: return false @@ -483,7 +670,7 @@ proc unixToNativePath*(path: string, drive=""): string {. ## Converts an UNIX-like path to a native one. ## ## On an UNIX system this does nothing. Else it converts - ## '/', '.', '..' to the appropriate things. + ## `'/'`, `'.'`, `'..'` to the appropriate things. ## ## On systems with a concept of "drives", `drive` is used to determine ## which drive label to use during absolute path conversion. @@ -542,8 +729,18 @@ proc getHomeDir*(): string {.rtl, extern: "nos$1", tags: [ReadEnvEffect, ReadIOEffect].} = ## Returns the home directory of the current user. ## - ## This proc is wrapped by the expandTilde proc for the convenience of - ## processing paths coming from user configuration files. + ## This proc is wrapped by the `expandTilde proc <#expandTilde,string>`_ + ## for the convenience of processing paths coming from user configuration files. + ## + ## See also: + ## * `getConfigDir proc <#getConfigDir>`_ + ## * `getTempDir proc <#getTempDir>`_ + ## * `expandTilde proc <#expandTilde,string>`_ + ## * `getCurrentDir proc <#getCurrentDir>`_ + ## * `setCurrentDir proc <#setCurrentDir,string>`_ + runnableExamples: + assert getHomeDir() == expandTilde("~") + when defined(windows): return string(getEnv("USERPROFILE")) & "\\" else: return string(getEnv("HOME")) & "/" @@ -552,12 +749,19 @@ proc getConfigDir*(): string {.rtl, extern: "nos$1", ## Returns the config directory of the current user for applications. ## ## On non-Windows OSs, this proc conforms to the XDG Base Directory - ## spec. Thus, this proc returns the value of the XDG_CONFIG_HOME environment - ## variable if it is set, and returns the default configuration directory, - ## "~/.config/", otherwise. + ## spec. Thus, this proc returns the value of the `XDG_CONFIG_HOME` environment + ## variable if it is set, otherwise it returns the default configuration + ## directory ("~/.config/"). ## ## An OS-dependent trailing slash is always present at the end of the - ## returned string; `\` on Windows and `/` on all other OSs. + ## returned string: `\\` on Windows and `/` on all other OSs. + ## + ## See also: + ## * `getHomeDir proc <#getHomeDir>`_ + ## * `getTempDir proc <#getTempDir>`_ + ## * `expandTilde proc <#expandTilde,string>`_ + ## * `getCurrentDir proc <#getCurrentDir>`_ + ## * `setCurrentDir proc <#setCurrentDir,string>`_ when defined(windows): result = getEnv("APPDATA").string else: @@ -573,6 +777,13 @@ proc getTempDir*(): string {.rtl, extern: "nos$1", ## returns ``getHomeDir()``, and on other Unix based systems it can cause ## security problems too. That said, you can override this implementation ## by adding ``-d:tempDir=mytempname`` to your compiler invokation. + ## + ## See also: + ## * `getHomeDir proc <#getHomeDir>`_ + ## * `getConfigDir proc <#getConfigDir>`_ + ## * `expandTilde proc <#expandTilde,string>`_ + ## * `getCurrentDir proc <#getCurrentDir>`_ + ## * `setCurrentDir proc <#setCurrentDir,string>`_ when defined(tempDir): const tempDir {.strdefine.}: string = nil return tempDir @@ -583,12 +794,22 @@ proc getTempDir*(): string {.rtl, extern: "nos$1", proc expandTilde*(path: string): string {. tags: [ReadEnvEffect, ReadIOEffect].} = ## Expands ``~`` or a path starting with ``~/`` to a full path, replacing - ## ``~`` with ``getHomeDir()`` (otherwise returns ``path`` unmodified). + ## ``~`` with `getHomeDir() <#getHomeDir>`_ (otherwise returns ``path`` unmodified). ## ## Windows: this is still supported despite Windows platform not having this ## convention; also, both ``~/`` and ``~\`` are handled. + ## + ## See also: + ## * `getHomeDir proc <#getHomeDir>`_ + ## * `getConfigDir proc <#getConfigDir>`_ + ## * `getTempDir proc <#getTempDir>`_ + ## * `getCurrentDir proc <#getCurrentDir>`_ + ## * `setCurrentDir proc <#setCurrentDir,string>`_ runnableExamples: - doAssert expandTilde("~" / "appname.cfg") == getHomeDir() / "appname.cfg" + assert expandTilde("~" / "appname.cfg") == getHomeDir() / "appname.cfg" + assert expandTilde("~/foo/bar") == getHomeDir() / "foo/bar" + assert expandTilde("/foo/bar") == "/foo/bar" + if len(path) == 0 or path[0] != '~': result = path elif len(path) == 1: @@ -602,11 +823,13 @@ proc expandTilde*(path: string): string {. # TODO: consider whether quoteShellPosix, quoteShellWindows, quoteShell, quoteShellCommand # belong in `strutils` instead; they are not specific to paths proc quoteShellWindows*(s: string): string {.noSideEffect, rtl, extern: "nosp$1".} = - ## Quote s, so it can be safely passed to Windows API. - ## Based on Python's subprocess.list2cmdline - ## See http://msdn.microsoft.com/en-us/library/17w5ykft.aspx - let needQuote = {' ', '\t'} in s or s.len == 0 + ## Quote `s`, so it can be safely passed to Windows API. + ## + ## Based on Python's `subprocess.list2cmdline`. + ## See `this link <http://msdn.microsoft.com/en-us/library/17w5ykft.aspx>`_ + ## for more details. + let needQuote = {' ', '\t'} in s or s.len == 0 result = "" var backslashBuff = "" if needQuote: @@ -631,7 +854,7 @@ proc quoteShellWindows*(s: string): string {.noSideEffect, rtl, extern: "nosp$1" proc quoteShellPosix*(s: string): string {.noSideEffect, rtl, extern: "nosp$1".} = ## Quote ``s``, so it can be safely passed to POSIX shell. - ## Based on Python's pipes.quote + ## Based on Python's `pipes.quote`. const safeUnixChars = {'%', '+', '-', '.', '/', '_', ':', '=', '@', '0'..'9', 'A'..'Z', 'a'..'z'} if s.len == 0: @@ -647,18 +870,23 @@ proc quoteShellPosix*(s: string): string {.noSideEffect, rtl, extern: "nosp$1".} when defined(windows) or defined(posix) or defined(nintendoswitch): proc quoteShell*(s: string): string {.noSideEffect, rtl, extern: "nosp$1".} = ## Quote ``s``, so it can be safely passed to shell. + ## + ## When on Windows, it calls `quoteShellWindows proc + ## <#quoteShellWindows,string>`_. Otherwise, calls `quoteShellPosix proc + ## <#quoteShellPosix,string>`_. when defined(windows): return quoteShellWindows(s) else: return quoteShellPosix(s) proc quoteShellCommand*(args: openArray[string]): string = - ## Concatenates and quotes shell arguments `args` + ## Concatenates and quotes shell arguments `args`. runnableExamples: when defined(posix): assert quoteShellCommand(["aaa", "", "c d"]) == "aaa '' 'c d'" when defined(windows): assert quoteShellCommand(["aaa", "", "c d"]) == "aaa \"\" \"c d\"" + # can't use `map` pending https://github.com/nim-lang/Nim/issues/8303 for i in 0..<args.len: if i > 0: result.add " " @@ -705,8 +933,12 @@ when defined(windows) and not weirdTarget: proc existsFile*(filename: string): bool {.rtl, extern: "nos$1", tags: [ReadDirEffect], noNimScript.} = ## Returns true if `filename` exists and is a regular file or symlink. - ## (directories, device files, named pipes and sockets return false) - ## This proc is not available for NimScript. + ## + ## Directories, device files, named pipes and sockets return false. + ## + ## See also: + ## * `existsDir proc <#existsDir,string>`_ + ## * `symlinkExists proc <#symlinkExists,string>`_ when defined(windows): when useWinUnicode: wrapUnary(a, getFileAttributesW, filename) @@ -722,6 +954,10 @@ proc existsDir*(dir: string): bool {.rtl, extern: "nos$1", tags: [ReadDirEffect] noNimScript.} = ## Returns true iff the directory `dir` exists. If `dir` is a file, false ## is returned. Follows symlinks. + ## + ## See also: + ## * `existsFile proc <#existsFile,string>`_ + ## * `symlinkExists proc <#symlinkExists,string>`_ when defined(windows): when useWinUnicode: wrapUnary(a, getFileAttributesW, dir) @@ -738,6 +974,10 @@ proc symlinkExists*(link: string): bool {.rtl, extern: "nos$1", noNimScript.} = ## Returns true iff the symlink `link` exists. Will return true ## regardless of whether the link points to a directory or file. + ## + ## See also: + ## * `existsFile proc <#existsFile,string>`_ + ## * `existsDir proc <#existsDir,string>`_ when defined(windows): when useWinUnicode: wrapUnary(a, getFileAttributesW, link) @@ -750,11 +990,19 @@ proc symlinkExists*(link: string): bool {.rtl, extern: "nos$1", return lstat(link, res) >= 0'i32 and S_ISLNK(res.st_mode) proc fileExists*(filename: string): bool {.inline, noNimScript.} = - ## Synonym for existsFile + ## Alias for `existsFile proc <#existsFile,string>`_. + ## + ## See also: + ## * `existsDir proc <#existsDir,string>`_ + ## * `symlinkExists proc <#symlinkExists,string>`_ existsFile(filename) proc dirExists*(dir: string): bool {.inline, noNimScript.} = - ## Synonym for existsDir + ## Alias for `existsDir proc <#existsDir,string>`_. + ## + ## See also: + ## * `existsFile proc <#existsFile,string>`_ + ## * `symlinkExists proc <#symlinkExists,string>`_ existsDir(dir) when not defined(windows) and not weirdTarget: @@ -764,19 +1012,23 @@ when not defined(windows) and not weirdTarget: else: result = S_ISLNK(rawInfo.st_mode) const - ExeExts* = when defined(windows): ["exe", "cmd", "bat"] else: [""] ## \ - ## platform specific file extension for executables. On Windows - ## ``["exe", "cmd", "bat"]``, on Posix ``[""]``. + ExeExts* = ## Platform specific file extension for executables. + ## On Windows ``["exe", "cmd", "bat"]``, on Posix ``[""]``. + when defined(windows): ["exe", "cmd", "bat"] else: [""] proc findExe*(exe: string, followSymlinks: bool = true; extensions: openarray[string]=ExeExts): string {. tags: [ReadDirEffect, ReadEnvEffect, ReadIOEffect], noNimScript.} = ## Searches for `exe` in the current working directory and then ## in directories listed in the ``PATH`` environment variable. - ## Returns "" if the `exe` cannot be found. `exe` + ## + ## Returns `""` if the `exe` cannot be found. `exe` ## is added the `ExeExts <#ExeExts>`_ file extensions if it has none. + ## ## If the system supports symlinks it also resolves them until it - ## meets the actual file. This behavior can be disabled if desired. + ## meets the actual file. This behavior can be disabled if desired + ## by setting `followSymlinks = false`. + if exe.len == 0: return template checkCurrentDir() = for ext in extensions: @@ -824,6 +1076,11 @@ when weirdTarget: proc getLastModificationTime*(file: string): times.Time {.rtl, extern: "nos$1", noNimScript.} = ## Returns the `file`'s last modification time. + ## + ## See also: + ## * `getLastAccessTime proc <#getLastAccessTime,string>`_ + ## * `getCreationTime proc <#getCreationTime,string>`_ + ## * `fileNewer proc <#fileNewer,string,string>`_ when defined(posix): var res: Stat if stat(file, res) < 0'i32: raiseOSError(osLastError()) @@ -837,6 +1094,11 @@ proc getLastModificationTime*(file: string): times.Time {.rtl, extern: "nos$1", proc getLastAccessTime*(file: string): times.Time {.rtl, extern: "nos$1", noNimScript.} = ## Returns the `file`'s last read or write access time. + ## + ## See also: + ## * `getLastModificationTime proc <#getLastModificationTime,string>`_ + ## * `getCreationTime proc <#getCreationTime,string>`_ + ## * `fileNewer proc <#fileNewer,string,string>`_ when defined(posix): var res: Stat if stat(file, res) < 0'i32: raiseOSError(osLastError()) @@ -854,6 +1116,11 @@ proc getCreationTime*(file: string): times.Time {.rtl, extern: "nos$1", noNimScr ## **Note:** Under POSIX OS's, the returned time may actually be the time at ## which the file's attribute's were last modified. See ## `here <https://github.com/nim-lang/Nim/issues/1058>`_ for details. + ## + ## See also: + ## * `getLastModificationTime proc <#getLastModificationTime,string>`_ + ## * `getLastAccessTime proc <#getLastAccessTime,string>`_ + ## * `fileNewer proc <#fileNewer,string,string>`_ when defined(posix): var res: Stat if stat(file, res) < 0'i32: raiseOSError(osLastError()) @@ -868,6 +1135,11 @@ proc getCreationTime*(file: string): times.Time {.rtl, extern: "nos$1", noNimScr proc fileNewer*(a, b: string): bool {.rtl, extern: "nos$1", noNimScript.} = ## Returns true if the file `a` is newer than file `b`, i.e. if `a`'s ## modification time is later than `b`'s. + ## + ## See also: + ## * `getLastModificationTime proc <#getLastModificationTime,string>`_ + ## * `getLastAccessTime proc <#getLastAccessTime,string>`_ + ## * `getCreationTime proc <#getCreationTime,string>`_ when defined(posix): # If we don't have access to nanosecond resolution, use '>=' when not StatHasNanoseconds: @@ -879,6 +1151,12 @@ proc fileNewer*(a, b: string): bool {.rtl, extern: "nos$1", noNimScript.} = proc getCurrentDir*(): string {.rtl, extern: "nos$1", tags: [], noNimScript.} = ## Returns the `current working directory`:idx:. + ## + ## See also: + ## * `getHomeDir proc <#getHomeDir>`_ + ## * `getConfigDir proc <#getConfigDir>`_ + ## * `getTempDir proc <#getTempDir>`_ + ## * `setCurrentDir proc <#setCurrentDir,string>`_ when defined(windows): var bufsize = MAX_PATH.int32 when useWinUnicode: @@ -922,8 +1200,14 @@ proc getCurrentDir*(): string {.rtl, extern: "nos$1", tags: [], noNimScript.} = raiseOSError(osLastError()) proc setCurrentDir*(newDir: string) {.inline, tags: [], noNimScript.} = - ## Sets the `current working directory`:idx:; `OSError` is raised if - ## `newDir` cannot been set. + ## Sets the `current working directory`:idx:; `OSError` + ## is raised if `newDir` cannot been set. + ## + ## See also: + ## * `getHomeDir proc <#getHomeDir>`_ + ## * `getConfigDir proc <#getConfigDir>`_ + ## * `getTempDir proc <#getTempDir>`_ + ## * `getCurrentDir proc <#getCurrentDir>`_ when defined(Windows): when useWinUnicode: if setCurrentDirectoryW(newWideCString(newDir)) == 0'i32: @@ -935,10 +1219,16 @@ proc setCurrentDir*(newDir: string) {.inline, tags: [], noNimScript.} = when not weirdTarget: proc absolutePath*(path: string, root = getCurrentDir()): string {.noNimScript.} = - ## Returns the absolute path of `path`, rooted at `root` (which must be absolute) - ## if `path` is absolute, return it, ignoring `root` + ## Returns the absolute path of `path`, rooted at `root` (which must be absolute; + ## default: current directory). + ## If `path` is absolute, return it, ignoring `root`. + ## + ## See also: + ## * `normalizedPath proc <#normalizedPath,string>`_ + ## * `normalizePath proc <#normalizePath,string>`_ runnableExamples: - doAssert absolutePath("a") == getCurrentDir() / "a" + assert absolutePath("a") == getCurrentDir() / "a" + if isAbsolute(path): path else: if not root.isAbsolute: @@ -950,11 +1240,21 @@ proc normalizePath*(path: var string) {.rtl, extern: "nos$1", tags: [], noNimScr ## ## Consecutive directory separators are collapsed, including an initial double slash. ## - ## On relative paths, double dot (..) sequences are collapsed if possible. + ## On relative paths, double dot (`..`) sequences are collapsed if possible. ## On absolute paths they are always collapsed. ## ## Warning: URL-encoded and Unicode attempts at directory traversal are not detected. ## Triple dot is not handled. + ## + ## See also: + ## * `absolutePath proc <#absolutePath,string>`_ + ## * `normalizedPath proc <#normalizedPath,string>`_ for a version which returns + ## a new string + runnableExamples: + var a = "a///b//..//c///d" + a.normalizePath() + assert a == "a/c/d" + path = pathnorm.normalizePath(path) when false: let isAbs = isAbsolute(path) @@ -984,7 +1284,13 @@ proc normalizePath*(path: var string) {.rtl, extern: "nos$1", tags: [], noNimScr path = "." proc normalizedPath*(path: string): string {.rtl, extern: "nos$1", tags: [], noNimScript.} = - ## Returns a normalized path for the current OS. See `<#normalizePath>`_ + ## Returns a normalized path for the current OS. + ## + ## See also: + ## * `absolutePath proc <#absolutePath,string>`_ + ## * `normalizePath proc <#normalizePath,string>`_ for the in-place version + runnableExamples: + assert normalizedPath("a///b//..//c///d") == "a/c/d" result = pathnorm.normalizePath(path) when defined(Windows) and not weirdTarget: @@ -1010,11 +1316,16 @@ when defined(Windows) and not weirdTarget: proc sameFile*(path1, path2: string): bool {.rtl, extern: "nos$1", tags: [ReadDirEffect], noNimScript.} = ## Returns true if both pathname arguments refer to the same physical - ## file or directory. Raises an exception if any of the files does not + ## file or directory. + ## + ## Raises `OSError` if any of the files does not ## exist or information about it can not be obtained. ## ## This proc will return true if given two alternative hard-linked or ## sym-linked paths to the same file or directory. + ## + ## See also: + ## * `sameFileContent proc <#sameFileContent,string,string>`_ when defined(Windows): var success = true var f1 = openHandle(path1) @@ -1051,6 +1362,9 @@ proc sameFileContent*(path1, path2: string): bool {.rtl, extern: "nos$1", tags: [ReadIOEffect], noNimScript.} = ## Returns true if both pathname arguments refer to files with identical ## binary content. + ## + ## See also: + ## * `sameFile proc <#sameFile,string,string>`_ const bufSize = 8192 # 8K buffer var @@ -1079,7 +1393,12 @@ proc sameFileContent*(path1, path2: string): bool {.rtl, extern: "nos$1", close(b) type - FilePermission* = enum ## file access permission; modelled after UNIX + FilePermission* = enum ## File access permission, modelled after UNIX. + ## + ## See also: + ## * `getFilePermissions <#getFilePermissions,string>`_ + ## * `setFilePermissions <#setFilePermissions,string,set[FilePermission]>`_ + ## * `FileInfo object <#FileInfo>`_ fpUserExec, ## execute access for the file owner fpUserWrite, ## write access for the file owner fpUserRead, ## read access for the file owner @@ -1092,9 +1411,15 @@ type proc getFilePermissions*(filename: string): set[FilePermission] {. rtl, extern: "nos$1", tags: [ReadDirEffect], noNimScript.} = - ## retrieves file permissions for `filename`. `OSError` is raised in case of - ## an error. On Windows, only the ``readonly`` flag is checked, every other + ## Retrieves file permissions for `filename`. + ## + ## `OSError` is raised in case of an error. + ## On Windows, only the ``readonly`` flag is checked, every other ## permission is available in any case. + ## + ## See also: + ## * `setFilePermissions proc <#setFilePermissions,string,set[FilePermission]>`_ + ## * `FilePermission enum <#FilePermission>`_ when defined(posix): var a: Stat if stat(filename, a) < 0'i32: raiseOSError(osLastError()) @@ -1124,9 +1449,15 @@ proc getFilePermissions*(filename: string): set[FilePermission] {. proc setFilePermissions*(filename: string, permissions: set[FilePermission]) {. rtl, extern: "nos$1", tags: [WriteDirEffect], noNimScript.} = - ## sets the file permissions for `filename`. `OSError` is raised in case of - ## an error. On Windows, only the ``readonly`` flag is changed, depending on - ## ``fpUserWrite``. + ## Sets the file permissions for `filename`. + ## + ## `OSError` is raised in case of an error. + ## On Windows, only the ``readonly`` flag is changed, depending on + ## ``fpUserWrite`` permission. + ## + ## See also: + ## * `getFilePermissions <#getFilePermissions,string>`_ + ## * `FilePermission enum <#FilePermission>`_ when defined(posix): var p = 0'i32 if fpUserRead in permissions: p = p or S_IRUSR @@ -1162,14 +1493,29 @@ proc copyFile*(source, dest: string) {.rtl, extern: "nos$1", tags: [ReadIOEffect, WriteIOEffect], noNimScript.} = ## Copies a file from `source` to `dest`. ## - ## If this fails, `OSError` is raised. On the Windows platform this proc will - ## copy the source file's attributes into dest. On other platforms you need - ## to use `getFilePermissions() <#getFilePermissions>`_ and - ## `setFilePermissions() <#setFilePermissions>`_ to copy them by hand (or use - ## the convenience `copyFileWithPermissions() <#copyFileWithPermissions>`_ - ## proc), otherwise `dest` will inherit the default permissions of a newly - ## created file for the user. If `dest` already exists, the file attributes + ## If this fails, `OSError` is raised. + ## + ## On the Windows platform this proc will + ## copy the source file's attributes into dest. + ## + ## On other platforms you need + ## to use `getFilePermissions <#getFilePermissions,string>`_ and + ## `setFilePermissions <#setFilePermissions,string,set[FilePermission]>`_ procs + ## to copy them by hand (or use the convenience `copyFileWithPermissions + ## proc <#copyFileWithPermissions,string,string>`_), + ## otherwise `dest` will inherit the default permissions of a newly + ## created file for the user. + ## + ## If `dest` already exists, the file attributes ## will be preserved and the content overwritten. + ## + ## See also: + ## * `copyDir proc <#copyDir,string,string>`_ + ## * `copyFileWithPermissions proc <#copyFileWithPermissions,string,string>`_ + ## * `tryRemoveFile proc <#tryRemoveFile,string>`_ + ## * `removeFile proc <#removeFile,string>`_ + ## * `moveFile proc <#moveFile,string,string>`_ + when defined(Windows): when useWinUnicode: let s = newWideCString(source) @@ -1221,9 +1567,18 @@ when defined(Windows) and not weirdTarget: setFileAttributesA(file, attrs) proc tryRemoveFile*(file: string): bool {.rtl, extern: "nos$1", tags: [WriteDirEffect], noNimScript.} = - ## Removes the `file`. If this fails, returns `false`. This does not fail + ## Removes the `file`. + ## + ## If this fails, returns `false`. This does not fail ## if the file never existed in the first place. + ## ## On Windows, ignores the read-only attribute. + ## + ## See also: + ## * `copyFile proc <#copyFile,string,string>`_ + ## * `copyFileWithPermissions proc <#copyFileWithPermissions,string,string>`_ + ## * `removeFile proc <#removeFile,string>`_ + ## * `moveFile proc <#moveFile,string,string>`_ result = true when defined(Windows): when useWinUnicode: @@ -1244,9 +1599,19 @@ proc tryRemoveFile*(file: string): bool {.rtl, extern: "nos$1", tags: [WriteDirE result = false proc removeFile*(file: string) {.rtl, extern: "nos$1", tags: [WriteDirEffect], noNimScript.} = - ## Removes the `file`. If this fails, `OSError` is raised. This does not fail + ## Removes the `file`. + ## + ## If this fails, `OSError` is raised. This does not fail ## if the file never existed in the first place. + ## ## On Windows, ignores the read-only attribute. + ## + ## See also: + ## * `removeDir proc <#removeDir,string>`_ + ## * `copyFile proc <#copyFile,string,string>`_ + ## * `copyFileWithPermissions proc <#copyFileWithPermissions,string,string>`_ + ## * `tryRemoveFile proc <#tryRemoveFile,string>`_ + ## * `moveFile proc <#moveFile,string,string>`_ if not tryRemoveFile(file): when defined(Windows): raiseOSError(osLastError()) @@ -1254,9 +1619,11 @@ proc removeFile*(file: string) {.rtl, extern: "nos$1", tags: [WriteDirEffect], n raiseOSError(osLastError(), $strerror(errno)) proc tryMoveFSObject(source, dest: string): bool {.noNimScript.} = - ## Moves a file or directory from `source` to `dest`. Returns false in case - ## of `EXDEV` error. In case of other errors `OSError` is raised. Returns - ## true in case of success. + ## Moves a file or directory from `source` to `dest`. + ## + ## Returns false in case of `EXDEV` error. + ## In case of other errors `OSError` is raised. + ## Returns true in case of success. when defined(Windows): when useWinUnicode: let s = newWideCString(source) @@ -1275,8 +1642,19 @@ proc tryMoveFSObject(source, dest: string): bool {.noNimScript.} = proc moveFile*(source, dest: string) {.rtl, extern: "nos$1", tags: [ReadIOEffect, WriteIOEffect], noNimScript.} = - ## Moves a file from `source` to `dest`. If this fails, `OSError` is raised. - ## Can be used to `rename files`:idx: + ## Moves a file from `source` to `dest`. + ## + ## If this fails, `OSError` is raised. + ## + ## Can be used to `rename files`:idx:. + ## + ## See also: + ## * `moveDir proc <#moveDir,string,string>`_ + ## * `copyFile proc <#copyFile,string,string>`_ + ## * `copyFileWithPermissions proc <#copyFileWithPermissions,string,string>`_ + ## * `removeFile proc <#removeFile,string>`_ + ## * `tryRemoveFile proc <#tryRemoveFile,string>`_ + if not tryMoveFSObject(source, dest): when not defined(windows): # Fallback to copy & del @@ -1288,7 +1666,7 @@ proc moveFile*(source, dest: string) {.rtl, extern: "nos$1", raise proc exitStatusLikeShell*(status: cint): cint = - ## converts exit code from `c_system` into a shell exit code + ## Converts exit code from `c_system` into a shell exit code. when defined(posix) and not weirdTarget: if WIFSIGNALED(status): # like the shell! @@ -1304,9 +1682,16 @@ proc execShellCmd*(command: string): int {.rtl, extern: "nos$1", ## ## Command has the form 'program args' where args are the command ## line arguments given to program. The proc returns the error code - ## of the shell when it has finished. The proc does not return until - ## the process has finished. To execute a program without having a - ## shell involved, use `osproc.execProcess`. + ## of the shell when it has finished (zero if there is no error). + ## The proc does not return until the process has finished. + ## + ## To execute a program without having a shell involved, use `osproc.execProcess proc + ## <osproc.html#execProcess,string,string,openArray[string],StringTableRef,set[ProcessOption]>`_. + ## + ## **Examples:** + ## + ## .. code-block:: + ## discard execShellCmd("ls -la") result = exitStatusLikeShell(c_system(command)) # Templates for filtering directories and files @@ -1368,32 +1753,51 @@ template walkCommon(pattern: string, filter) = iterator walkPattern*(pattern: string): string {.tags: [ReadDirEffect], noNimScript.} = ## Iterate over all the files and directories that match the `pattern`. - ## On POSIX this uses the `glob`:idx: call. ## - ## `pattern` is OS dependent, but at least the "\*.ext" + ## On POSIX this uses the `glob`:idx: call. + ## `pattern` is OS dependent, but at least the `"\*.ext"` ## notation is supported. + ## + ## See also: + ## * `walkFiles iterator <#walkFiles.i,string>`_ + ## * `walkDirs iterator <#walkDirs.i,string>`_ + ## * `walkDir iterator <#walkDir.i,string>`_ + ## * `walkDirRec iterator <#walkDirRec.i,string>`_ walkCommon(pattern, defaultWalkFilter) iterator walkFiles*(pattern: string): string {.tags: [ReadDirEffect], noNimScript.} = - ## Iterate over all the files that match the `pattern`. On POSIX this uses - ## the `glob`:idx: call. + ## Iterate over all the files that match the `pattern`. ## - ## `pattern` is OS dependent, but at least the "\*.ext" + ## On POSIX this uses the `glob`:idx: call. + ## `pattern` is OS dependent, but at least the `"\*.ext"` ## notation is supported. + ## + ## See also: + ## * `walkPattern iterator <#walkPattern.i,string>`_ + ## * `walkDirs iterator <#walkDirs.i,string>`_ + ## * `walkDir iterator <#walkDir.i,string>`_ + ## * `walkDirRec iterator <#walkDirRec.i,string>`_ walkCommon(pattern, isFile) iterator walkDirs*(pattern: string): string {.tags: [ReadDirEffect], noNimScript.} = ## Iterate over all the directories that match the `pattern`. - ## On POSIX this uses the `glob`:idx: call. ## - ## `pattern` is OS dependent, but at least the "\*.ext" + ## On POSIX this uses the `glob`:idx: call. + ## `pattern` is OS dependent, but at least the `"\*.ext"` ## notation is supported. + ## + ## See also: + ## * `walkPattern iterator <#walkPattern.i,string>`_ + ## * `walkFiles iterator <#walkFiles.i,string>`_ + ## * `walkDir iterator <#walkDir.i,string>`_ + ## * `walkDirRec iterator <#walkDirRec.i,string>`_ walkCommon(pattern, isDir) proc expandFilename*(filename: string): string {.rtl, extern: "nos$1", tags: [ReadDirEffect], noNimScript.} = - ## Returns the full (`absolute`:idx:) path of an existing file `filename`, - ## raises OSError in case of an error. Follows symlinks. + ## Returns the full (`absolute`:idx:) path of an existing file `filename`. + ## + ## Raises `OSError` in case of an error. Follows symlinks. when defined(windows): var bufsize = MAX_PATH.int32 when useWinUnicode: @@ -1440,13 +1844,19 @@ proc expandFilename*(filename: string): string {.rtl, extern: "nos$1", type PathComponent* = enum ## Enumeration specifying a path component. + ## + ## See also: + ## * `walkDirRec iterator <#walkDirRec.i,string>`_ + ## * `FileInfo object <#FileInfo>`_ pcFile, ## path refers to a file pcLinkToFile, ## path refers to a symbolic link to a file pcDir, ## path refers to a directory pcLinkToDir ## path refers to a symbolic link to a directory proc getCurrentCompilerExe*(): string {.compileTime.} = discard - ## `getAppFilename` at CT; can be used to retrive the currently executing + ## This is `getAppFilename() <#getAppFilename>`_ at compile time. + ## + ## Can be used to retrive the currently executing ## Nim compiler from a Nim or nimscript program, or the nimble binary ## inside a nimble program (likewise with other binaries built from ## compiler API). @@ -1467,10 +1877,11 @@ proc staticWalkDir(dir: string; relative: bool): seq[ iterator walkDir*(dir: string; relative=false): tuple[kind: PathComponent, path: string] {. tags: [ReadDirEffect].} = - ## walks over the directory `dir` and yields for each directory or file in - ## `dir`. The component type and full path for each item is returned. - ## Walking is not recursive. If ``relative`` is true the resulting path is - ## shortened to be relative to ``dir``. + ## Walks over the directory `dir` and yields for each directory or file in + ## `dir`. The component type and full path for each item are returned. + ## + ## Walking is not recursive. If ``relative`` is true (default: false) + ## the resulting path is shortened to be relative to ``dir``. ## Example: This directory structure:: ## dirA / dirB / fileB1.txt ## / dirC @@ -1483,11 +1894,18 @@ iterator walkDir*(dir: string; relative=false): tuple[kind: PathComponent, path: ## for kind, path in walkDir("dirA"): ## echo(path) ## - ## produces this output (but not necessarily in this order!):: + ## produce this output (but not necessarily in this order!):: ## dirA/dirB ## dirA/dirC ## dirA/fileA1.txt ## dirA/fileA2.txt + ## + ## See also: + ## * `walkPattern iterator <#walkPattern.i,string>`_ + ## * `walkFiles iterator <#walkFiles.i,string>`_ + ## * `walkDirs iterator <#walkDirs.i,string>`_ + ## * `walkDirRec iterator <#walkDirRec.i,string>`_ + when nimvm: for k, v in items(staticWalkDir(dir, relative)): yield (k, v) @@ -1554,19 +1972,20 @@ iterator walkDirRec*(dir: string, relative = false): string {.tags: [ReadDirEffect].} = ## Recursively walks over the directory `dir` and yields for each file ## or directory in `dir`. - ## If ``relative`` is true the resulting path is + ## + ## If ``relative`` is true (default: false) the resulting path is ## shortened to be relative to ``dir``, otherwise the full path is returned. ## ## **Warning**: ## Modifying the directory structure while the iterator ## is traversing may result in undefined behavior! ## - ## Walking is recursive. `filters` controls the behaviour of the iterator: + ## Walking is recursive. `followFilter` controls the behaviour of the iterator: ## ## --------------------- --------------------------------------------- ## yieldFilter meaning ## --------------------- --------------------------------------------- - ## ``pcFile`` yield real files + ## ``pcFile`` yield real files (default) ## ``pcLinkToFile`` yield symbolic links to files ## ``pcDir`` yield real directories ## ``pcLinkToDir`` yield symbolic links to directories @@ -1575,10 +1994,17 @@ iterator walkDirRec*(dir: string, ## --------------------- --------------------------------------------- ## followFilter meaning ## --------------------- --------------------------------------------- - ## ``pcDir`` follow real directories + ## ``pcDir`` follow real directories (default) ## ``pcLinkToDir`` follow symbolic links to directories ## --------------------- --------------------------------------------- ## + ## + ## See also: + ## * `walkPattern iterator <#walkPattern.i,string>`_ + ## * `walkFiles iterator <#walkFiles.i,string>`_ + ## * `walkDirs iterator <#walkDirs.i,string>`_ + ## * `walkDir iterator <#walkDir.i,string>`_ + var stack = @[""] while stack.len > 0: let d = stack.pop() @@ -1609,6 +2035,15 @@ proc removeDir*(dir: string) {.rtl, extern: "nos$1", tags: [ ## ## If this fails, `OSError` is raised. This does not fail if the directory never ## existed in the first place. + ## + ## See also: + ## * `tryRemoveFile proc <#tryRemoveFile,string>`_ + ## * `removeFile proc <#removeFile,string>`_ + ## * `existsOrCreateDir proc <#existsOrCreateDir,string>`_ + ## * `createDir proc <#createDir,string>`_ + ## * `copyDir proc <#copyDir,string,string>`_ + ## * `copyDirWithPermissions proc <#copyDirWithPermissions,string,string>`_ + ## * `moveDir proc <#moveDir,string,string>`_ for kind, path in walkDir(dir): case kind of pcFile, pcLinkToFile, pcLinkToDir: removeFile(path) @@ -1666,6 +2101,13 @@ proc existsOrCreateDir*(dir: string): bool {.rtl, extern: "nos$1", ## Does not create parent directories (fails if parent does not exist). ## Returns `true` if the directory already exists, and `false` ## otherwise. + ## + ## See also: + ## * `removeDir proc <#removeDir,string>`_ + ## * `createDir proc <#createDir,string>`_ + ## * `copyDir proc <#copyDir,string,string>`_ + ## * `copyDirWithPermissions proc <#copyDirWithPermissions,string,string>`_ + ## * `moveDir proc <#moveDir,string,string>`_ result = not rawCreateDir(dir) if result: # path already exists - need to check that it is indeed a directory @@ -1677,9 +2119,17 @@ proc createDir*(dir: string) {.rtl, extern: "nos$1", ## Creates the `directory`:idx: `dir`. ## ## The directory may contain several subdirectories that do not exist yet. - ## The full path is created. If this fails, `OSError` is raised. It does **not** - ## fail if the directory already exists because for most usages this does not - ## indicate an error. + ## The full path is created. If this fails, `OSError` is raised. + ## + ## It does **not** fail if the directory already exists because for + ## most usages this does not indicate an error. + ## + ## See also: + ## * `removeDir proc <#removeDir,string>`_ + ## * `existsOrCreateDir proc <#existsOrCreateDir,string>`_ + ## * `copyDir proc <#copyDir,string,string>`_ + ## * `copyDirWithPermissions proc <#copyDirWithPermissions,string,string>`_ + ## * `moveDir proc <#moveDir,string,string>`_ var omitNext = false when doslikeFileSystem: omitNext = isAbsolute(dir) @@ -1699,11 +2149,24 @@ proc copyDir*(source, dest: string) {.rtl, extern: "nos$1", tags: [WriteIOEffect, ReadIOEffect], benign, noNimScript.} = ## Copies a directory from `source` to `dest`. ## - ## If this fails, `OSError` is raised. On the Windows platform this proc will - ## copy the attributes from `source` into `dest`. On other platforms created - ## files and directories will inherit the default permissions of a newly - ## created file/directory for the user. To preserve attributes recursively on - ## these platforms use `copyDirWithPermissions() <#copyDirWithPermissions>`_. + ## If this fails, `OSError` is raised. + ## + ## On the Windows platform this proc will copy the attributes from + ## `source` into `dest`. + ## + ## On other platforms created files and directories will inherit the + ## default permissions of a newly created file/directory for the user. + ## Use `copyDirWithPermissions proc <#copyDirWithPermissions,string,string>`_ + ## to preserve attributes recursively on these platforms. + ## + ## See also: + ## * `copyDirWithPermissions proc <#copyDirWithPermissions,string,string>`_ + ## * `copyFile proc <#copyFile,string,string>`_ + ## * `copyFileWithPermissions proc <#copyFileWithPermissions,string,string>`_ + ## * `removeDir proc <#removeDir,string>`_ + ## * `existsOrCreateDir proc <#existsOrCreateDir,string>`_ + ## * `createDir proc <#createDir,string>`_ + ## * `moveDir proc <#moveDir,string,string>`_ createDir(dest) for kind, path in walkDir(source): var noSource = splitPath(path).tail @@ -1714,6 +2177,24 @@ proc copyDir*(source, dest: string) {.rtl, extern: "nos$1", copyDir(path, dest / noSource) else: discard +proc moveDir*(source, dest: string) {.tags: [ReadIOEffect, WriteIOEffect], noNimScript.} = + ## Moves a directory from `source` to `dest`. + ## + ## If this fails, `OSError` is raised. + ## + ## See also: + ## * `moveFile proc <#moveFile,string,string>`_ + ## * `copyDir proc <#copyDir,string,string>`_ + ## * `copyDirWithPermissions proc <#copyDirWithPermissions,string,string>`_ + ## * `removeDir proc <#removeDir,string>`_ + ## * `existsOrCreateDir proc <#existsOrCreateDir,string>`_ + ## * `createDir proc <#createDir,string>`_ + if not tryMoveFSObject(source, dest): + when not defined(windows): + # Fallback to copy & del + copyDir(source, dest) + removeDir(source) + proc createSymlink*(src, dest: string) {.noNimScript.} = ## Create a symbolic link at `dest` which points to the item specified ## by `src`. On most operating systems, will fail if a link already exists. @@ -1721,6 +2202,11 @@ proc createSymlink*(src, dest: string) {.noNimScript.} = ## **Warning**: ## Some OS's (such as Microsoft Windows) restrict the creation ## of symlinks to root users (administrators). + ## + ## See also: + ## * `createHardlink proc <#createHardlink,string,string>`_ + ## * `expandSymlink proc <#expandSymlink,string>`_ + when defined(Windows): # 2 is the SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE. This allows # anyone with developer mode on to create a link @@ -1743,6 +2229,9 @@ proc createHardlink*(src, dest: string) {.noNimScript.} = ## ## **Warning**: Some OS's restrict the creation of hard links to ## root users (administrators). + ## + ## See also: + ## * `createSymlink proc <#createSymlink,string,string>`_ when defined(Windows): when useWinUnicode: var wSrc = newWideCString(src) @@ -1756,13 +2245,128 @@ proc createHardlink*(src, dest: string) {.noNimScript.} = if link(src, dest) != 0: raiseOSError(osLastError()) +proc copyFileWithPermissions*(source, dest: string, + ignorePermissionErrors = true) {.noNimScript.} = + ## Copies a file from `source` to `dest` preserving file permissions. + ## + ## This is a wrapper proc around `copyFile <#copyFile,string,string>`_, + ## `getFilePermissions <#getFilePermissions,string>`_ and + ## `setFilePermissions<#setFilePermissions,string,set[FilePermission]>`_ + ## procs on non-Windows platforms. + ## + ## On Windows this proc is just a wrapper for `copyFile proc + ## <#copyFile,string,string>`_ since that proc already copies attributes. + ## + ## On non-Windows systems permissions are copied after the file itself has + ## been copied, which won't happen atomically and could lead to a race + ## condition. If `ignorePermissionErrors` is true (default), errors while + ## reading/setting file attributes will be ignored, otherwise will raise + ## `OSError`. + ## + ## See also: + ## * `copyFile proc <#copyFile,string,string>`_ + ## * `copyDir proc <#copyDir,string,string>`_ + ## * `tryRemoveFile proc <#tryRemoveFile,string>`_ + ## * `removeFile proc <#removeFile,string>`_ + ## * `moveFile proc <#moveFile,string,string>`_ + ## * `copyDirWithPermissions proc <#copyDirWithPermissions,string,string>`_ + copyFile(source, dest) + when not defined(Windows): + try: + setFilePermissions(dest, getFilePermissions(source)) + except: + if not ignorePermissionErrors: + raise + +proc copyDirWithPermissions*(source, dest: string, + ignorePermissionErrors = true) {.rtl, extern: "nos$1", + tags: [WriteIOEffect, ReadIOEffect], benign, noNimScript.} = + ## Copies a directory from `source` to `dest` preserving file permissions. + ## + ## If this fails, `OSError` is raised. This is a wrapper proc around `copyDir + ## <#copyDir,string,string>`_ and `copyFileWithPermissions + ## <#copyFileWithPermissions,string,string>`_ procs + ## on non-Windows platforms. + ## + ## On Windows this proc is just a wrapper for `copyDir proc + ## <#copyDir,string,string>`_ since that proc already copies attributes. + ## + ## On non-Windows systems permissions are copied after the file or directory + ## itself has been copied, which won't happen atomically and could lead to a + ## race condition. If `ignorePermissionErrors` is true (default), errors while + ## reading/setting file attributes will be ignored, otherwise will raise + ## `OSError`. + ## + ## See also: + ## * `copyDir proc <#copyDir,string,string>`_ + ## * `copyFile proc <#copyFile,string,string>`_ + ## * `copyFileWithPermissions proc <#copyFileWithPermissions,string,string>`_ + ## * `removeDir proc <#removeDir,string>`_ + ## * `moveDir proc <#moveDir,string,string>`_ + ## * `existsOrCreateDir proc <#existsOrCreateDir,string>`_ + ## * `createDir proc <#createDir,string>`_ + createDir(dest) + when not defined(Windows): + try: + setFilePermissions(dest, getFilePermissions(source)) + except: + if not ignorePermissionErrors: + raise + for kind, path in walkDir(source): + var noSource = splitPath(path).tail + case kind + of pcFile: + copyFileWithPermissions(path, dest / noSource, ignorePermissionErrors) + of pcDir: + copyDirWithPermissions(path, dest / noSource, ignorePermissionErrors) + else: discard + +proc inclFilePermissions*(filename: string, + permissions: set[FilePermission]) {. + rtl, extern: "nos$1", tags: [ReadDirEffect, WriteDirEffect], noNimScript.} = + ## A convenience proc for: + ## + ## .. code-block:: nim + ## setFilePermissions(filename, getFilePermissions(filename)+permissions) + setFilePermissions(filename, getFilePermissions(filename)+permissions) + +proc exclFilePermissions*(filename: string, + permissions: set[FilePermission]) {. + rtl, extern: "nos$1", tags: [ReadDirEffect, WriteDirEffect], noNimScript.} = + ## A convenience proc for: + ## + ## .. code-block:: nim + ## setFilePermissions(filename, getFilePermissions(filename)-permissions) + setFilePermissions(filename, getFilePermissions(filename)-permissions) + +proc expandSymlink*(symlinkPath: string): string {.noNimScript.} = + ## Returns a string representing the path to which the symbolic link points. + ## + ## On Windows this is a noop, ``symlinkPath`` is simply returned. + ## + ## See also: + ## * `createSymlink proc <#createSymlink,string,string>`_ + when defined(windows): + result = symlinkPath + else: + result = newString(256) + var len = readlink(symlinkPath, result, 256) + if len < 0: + raiseOSError(osLastError()) + if len > 256: + result = newString(len+1) + len = readlink(symlinkPath, result, len) + setLen(result, len) + proc parseCmdLine*(c: string): seq[string] {. noSideEffect, rtl, extern: "nos$1".} = - ## Splits a `command line`:idx: into several components; - ## This proc is only occasionally useful, better use the `parseopt` module. + ## Splits a `command line`:idx: into several components. + ## + ## **Note**: This proc is only occasionally useful, better use the + ## `parseopt module <parseopt.html>`_. ## - ## On Windows, it uses the following parsing rules - ## (see http://msdn.microsoft.com/en-us/library/17w5ykft.aspx ): + ## On Windows, it uses the `following parsing rules + ## <http://msdn.microsoft.com/en-us/library/17w5ykft.aspx>`_: ## ## * Arguments are delimited by white space, which is either a space or a tab. ## * The caret character (^) is not recognized as an escape character or @@ -1787,6 +2391,13 @@ proc parseCmdLine*(c: string): seq[string] {. ## On Posix systems, it uses the following parsing rules: ## Components are separated by whitespace unless the whitespace ## occurs within ``"`` or ``'`` quotes. + ## + ## See also: + ## * `parseopt module <parseopt.html>`_ + ## * `paramCount proc <#paramCount>`_ + ## * `paramStr proc <#paramStr,int>`_ + ## * `commandLineParams proc <#commandLineParams>`_ + result = @[] var i = 0 var a = "" @@ -1844,102 +2455,6 @@ proc parseCmdLine*(c: string): seq[string] {. inc(i) add(result, a) -proc copyFileWithPermissions*(source, dest: string, - ignorePermissionErrors = true) {.noNimScript.} = - ## Copies a file from `source` to `dest` preserving file permissions. - ## - ## This is a wrapper proc around `copyFile() <#copyFile>`_, - ## `getFilePermissions() <#getFilePermissions>`_ and `setFilePermissions() - ## <#setFilePermissions>`_ on non Windows platform. On Windows this proc is - ## just a wrapper for `copyFile() <#copyFile>`_ since that proc already - ## copies attributes. - ## - ## On non Windows systems permissions are copied after the file itself has - ## been copied, which won't happen atomically and could lead to a race - ## condition. If `ignorePermissionErrors` is true, errors while - ## reading/setting file attributes will be ignored, otherwise will raise - ## `OSError`. - copyFile(source, dest) - when not defined(Windows): - try: - setFilePermissions(dest, getFilePermissions(source)) - except: - if not ignorePermissionErrors: - raise - -proc copyDirWithPermissions*(source, dest: string, - ignorePermissionErrors = true) {.rtl, extern: "nos$1", - tags: [WriteIOEffect, ReadIOEffect], benign, noNimScript.} = - ## Copies a directory from `source` to `dest` preserving file permissions. - ## - ## If this fails, `OSError` is raised. This is a wrapper proc around `copyDir() - ## <#copyDir>`_ and `copyFileWithPermissions() <#copyFileWithPermissions>`_ - ## on non Windows platforms. On Windows this proc is just a wrapper for - ## `copyDir() <#copyDir>`_ since that proc already copies attributes. - ## - ## On non Windows systems permissions are copied after the file or directory - ## itself has been copied, which won't happen atomically and could lead to a - ## race condition. If `ignorePermissionErrors` is true, errors while - ## reading/setting file attributes will be ignored, otherwise will raise - ## `OSError`. - createDir(dest) - when not defined(Windows): - try: - setFilePermissions(dest, getFilePermissions(source)) - except: - if not ignorePermissionErrors: - raise - for kind, path in walkDir(source): - var noSource = splitPath(path).tail - case kind - of pcFile: - copyFileWithPermissions(path, dest / noSource, ignorePermissionErrors) - of pcDir: - copyDirWithPermissions(path, dest / noSource, ignorePermissionErrors) - else: discard - -proc inclFilePermissions*(filename: string, - permissions: set[FilePermission]) {. - rtl, extern: "nos$1", tags: [ReadDirEffect, WriteDirEffect], noNimScript.} = - ## a convenience procedure for: - ## - ## .. code-block:: nim - ## setFilePermissions(filename, getFilePermissions(filename)+permissions) - setFilePermissions(filename, getFilePermissions(filename)+permissions) - -proc exclFilePermissions*(filename: string, - permissions: set[FilePermission]) {. - rtl, extern: "nos$1", tags: [ReadDirEffect, WriteDirEffect], noNimScript.} = - ## a convenience procedure for: - ## - ## .. code-block:: nim - ## setFilePermissions(filename, getFilePermissions(filename)-permissions) - setFilePermissions(filename, getFilePermissions(filename)-permissions) - -proc moveDir*(source, dest: string) {.tags: [ReadIOEffect, WriteIOEffect], noNimScript.} = - ## Moves a directory from `source` to `dest`. If this fails, `OSError` is raised. - if not tryMoveFSObject(source, dest): - when not defined(windows): - # Fallback to copy & del - copyDir(source, dest) - removeDir(source) - -proc expandSymlink*(symlinkPath: string): string {.noNimScript.} = - ## Returns a string representing the path to which the symbolic link points. - ## - ## On Windows this is a noop, ``symlinkPath`` is simply returned. - when defined(windows): - result = symlinkPath - else: - result = newString(256) - var len = readlink(symlinkPath, result, 256) - if len < 0: - raiseOSError(osLastError()) - if len > 256: - result = newString(len+1) - len = readlink(symlinkPath, result, len) - setLen(result, len) - when defined(nimdoc): # Common forward declaration docstring block for parameter retrieval procs. proc paramCount*(): int {.tags: [ReadIOEffect].} = @@ -1948,14 +2463,21 @@ when defined(nimdoc): ## ## Unlike `argc`:idx: in C, if your binary was called without parameters this ## will return zero. - ## You can query each individual paramater with `paramStr() <#paramStr>`_ - ## or retrieve all of them in one go with `commandLineParams() + ## You can query each individual paramater with `paramStr proc <#paramStr,int>`_ + ## or retrieve all of them in one go with `commandLineParams proc ## <#commandLineParams>`_. ## - ## **Availability**: When generating a dynamic library (see --app:lib) on + ## **Availability**: When generating a dynamic library (see `--app:lib`) on ## Posix this proc is not defined. - ## Test for availability using `declared() <system.html#declared>`_. - ## Example: + ## Test for availability using `declared() <system.html#declared,untyped>`_. + ## + ## See also: + ## * `parseopt module <parseopt.html>`_ + ## * `parseCmdLine proc <#parseCmdLine,string>`_ + ## * `paramStr proc <#paramStr,int>`_ + ## * `commandLineParams proc <#commandLineParams>`_ + ## + ## **Examples:** ## ## .. code-block:: nim ## when declared(paramCount): @@ -1976,10 +2498,18 @@ when defined(nimdoc): ## contents (usually the name of the invoked executable). You should avoid ## this and call `getAppFilename() <#getAppFilename>`_ instead. ## - ## **Availability**: When generating a dynamic library (see --app:lib) on + ## **Availability**: When generating a dynamic library (see `--app:lib`) on ## Posix this proc is not defined. - ## Test for availability using `declared() <system.html#declared>`_. - ## Example: + ## Test for availability using `declared() <system.html#declared,untyped>`_. + ## + ## See also: + ## * `parseopt module <parseopt.html>`_ + ## * `parseCmdLine proc <#parseCmdLine,string>`_ + ## * `paramCount proc <#paramCount>`_ + ## * `commandLineParams proc <#commandLineParams>`_ + ## * `getAppFilename proc <#getAppFilename>`_ + ## + ## **Examples:** ## ## .. code-block:: nim ## when declared(paramStr): @@ -2052,8 +2582,17 @@ when declared(paramCount) or defined(nimdoc): ## ## **Availability**: On Posix there is no portable way to get the command ## line from a DLL and thus the proc isn't defined in this environment. You - ## can test for its availability with `declared() <system.html#declared>`_. - ## Example: + ## can test for its availability with `declared() + ## <system.html#declared,untyped>`_. + ## + ## See also: + ## * `parseopt module <parseopt.html>`_ + ## * `parseCmdLine proc <#parseCmdLine,string>`_ + ## * `paramCount proc <#paramCount>`_ + ## * `paramStr proc <#paramStr,int>`_ + ## * `getAppFilename proc <#getAppFilename>`_ + ## + ## **Examples:** ## ## .. code-block:: nim ## when declared(commandLineParams): @@ -2151,10 +2690,12 @@ when defined(haiku): result = "" proc getAppFilename*(): string {.rtl, extern: "nos$1", tags: [ReadIOEffect], noNimScript.} = - ## Returns the filename of the application's executable. See also - ## `getCurrentCompilerExe`. + ## Returns the filename of the application's executable. + ## This proc will resolve symlinks. ## - ## This procedure will resolve symlinks. + ## See also: + ## * `getAppDir proc <#getAppDir>`_ + ## * `getCurrentCompilerExe proc <#getCurrentCompilerExe>`_ # Linux: /proc/<pid>/exe # Solaris: @@ -2213,10 +2754,13 @@ proc getAppFilename*(): string {.rtl, extern: "nos$1", tags: [ReadIOEffect], noN proc getAppDir*(): string {.rtl, extern: "nos$1", tags: [ReadIOEffect], noNimScript.} = ## Returns the directory of the application's executable. + ## + ## See also: + ## * `getAppFilename proc <#getAppFilename>`_ result = splitFile(getAppFilename()).dir proc sleep*(milsecs: int) {.rtl, extern: "nos$1", tags: [TimeEffect], noNimScript.} = - ## sleeps `milsecs` milliseconds. + ## Sleeps `milsecs` milliseconds. when defined(windows): winlean.sleep(int32(milsecs)) else: @@ -2227,7 +2771,7 @@ proc sleep*(milsecs: int) {.rtl, extern: "nos$1", tags: [TimeEffect], noNimScrip proc getFileSize*(file: string): BiggestInt {.rtl, extern: "nos$1", tags: [ReadIOEffect], noNimScript.} = - ## returns the file size of `file` (in bytes). An ``OSError`` exception is + ## Returns the file size of `file` (in bytes). ``OSError`` is ## raised in case of an error. when defined(windows): var a: WIN32_FIND_DATA @@ -2254,14 +2798,19 @@ else: type FileInfo* = object ## Contains information associated with a file object. - id*: tuple[device: DeviceId, file: FileId] # Device and file id. - kind*: PathComponent # Kind of file object - directory, symlink, etc. - size*: BiggestInt # Size of file. - permissions*: set[FilePermission] # File permissions - linkCount*: BiggestInt # Number of hard links the file object has. - lastAccessTime*: times.Time # Time file was last accessed. - lastWriteTime*: times.Time # Time file was last modified/written to. - creationTime*: times.Time # Time file was created. Not supported on all systems! + ## + ## See also: + ## * `getFileInfo(handle) proc <#getFileInfo,FileHandle>`_ + ## * `getFileInfo(file) proc <#getFileInfo,File>`_ + ## * `getFileInfo(path) proc <#getFileInfo,string>`_ + id*: tuple[device: DeviceId, file: FileId] ## Device and file id. + kind*: PathComponent ## Kind of file object - directory, symlink, etc. + size*: BiggestInt ## Size of file. + permissions*: set[FilePermission] ## File permissions + linkCount*: BiggestInt ## Number of hard links the file object has. + lastAccessTime*: times.Time ## Time file was last accessed. + lastWriteTime*: times.Time ## Time file was last modified/written to. + creationTime*: times.Time ## Time file was created. Not supported on all systems! template rawToFormalFileInfo(rawInfo, path, formalInfo): untyped = ## Transforms the native file info structure into the one nim uses. @@ -2333,7 +2882,12 @@ proc getFileInfo*(handle: FileHandle): FileInfo {.noNimScript.} = ## handle. ## ## If the information cannot be retrieved, such as when the file handle - ## is invalid, an error will be thrown. + ## is invalid, `OSError` is raised. + ## + ## See also: + ## * `getFileInfo(file) proc <#getFileInfo,File>`_ + ## * `getFileInfo(path) proc <#getFileInfo,string>`_ + # Done: ID, Kind, Size, Permissions, Link Count when defined(Windows): var rawInfo: BY_HANDLE_FILE_INFORMATION @@ -2350,6 +2904,11 @@ proc getFileInfo*(handle: FileHandle): FileInfo {.noNimScript.} = rawToFormalFileInfo(rawInfo, "", result) proc getFileInfo*(file: File): FileInfo {.noNimScript.} = + ## Retrieves file information for the file object. + ## + ## See also: + ## * `getFileInfo(handle) proc <#getFileInfo,FileHandle>`_ + ## * `getFileInfo(path) proc <#getFileInfo,string>`_ if file.isNil: raise newException(IOError, "File is nil") result = getFileInfo(file.getFileHandle()) @@ -2358,16 +2917,20 @@ proc getFileInfo*(path: string, followSymlink = true): FileInfo {.noNimScript.} ## Retrieves file information for the file object pointed to by `path`. ## ## Due to intrinsic differences between operating systems, the information - ## contained by the returned `FileInfo` structure will be slightly different - ## across platforms, and in some cases, incomplete or inaccurate. + ## contained by the returned `FileInfo object <#FileInfo>`_ will be slightly + ## different across platforms, and in some cases, incomplete or inaccurate. ## - ## When `followSymlink` is true, symlinks are followed and the information - ## retrieved is information related to the symlink's target. Otherwise, - ## information on the symlink itself is retrieved. + ## When `followSymlink` is true (default), symlinks are followed and the + ## information retrieved is information related to the symlink's target. + ## Otherwise, information on the symlink itself is retrieved. ## ## If the information cannot be retrieved, such as when the path doesn't ## exist, or when permission restrictions prevent the program from retrieving - ## file information, an error will be thrown. + ## file information, `OSError` is raised. + ## + ## See also: + ## * `getFileInfo(handle) proc <#getFileInfo,FileHandle>`_ + ## * `getFileInfo(file) proc <#getFileInfo,File>`_ when defined(Windows): var handle = openHandle(path, followSymlink) @@ -2389,21 +2952,23 @@ proc getFileInfo*(path: string, followSymlink = true): FileInfo {.noNimScript.} rawToFormalFileInfo(rawInfo, path, result) proc isHidden*(path: string): bool {.noNimScript.} = - ## Determines whether ``path`` is hidden or not, using this - ## reference https://en.wikipedia.org/wiki/Hidden_file_and_hidden_directory + ## Determines whether ``path`` is hidden or not, using `this + ## reference <https://en.wikipedia.org/wiki/Hidden_file_and_hidden_directory>`_. ## ## On Windows: returns true if it exists and its "hidden" attribute is set. ## ## On posix: returns true if ``lastPathPart(path)`` starts with ``.`` and is - ## not ``.`` or ``..``. Note: paths are not normalized to determine `isHidden`. + ## not ``.`` or ``..``. + ## + ## **Note**: paths are not normalized to determine `isHidden`. runnableExamples: when defined(posix): - doAssert ".foo".isHidden - doAssert: not ".foo/bar".isHidden - doAssert: not ".".isHidden - doAssert: not "..".isHidden - doAssert: not "".isHidden - doAssert ".foo/".isHidden + assert ".foo".isHidden + assert not ".foo/bar".isHidden + assert not ".".isHidden + assert not "..".isHidden + assert not "".isHidden + assert ".foo/".isHidden when defined(Windows): when useWinUnicode: @@ -2417,7 +2982,10 @@ proc isHidden*(path: string): bool {.noNimScript.} = result = len(fileName) >= 2 and fileName[0] == '.' and fileName != ".." proc getCurrentProcessId*(): int {.noNimScript.} = - ## return current process ID. See also ``osproc.processID(p: Process)``. + ## Return current process ID. + ## + ## See also: + ## * `osproc.processID(p: Process) <osproc.html#processID,Process>`_ when defined(windows): proc GetCurrentProcessId(): DWORD {.stdcall, dynlib: "kernel32", importc: "GetCurrentProcessId".} @@ -2444,6 +3012,7 @@ proc setLastModificationTime*(file: string, t: times.Time) {.noNimScript.} = discard h.closeHandle if res == 0'i32: raiseOSError(osLastError()) + when isMainModule: assert quoteShellWindows("aaa") == "aaa" assert quoteShellWindows("aaa\"") == "aaa\\\"" diff --git a/lib/pure/times.nim b/lib/pure/times.nim index 0104a97c1..e2d0b8739 100644 --- a/lib/pure/times.nim +++ b/lib/pure/times.nim @@ -224,9 +224,6 @@ elif defined(posix): cpuClockId {.importc: "CLOCK_THREAD_CPUTIME_ID", header: "<time.h>".}: Clockid - proc gettimeofday(tp: var Timeval, unused: pointer = nil) - {.importc: "gettimeofday", header: "<sys/time.h>".} - when not defined(freebsd) and not defined(netbsd) and not defined(openbsd): var timezone {.importc, header: "<time.h>".}: int when not defined(valgrind_workaround_10121): @@ -1110,12 +1107,6 @@ proc getTime*(): Time {.tags: [TimeEffect], benign.} = let nanos = convert(Milliseconds, Nanoseconds, millis mod convert(Seconds, Milliseconds, 1).int) result = initTime(seconds, nanos) - # I'm not entirely certain if freebsd needs to use `gettimeofday`. - elif defined(macosx) or defined(freebsd): - var a: Timeval - gettimeofday(a) - result = initTime(a.tv_sec.int64, - convert(Microseconds, Nanoseconds, a.tv_usec.int)) elif defined(posix): var ts: Timespec discard clock_gettime(realTimeClockId, ts) @@ -2449,9 +2440,10 @@ when not defined(JS): ## ## ``getTime`` should generally be prefered over this proc. when defined(posix): - var a: Timeval - gettimeofday(a) - result = toBiggestFloat(a.tv_sec.int64) + toFloat(a.tv_usec)*0.00_0001 + var ts: Timespec + discard clock_gettime(realTimeClockId, ts) + result = toBiggestFloat(ts.tv_sec.int64) + + toBiggestFloat(ts.tv_nsec.int64) / 1_000_000_000 elif defined(windows): var f: winlean.FILETIME getSystemTimeAsFileTime(f) diff --git a/lib/system.nim b/lib/system.nim index 0241b92e0..b9be52308 100644 --- a/lib/system.nim +++ b/lib/system.nim @@ -3049,6 +3049,19 @@ else: if x < 0: -x else: x {.pop.} +when defined(nimNewRoof): + iterator `..<`*[T](a, b: T): T = + var i = T(a) + while i < b: + yield i + inc i +else: + iterator `..<`*[S, T](a: S, b: T): T = + var i = T(a) + while i < b: + yield i + inc i + when not defined(JS): proc likelyProc(val: bool): bool {.importc: "likely", nodecl, nosideeffect.} proc unlikelyProc(val: bool): bool {.importc: "unlikely", nodecl, nosideeffect.} @@ -3144,7 +3157,7 @@ when not defined(JS): #and not defined(nimscript): # ----------------- IO Part ------------------------------------------------ type CFile {.importc: "FILE", header: "<stdio.h>", - final, incompletestruct.} = object + incompletestruct.} = object File* = ptr CFile ## The type representing a file handle. FileMode* = enum ## The file mode when opening a file. @@ -3392,6 +3405,10 @@ when not defined(JS): #and not defined(nimscript): ## returns the OS file handle of the file ``f``. This is only useful for ## platform specific programming. + when defined(gcDestructors) and not defined(nimscript): + include "core/strs" + include "core/seqs" + when declared(newSeq): proc cstringArrayToSeq*(a: cstringArray, len: Natural): seq[string] = ## converts a ``cstringArray`` to a ``seq[string]``. `a` is supposed to be @@ -3483,10 +3500,6 @@ when not defined(JS): #and not defined(nimscript): when defined(memtracker): include "system/memtracker" - when defined(gcDestructors): - include "core/strs" - include "core/seqs" - when hostOS == "standalone": include "system/embedded" else: @@ -3716,19 +3729,6 @@ template `..<`*(a, b: untyped): untyped = ## a shortcut for 'a .. (when b is BackwardsIndex: succ(b) else: pred(b))'. a .. (when b is BackwardsIndex: succ(b) else: pred(b)) -when defined(nimNewRoof): - iterator `..<`*[T](a, b: T): T = - var i = T(a) - while i < b: - yield i - inc i -else: - iterator `..<`*[S, T](a: S, b: T): T = - var i = T(a) - while i < b: - yield i - inc i - template spliceImpl(s, a, L, b: untyped): untyped = # make room for additional elements or cut: var shift = b.len - max(0,L) # ignore negative slice size @@ -4307,15 +4307,17 @@ proc `==`*(x, y: cstring): bool {.magic: "EqCString", noSideEffect, when defined(nimNoNilSeqs2): when not compileOption("nilseqs"): when defined(nimHasUserErrors): - proc `==`*(x: string; y: type(nil)): bool {. + # bug #9149; ensure that 'type(nil)' does not match *too* well by using 'type(nil) | type(nil)'. + # Eventually (in 0.20?) we will be able to remove this hack completely. + proc `==`*(x: string; y: type(nil) | type(nil)): bool {. error: "'nil' is now invalid for 'string'; compile with --nilseqs:on for a migration period".} = discard - proc `==`*(x: type(nil); y: string): bool {. + proc `==`*(x: type(nil) | type(nil); y: string): bool {. error: "'nil' is now invalid for 'string'; compile with --nilseqs:on for a migration period".} = discard else: - proc `==`*(x: string; y: type(nil)): bool {.error.} = discard - proc `==`*(x: type(nil); y: string): bool {.error.} = discard + proc `==`*(x: string; y: type(nil) | type(nil)): bool {.error.} = discard + proc `==`*(x: type(nil) | type(nil); y: string): bool {.error.} = discard template closureScope*(body: untyped): untyped = ## Useful when creating a closure in a loop to capture local loop variables by @@ -4405,7 +4407,7 @@ template doAssertRaises*(exception: typedesc, code: untyped): typed = wrong = true except exception: discard - except Exception as exc: + except Exception: raiseAssert(astToStr(exception) & " wasn't raised, another error was raised instead by:\n"& astToStr(code)) diff --git a/lib/system/excpt.nim b/lib/system/excpt.nim index cc0c1f54b..f2f82c3b8 100644 --- a/lib/system/excpt.nim +++ b/lib/system/excpt.nim @@ -220,11 +220,12 @@ proc auxWriteStackTrace(f: PFrame; s: var seq[StackTraceEntry]) = inc(i) it = it.prev var last = i-1 - if s.len == 0: - s = newSeq[StackTraceEntry](i) - else: - last = s.len + i - 1 - s.setLen(last+1) + when true: # not defined(gcDestructors): + if s.len == 0: + s = newSeq[StackTraceEntry](i) + else: + last = s.len + i - 1 + s.setLen(last+1) it = f while it != nil: s[last] = StackTraceEntry(procname: it.procname, @@ -440,11 +441,13 @@ proc getStackTrace(e: ref Exception): string = else: result = "" -when not defined(gcDestructors): - proc getStackTraceEntries*(e: ref Exception): seq[StackTraceEntry] = - ## Returns the attached stack trace to the exception ``e`` as - ## a ``seq``. This is not yet available for the JS backend. +proc getStackTraceEntries*(e: ref Exception): seq[StackTraceEntry] = + ## Returns the attached stack trace to the exception ``e`` as + ## a ``seq``. This is not yet available for the JS backend. + when not defined(gcDestructors): shallowCopy(result, e.trace) + else: + result = move(e.trace) const nimCallDepthLimit {.intdefine.} = 2000 diff --git a/lib/system/gc.nim b/lib/system/gc.nim index 416827f21..018197c1e 100644 --- a/lib/system/gc.nim +++ b/lib/system/gc.nim @@ -864,7 +864,10 @@ when not defined(useNimRtl): for stack in items(gch.stack): result.add "[GC] stack " & stack.bottom.repr & "[GC] max stack size " & cast[pointer](stack.maxStackSize).repr & "\n" else: - result.add "[GC] stack bottom: " & gch.stack.bottom.repr + # this caused memory leaks, see #10488 ; find a way without `repr` + # maybe using a local copy of strutils.toHex or snprintf + when defined(logGC): + result.add "[GC] stack bottom: " & gch.stack.bottom.repr result.add "[GC] max stack size: " & $gch.stat.maxStackSize & "\n" {.pop.} # profiler: off, stackTrace: off diff --git a/lib/system/gc_regions.nim b/lib/system/gc_regions.nim index 59f68918f..797eeeebf 100644 --- a/lib/system/gc_regions.nim +++ b/lib/system/gc_regions.nim @@ -195,6 +195,19 @@ proc runFinalizers(c: Chunk) = (cast[Finalizer](it.typ.finalizer))(it+!sizeof(ObjHeader)) it = it.nextFinal +proc runFinalizers(c: Chunk; newbump: pointer) = + var it = c.head + var prev: ptr ObjHeader = nil + while it != nil: + let nxt = it.nextFinal + if it >= newbump: + if it.typ != nil and it.typ.finalizer != nil: + (cast[Finalizer](it.typ.finalizer))(it+!sizeof(ObjHeader)) + elif prev != nil: + prev.nextFinal = nil + prev = it + it = nxt + proc dealloc(r: var MemRegion; p: pointer; size: int) = let it = cast[ptr ObjHeader](p-!sizeof(ObjHeader)) if it.typ != nil and it.typ.finalizer != nil: @@ -237,16 +250,15 @@ template computeRemaining(r): untyped = proc setObstackPtr*(r: var MemRegion; sp: StackPtr) = # free everything after 'sp': - if sp.current.next != nil: + if sp.current != nil and sp.current.next != nil: deallocAll(r, sp.current.next) sp.current.next = nil when false: # better leak this memory than be sorry: for i in 0..high(r.freeLists): r.freeLists[i] = nil r.holes = nil - #else: - # deallocAll(r, r.head) - # r.head = nil + if r.tail != nil: runFinalizers(r.tail, sp.bump) + r.bump = sp.bump r.tail = sp.current r.remaining = sp.remaining diff --git a/lib/system/helpers2.nim b/lib/system/helpers2.nim index c67a2c278..8bd69ad71 100644 --- a/lib/system/helpers2.nim +++ b/lib/system/helpers2.nim @@ -1,7 +1,7 @@ # imported by other modules, unlike helpers.nim which is included template formatErrorIndexBound*[T](i, a, b: T): string = - "index out of bounds: (a:" & $a & ") <= (i:" & $i & ") <= (b:" & $b & ") " + "index out of bounds: (a: " & $a & ") <= (i: " & $i & ") <= (b: " & $b & ") " template formatErrorIndexBound*[T](i, n: T): string = - "index out of bounds: (i:" & $i & ") <= (n:" & $n & ") " + "index out of bounds: (i: " & $i & ") <= (n: " & $n & ") " diff --git a/lib/windows/winlean.nim b/lib/windows/winlean.nim index 6c480d03a..d1bfbd447 100644 --- a/lib/windows/winlean.nim +++ b/lib/windows/winlean.nim @@ -896,7 +896,7 @@ proc getProcessTimes*(hProcess: Handle; lpCreationTime, lpExitTime, dynlib: "kernel32", importc: "GetProcessTimes".} type inet_ntop_proc = proc(family: cint, paddr: pointer, pStringBuffer: cstring, - stringBufSize: int32): cstring {.gcsafe, stdcall.} + stringBufSize: int32): cstring {.gcsafe, stdcall, tags: [].} var inet_ntop_real: inet_ntop_proc = nil diff --git a/tests/deprecated/tdeprecated.nim b/tests/deprecated/tdeprecated.nim index 920f350cc..ba8d579ad 100644 --- a/tests/deprecated/tdeprecated.nim +++ b/tests/deprecated/tdeprecated.nim @@ -1,8 +1,21 @@ discard """ - nimout: '''tdeprecated.nim(10, 3) Warning: a is deprecated [Deprecated] -tdeprecated.nim(17, 11) Warning: asdf; enum 'Foo' which contains field 'a' is deprecated [Deprecated] + nimout: ''' +tdeprecated.nim(23, 3) Warning: a is deprecated [Deprecated] +tdeprecated.nim(30, 11) Warning: asdf; enum 'Foo' which contains field 'a' is deprecated [Deprecated] +tdeprecated.nim(40, 16) Warning: use fooX instead; fooA is deprecated [Deprecated] +end ''' """ + + + + + + +## line 15 + + + block: var a {.deprecated.}: array[0..11, int] @@ -17,3 +30,13 @@ block t10111: var _ = a +block: # issue #8063 + type + Foo = enum + fooX + + {.deprecated: [fooA: fooX].} + let + foo: Foo = fooA + echo foo + static: echo "end" diff --git a/tests/dir with space/more spaces/mspace.nim b/tests/dir with space/more spaces/mspace.nim new file mode 100644 index 000000000..bc2c90f5e --- /dev/null +++ b/tests/dir with space/more spaces/mspace.nim @@ -0,0 +1 @@ +proc tenTimes*(x: int): int = 10*x diff --git a/tests/dir with space/tspace.nim b/tests/dir with space/tspace.nim index 59237c9a1..87a52c271 100644 --- a/tests/dir with space/tspace.nim +++ b/tests/dir with space/tspace.nim @@ -2,5 +2,9 @@ discard """ output: "Successful" """ # Test for the compiler to be able to compile a Nim file with spaces in the directory name. +# Also test if import of a directory with a space works. +import "more spaces" / mspace + +assert tenTimes(5) == 50 echo("Successful") diff --git a/tests/misc/tinvalidarrayaccess.nim b/tests/misc/tinvalidarrayaccess.nim index 57ad38b85..ab44d98e8 100644 --- a/tests/misc/tinvalidarrayaccess.nim +++ b/tests/misc/tinvalidarrayaccess.nim @@ -1,5 +1,5 @@ discard """ - errormsg: "index out of bounds: (a:0) <= (i:2) <= (b:1) " + errormsg: "index out of bounds: (a: 0) <= (i: 2) <= (b: 1) " line: 18 """ diff --git a/tests/misc/tinvalidarrayaccess2.nim b/tests/misc/tinvalidarrayaccess2.nim index 86d349457..a791dc4e7 100644 --- a/tests/misc/tinvalidarrayaccess2.nim +++ b/tests/misc/tinvalidarrayaccess2.nim @@ -1,5 +1,5 @@ discard """ - errormsg: "index out of bounds: (a:0) <= (i:3) <= (b:1) " + errormsg: "index out of bounds: (a: 0) <= (i: 3) <= (b: 1) " line: 9 """ diff --git a/tests/overload/tconverter_to_string.nim b/tests/overload/tconverter_to_string.nim new file mode 100644 index 000000000..1960372d8 --- /dev/null +++ b/tests/overload/tconverter_to_string.nim @@ -0,0 +1,22 @@ +discard """ + output: '''123 +c is not nil''' +""" + +# bug #9149 + +type + Container = ref object + data: int + +converter containerToString*(x: Container): string = $x.data + +var c = Container(data: 123) +var str = string c +echo str + +if c == nil: # this line can compile on v0.18, but not on 0.19 + echo "c is nil" + +if not c.isNil: + echo "c is not nil" diff --git a/tests/parser/tprecedence.nim b/tests/parser/tprecedence.nim index aff7c6aca..3e1c03dd1 100644 --- a/tests/parser/tprecedence.nim +++ b/tests/parser/tprecedence.nim @@ -40,3 +40,12 @@ proc getX(x: MyObject): lent MyField {.inline.} = let a = MyObject() echo a.getX.b.len + + +# bug #10458 +template t(x: untyped): untyped = "x" + +let + aaa = t 2 + 4 + ccc = t (1, 1) + 6 + ddd = t [0, 1, 2] + 5 |