The R Project SVN R

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
71390 luke 1 
library(compiler)
2 
 
3 
# This tests tracking of source file references
4 
 
5 
options(keep.source=TRUE)
6 
ln <- function() attr(sys.call(), "srcref")[1]
7 
 
8 
# NOTE: the block below is sensitive to formatting (newlines)
9 
 
10 
code <- quote({
11 
    start <- ln()
12 
    plus1 <- ln()                          # start + 1
13 
    stopifnot(identical(plus1, start+1L))
14 
    {
15 
        plus4 <- ln()                         # start + 4
16 
    }
17 
    stopifnot(identical(plus4, start+4L))
18 
    plus9 <- 0
19 
    f <- function() {
20 
        plus9 <<- ln()                       # start + 9
21 
    }
22 
    f()
23 
    stopifnot(identical(plus9, start+9L))
24 
    g <- function(x = ln()) x              # start + 13
25 
    plus13 <- g()
26 
    stopifnot(identical(plus13, start+13L))
27 
    plus16 <- g(ln())                      # start + 16
28 
    stopifnot(identical(plus16, start+13L) || identical(plus16, start+16L)) ### NOTE: see compatibility note below
29 
    for(i in 1) plus18 <- ln()             # start + 18
30 
    stopifnot(identical(plus18, start+18L))
31 
    for(i in 1) { plus20 <- ln() }         # start + 20
32 
    stopifnot(identical(plus20, start+20L))
33 
    for(i in 1) {
34 
        plus23 <- ln()                       # start + 23
35 
    }
36 
    stopifnot(identical(plus23, start+23L))
37 
    ff <- function() for(i in 1) return(ln()) # start + 26
38 
    plus26 <- ff()
39 
    stopifnot(identical(plus26, start+26L))
40 
    ff1 <- function() {
41 
        for(i in 1) return(ln())             # start + 30
42 
    }
43 
    plus30 <- ff1()
44 
    stopifnot(identical(plus30, start+30L))
45 
})
46 
 
47 
## Compatibility note
48 
##
49 
## in the example above, "plus16" with the AST interpreter gets line number
50 
## start+13, but with the compiler, it gets start+16.  The latter seems to
51 
## be more correct, as line start+16 is where the spelling of "ln()" is.
52 
 
53 
oldoptimize <- getCompilerOption("optimize")
54 
oldjit <- enableJIT(0)
55 
 
56 
l <- function() 1
57 
body(l) <- code
58 
 
59 
for(jit in 0:2) {
60 
    enableJIT(jit)
61 
    for (opt in 0:3) {
62 
        if (opt >=2 || jit <=2) {
63 
            setCompilerOptions(optimize=opt)
64 
            eval(code)
65 
            eval(compile(code))
66 
            body(l) <- code
67 
            l()
68 
            body(l) <- code
69 
            cmpfun(l)()
70 
            local(eval(code))
71 
            do.call("local", list(code))
72 
        }
73 
    }
74 
}
75 
 
76 
setCompilerOptions(optimize = oldoptimize)
77 
enableJIT(oldjit)