Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
pub
frama-c
Commits
904ea7aa
Commit
904ea7aa
authored
Dec 19, 2019
by
Michele Alberti
Browse files
[Server] Implement proposed API for get/set/exec files.
parent
bee34c79
Changes
3
Hide whitespace changes
Inline
Side-by-side
src/plugins/server/kernel_ast.ml
View file @
904ea7aa
...
...
@@ -164,3 +164,38 @@ let () = Request.register ~page
(
fun
kf
->
Jbuffer
.
to_json
PP
.
pp_global
(
Kernel_function
.
get_global
kf
))
(* -------------------------------------------------------------------------- *)
(* --- Files --- *)
(* -------------------------------------------------------------------------- *)
let
()
=
Request
.
register
~
page
~
descr
:
(
Md
.
plain
"Get the currently analyzed source file names"
)
~
kind
:
`GET
~
name
:
"kernel.ast.getFiles"
~
input
:
(
module
Junit
)
~
output
:
(
module
Jstring
.
Jlist
)
Kernel
.
Files
.
get
let
()
=
Request
.
register
~
page
~
descr
:
(
Md
.
plain
"Set the source file names to analyze."
)
~
kind
:
`SET
~
name
:
"kernel.ast.setFiles"
~
input
:
(
module
Jstring
.
Jlist
)
~
output
:
(
module
Junit
)
Kernel
.
Files
.
set
let
()
=
Request
.
register
~
page
~
descr
:
(
Md
.
plain
"Compute the AST of the currently set source file names."
)
~
kind
:
`EXEC
~
name
:
"kernel.ast.execCompute"
~
input
:
(
module
Junit
)
~
output
:
(
module
Junit
)
(
fun
()
->
if
not
(
Ast
.
is_computed
()
)
then
File
.
init_from_cmdline
()
)
(* -------------------------------------------------------------------------- *)
src/plugins/server/kernel_project.ml
View file @
904ea7aa
...
...
@@ -126,13 +126,12 @@ let () = Request.register ~page
let
()
=
Request
.
register
~
kind
:
`GET
~
page
~
name
:
"kernel.project.getSourceFileNames"
~
descr
:
(
Md
.
plain
"Get the source file names of the current project"
)
~
input
:
(
module
Junit
)
~
output
:
(
module
Jstring
.
Jlist
)
(
fun
()
->
List
.
map
(
fun
fname
->
(
Filepath
.
Normalized
.
of_string
fname
:>
string
))
(
Kernel
.
Files
.
get
()
))
~
page
~
descr
:
(
Md
.
plain
"Create a new project"
)
~
kind
:
`SET
~
name
:
"kernel.project.setCreate"
~
input
:
(
module
Jstring
)
~
output
:
(
module
ProjectInfo
)
Project
.
create
(* -------------------------------------------------------------------------- *)
src/plugins/server/main.ml
View file @
904ea7aa
...
...
@@ -147,10 +147,33 @@ let execute exec : _ response =
exec
.
request
(
Cmdline
.
protect
exn
)
;
`Error
(
exec
.
id
,
Printexc
.
to_string
exn
)
let
acceptable_between_yield
=
0
.
25
(* seconds *)
let
execute_with_yield
yield
exec
=
let
db
=
!
Db
.
progress
in
Db
.
progress
:=
if
exec
.
yield
then
yield
else
no_yield
;
Extlib
.
try_finally
~
finally
:
(
fun
()
->
Db
.
progress
:=
db
)
execute
exec
let
yield
,
check
=
if
Senv
.
debug_atleast
1
then
let
time
=
ref
(
Unix
.
gettimeofday
()
)
in
let
check
()
=
let
time'
=
Unix
.
gettimeofday
()
in
let
diff
=
time'
-.
!
time
in
if
diff
>
acceptable_between_yield
then
Senv
.
debug
"Db.progress missing during %s request (spent %fs between calls)"
exec
.
request
diff
in
(
fun
()
->
check
()
;
yield
()
;
time
:=
Unix
.
gettimeofday
()
)
,
check
else
yield
,
ignore
in
Db
.
progress
:=
if
exec
.
yield
then
yield
else
no_yield
;
Extlib
.
try_finally
~
finally
:
(
fun
()
->
Db
.
progress
:=
db
;
check
()
)
execute
exec
let
execute_debug
pp
yield
exec
=
if
Senv
.
debug_atleast
1
then
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment