diff --git a/.github/workflows/build-and-test.yml b/.github/workflows/build-and-test.yml index 9fb851071..22fc75081 100644 --- a/.github/workflows/build-and-test.yml +++ b/.github/workflows/build-and-test.yml @@ -21,12 +21,14 @@ jobs: uses: actions/checkout@v3 - name: Build Docker images run: "make docker-images" + - name: Fix permissions + run: "chmod -R a+wX demo-repository" - name: Run learn-ocaml build on demo-repository run: "docker run --rm -v $(pwd)/demo-repository:/repository learn-ocaml -- build" - name: Clone learn-ocaml-corpus inside tests/corpuses - run: "mkdir tests/corpuses && cd tests/corpuses && git clone --depth=1 https://github.com/ocaml-sf/learn-ocaml-corpus.git && cd ../.." + run: "git clone --depth=1 https://github.com/ocaml-sf/learn-ocaml-corpus.git tests/corpuses/learn-ocaml-corpus" - name: Run tests - run: "cd tests && bash -c ./runtests.sh" + run: "tests/runtests.sh" client_using_other_server: name: Build learn-ocaml-client and run quick tests @@ -36,8 +38,8 @@ jobs: fail-fast: false matrix: server_image: - - 'ocamlsf/learn-ocaml:0.12' - - 'ocamlsf/learn-ocaml:0.13.0' + # - 'ocamlsf/learn-ocaml:0.12' + # - 'ocamlsf/learn-ocaml:0.13.0' - 'learn-ocaml' # use learn-ocaml image built from master env: USE_CLIENT_IMAGE: 'true' diff --git a/.gitignore b/.gitignore index ad564485a..b18739c8c 100644 --- a/.gitignore +++ b/.gitignore @@ -35,3 +35,8 @@ tests/corpuses/* detect-libs.* docs/odoc.html + +demo-repository/exercises/**/*.cmo +demo-repository/exercises/**/*.cmi +demo-repository/exercises/**/*.cma +demo-repository/exercises/**/*.js diff --git a/Dockerfile b/Dockerfile index 4b1c13d5d..126d0b2c1 100644 --- a/Dockerfile +++ b/Dockerfile @@ -66,6 +66,18 @@ ARG opam_switch="/home/opam/.opam/4.12" COPY --from=compilation /home/opam/install-prefix /usr COPY --from=compilation "$opam_switch/bin"/ocaml* "$opam_switch/bin/" COPY --from=compilation "$opam_switch/lib/ocaml" "$opam_switch/lib/ocaml/" +COPY --from=compilation "$opam_switch/bin/js_of_ocaml" "$opam_switch/bin/" +COPY --from=compilation "$opam_switch/lib/js_of_ocaml" "$opam_switch/lib/js_of_ocaml" +COPY --from=compilation "$opam_switch/lib/vg" "$opam_switch/lib/vg" +COPY --from=compilation "$opam_switch/lib/gg" "$opam_switch/lib/gg" + +# Fixes for ocamlfind +COPY --from=compilation "$opam_switch/lib/findlib.conf" "$opam_switch/lib/" +COPY --from=compilation "$opam_switch/lib/stdlib" "$opam_switch/lib/stdlib" +ENV PATH="${opam_switch}/bin:${PATH}" +ENV OCAMLPATH="/usr/lib" +RUN ln -sf "$opam_switch/lib/vg" "/usr/lib" +RUN ln -sf "$opam_switch/lib/gg" "/usr/lib" ENTRYPOINT ["dumb-init","/usr/bin/learn-ocaml","--sync-dir=/sync","--repo=/repository"] CMD ["build","serve"] diff --git a/META.learn-ocaml.template b/META.learn-ocaml.template new file mode 100644 index 000000000..73be50fbb --- /dev/null +++ b/META.learn-ocaml.template @@ -0,0 +1,7 @@ +package "test_lib" ( + directory = "test_lib" + version = "0.13.2" + description = "Learn-ocaml dependencies for automatic graders" + requires = "compiler-libs" +) +# DUNE_GEN diff --git a/Makefile b/Makefile index 0afbb6028..6d0c8c87a 100644 --- a/Makefile +++ b/Makefile @@ -70,7 +70,7 @@ REPO ?= demo-repository testrun: build install rm -rf www/css - learn-ocaml build --repo $(REPO) -j1 + learn-ocaml build --repo $(REPO) rm -rf www/css ln -s ../static/css www LEARNOCAML_SERVER_NOCACHE=1 learn-ocaml serve @@ -82,7 +82,7 @@ docker-images: Dockerfile learn-ocaml.opam @docker build -t learn-ocaml-compilation --target compilation docker @docker build -t learn-ocaml --target program docker @docker build -t learn-ocaml-client --target client docker - @echo "Use with 'docker run --rm -v \$$PWD/sync:/sync -v \$$PWD:/repository -p PORT:8080 learn-ocaml -- ARGS'" + @echo "Use with 'docker run --rm -v learn-ocaml-sync:/sync -v \$$PWD:/repository -p PORT:8080 learn-ocaml -- ARGS'" VERSION = $(shell opam show ./learn-ocaml.opam -f version) diff --git a/README.md b/README.md index babacbb3b..b2ee64025 100644 --- a/README.md +++ b/README.md @@ -53,7 +53,7 @@ The Inconsolata font is released under the Open Font License. See [http://www.levien.com/type/myfonts/inconsolata.html](http://www.levien.com/type/myfonts/inconsolata.html). The Biolinum font is licensed under the GNU General Public License with -a the 'Font-Exception'. +a 'Font-Exception'. See [http://www.linuxlibertine.org](http://www.linuxlibertine.org). The public instance of Learn OCaml uses the Fontin font instead of @@ -78,9 +78,9 @@ It was written by OCamlPro from 2015 to 2018. The current main contributors are Érik Martin-Dorel, Yann Régis-Gianas, and Louis Gesbert. -The initial authors were Benjamin Canou, Çağdaş Bozman, and Grégoire Henry. +The initial authors were Benjamin Canou, Çağdaş Bozman, Grégoire Henry, and Louis Gesbert. -It builds on the previous experience of Try OCaml, by Çağdaş Bozman, and Fabrice Le Fessant. +It builds on the previous experience of Try OCaml, by Çağdaş Bozman and Fabrice Le Fessant. We heavily use js_of_ocaml, so thanks to the Ocsigen team. diff --git a/demo-repository/exercises/demo/test_libs.txt b/demo-repository/exercises/demo/test_libs.txt new file mode 100644 index 000000000..6a71efd37 --- /dev/null +++ b/demo-repository/exercises/demo/test_libs.txt @@ -0,0 +1 @@ +learn-ocaml.mutation_testing diff --git a/docs/exercises_format.md b/docs/exercises_format.md index 4eded44e3..ca01cab5e 100644 --- a/docs/exercises_format.md +++ b/docs/exercises_format.md @@ -54,6 +54,30 @@ An exercise is described by a directory containing at most the following files: - solution.ml - test.ml - max_score.txt +- test_libs.txt + +> Note: as of learn-ocaml 1.0, the `.ml` files get compiled into the exercise. +> It is therefore not possible to use directives like `#install_printer`. +> However, you can still define your own printers in a way similar to defining +> custom `sample_` functions: +> +> ```ocaml +> (* Custom printer for a pre-defined type *) +> let print_float ppf x = Format.fprintf ppf "%.2f" x +> +> (* Name the alias to define a printer for a specific instanciation of a +> generic type *) +> type int_list = int list +> let print_int_list ppf l = ... +> +> (* Define a generic printer for a generic type *) +> let print_result ppok pperr ppf = function +> | Ok ok -> Format.fprintf ppf "OK(%a)" ppok ok +> | Error err -> Format.fprintf ppf "ERR(%a)" pperr err +> ``` +> +> Printers defined in `prelude.ml` or `prepare.ml` affect the toplevel and the +> grader. Printers defined in `test.ml`, obviously, affect only the grader. ### meta.json @@ -130,6 +154,12 @@ code, which will be described and detailed in another section. Maximum score that is possible to get for this exercise, even if the grader grades more. Overridden by the field `max_score`, if present in `meta.json`. +### test_libs.txt + +List of additional libraries (one per line) to be used by the grader. The +libraries will be looked up using `ocamlfind`, available to `test.ml` during its +compilation, and bundled in the exercise grader. + # Metadata When building the corpus and extracting the metadatas of all exercises, the diff --git a/docs/exercises_tests.md b/docs/exercises_tests.md index 0ea7c8337..69e6afa19 100644 --- a/docs/exercises_tests.md +++ b/docs/exercises_tests.md @@ -20,23 +20,23 @@ A classic `test.ml` file is as follows: open Test_lib open Report -let exercise_1 = .. +let exercise_1 () = .. -let exercise_2 = .. +let exercise_2 () = .. -let exercise_3 = .. +let exercise_3 () = .. let () = set_result @@ ast_sanity_check code_ast @@ fun () -> - [ exercise_1 ; exercise_2 ; exercise_3 ] + [ exercise_1 (); exercise_2 (); exercise_3 () ] ``` -The values `exercise_x` are values of type `Learnocaml_report.report`, which is +The return values of `exercise_x` are of type `Learnocaml_report.report`, which is a representation of the report given by the grader. In this example, each of -these values are referring to a specific question from the exercise. Their +these values is referring to a specific question from the exercise. Their content is detailed in the next section. These reports are then given to the function `ast_sanity_check`, which ensures that some modules are never used (`Obj`, `Marshall`, all the modules from `compiler-libs` or the library that @@ -46,7 +46,7 @@ allows introspection), and also excludes some syntactic features of the language # Writing tests and reports -The format of reports can be found in `src/state/learnocaml_report.ml`. A report +The format of reports can be found in `src/grader/learnocaml_report.ml`. A report describes the result of what should be outputted and interpreted by the grader. It can be classified into sections for lisibility, and return many kind of messages: @@ -252,3 +252,23 @@ forbidden or required. The two functions `ast_check_expr` and pattern-matching on some specific patterns into the code. The function `find_binding` look for a toplevel value and apply a given function on its syntax tree. + +### Using helper libraries for testing + +Using a `test_libs.txt` file, it is possible to include libraries that define +helpers for grading. + +The file should contain the ocamlfind names of the libraries, one per line. + +Example of such libs include +[mutation_testing](https://github.com/ocaml-sf/learn-ocaml/blob/master/src/grader-plugins/mutation_test.ml) +(from McGill University, included in this repository), or +[easy-check](https://github.com/lsylvestre/easy-check) from University Paris 6. + +See `src/grader-plugins/dune` to get how to build such libraries. Like +`test.ml`, they can access the `Introspection` and `Test_lib` interfaces. They +cannot, at the time of writing, define new samplers or printers, but if you need +that feature and are ready to contribute, all that is missing is the inclusion +of their `cmi` files in the grading-toplevel environment (these features rely +on dynamic typing, and the `cma` library doesn't include the required typing +information). diff --git a/docs/howto-setup-exercise-development-environment.md b/docs/howto-setup-exercise-development-environment.md index d591abf8a..6893a8ddd 100644 --- a/docs/howto-setup-exercise-development-environment.md +++ b/docs/howto-setup-exercise-development-environment.md @@ -12,7 +12,6 @@ GNU/Linux and MacOS X are supported. > use: > > docker version # If this fails, find out how to run Docker, first -> docker login > docker run --rm \ > -v $REPOSITORY:/repository:ro \ > -v learn-ocaml-sync:/sync \ @@ -63,7 +62,6 @@ ready: ``` opam switch create . --deps-only --locked -opam install opam-installer eval $(opam env) ``` @@ -74,7 +72,7 @@ your current opam switch, without creating a dedicated one.) Second, compile and install the platform: ``` -make && make opaminstall +make && make install ``` At this point, you should get a working `learn-ocaml` program in diff --git a/docs/howto-write-exercises.md b/docs/howto-write-exercises.md index a61200a85..1ccc42435 100644 --- a/docs/howto-write-exercises.md +++ b/docs/howto-write-exercises.md @@ -65,9 +65,3 @@ get the files for the second step, and so on and so forth. [Step 6 : Grading functions for variables](tutorials/step-6.md) [Step 7 : Modifying the comparison functions (testers) with the optional arguments [~test], [~test_stdout], [~test_stderr]](tutorials/step-7.md) - -[Step 8 : Reusing the grader code](tutorials/step-8.md) - -- Separating the grader code - -[Step 9 : Introspection of students code](tutorials/step-9.md) diff --git a/docs/index.md b/docs/index.md index 312a281aa..652928f29 100644 --- a/docs/index.md +++ b/docs/index.md @@ -53,7 +53,7 @@ The Inconsolata font is released under the Open Font License. See [http://www.levien.com/type/myfonts/inconsolata.html](http://www.levien.com/type/myfonts/inconsolata.html). The Biolinum font is licensed under the GNU General Public License with -a the 'Font-Exception'. +a 'Font-Exception'. See [http://www.linuxlibertine.org](http://www.linuxlibertine.org). The public instance of Learn OCaml uses the Fontin font instead of @@ -78,9 +78,9 @@ It was written by OCamlPro from 2015 to 2018. The current main contributors are Érik Martin-Dorel, Yann Régis-Gianas, and Louis Gesbert. -The initial authors were Benjamin Canou, Çağdaş Bozman, and Grégoire Henry. +The initial authors were Benjamin Canou, Çağdaş Bozman, Grégoire Henry, and Louis Gesbert. -It builds on the previous experience of Try OCaml, by Çağdaş Bozman, and Fabrice Le Fessant. +It builds on the previous experience of Try OCaml, by Çağdaş Bozman and Fabrice Le Fessant. We heavily use js_of_ocaml, so thanks to the Ocsigen team. diff --git a/docs/tutorials/step-0.md b/docs/tutorials/step-0.md index a56304157..4fbeabb6f 100644 --- a/docs/tutorials/step-0.md +++ b/docs/tutorials/step-0.md @@ -13,7 +13,8 @@ specific shape, illustrated by the following ascii art: │   │   ├── prepare.ml │   │   ├── solution.ml │   │   ├── template.ml -│   │   └── test.ml +│   │   ├── test.ml +│   │   └── test_libs.txt │   ├── exercise2 │   │   ├── ... │   ├── index.json @@ -68,6 +69,8 @@ The complete format specification for exercise description is given in - `test.ml` is the grader code. + - `test_libs.txt` optionally lists grader-helper libraries used by `test.ml` + - `lessons` and `tutorials` are ignored in this tutorial. ## Do it yourself! diff --git a/docs/tutorials/step-8.md b/docs/tutorials/step-8.md deleted file mode 100644 index 1b26ab136..000000000 --- a/docs/tutorials/step-8.md +++ /dev/null @@ -1,199 +0,0 @@ -# Step 8: Reusing the grader code - -This step explains how to separate the grader code, and eventually reuse it in -other exercises. - -During the grading, the file **test.ml** is evaluated in an environment that -contains notably: -- **prelude.ml** and **prepare.ml** ; -- the student code isolated in a module `Code` ; -- **solution.ml** in a module `Solution` ; -- the grading modules **Introspection**, **Report** and **Test_lib**. - -### Separating the grader code - -It is possible to extend this environment by declaring some other user-defined -modules in an optional file **depend.txt**, located in the exercise directory. - -Each declaration in **depend.txt** is a single line containing the relative path -of an *.ml* or *.mli* file. The order of the *.ml* declarations specifies the -order in which each module is loaded in the grading environment. - -By default each dependency *foo.ml* is isolated in a module *Foo*, which can be -constrained by the content of an optional signature file *foo.mli*. Furthermore, -an annotation `[@@@included]` can be used at the beginning of a file *foo.ml* to -denote that all the bindings of *foo.ml* are evaluated in the toplevel -environment (and not in a module *Foo*). - -Dependencies that are not defined at the root of the exercise repository are -ignored by the build system: therefore, if you modify them, do not forget to -refresh the timestamp of `test.ml` (using `touch` for instance). - -### A complete example - -Let's write an exercise dedicated to *Peano numbers*. Here is the structure of -the exercise: - -``` -. -├── exercises -│ ├── index.json -│ └── lib -│ │ ├── check.ml -│ │ └── check.mli -│ ├── peano -│ │ ├── depend.txt -│ │ ├── descr.md -│ │ ├── meta.json -│ │ ├── prelude.ml -│ │ ├── prepare.ml -│ │ ├── solution.ml -│ │ ├── template.ml -│ │ ├── test.ml -│ │ └── tests -│ │ ├── samples.ml -│ │ ├── add.ml -│ │ └── odd_even.ml -│ ├── an-other-exercise -│ │ ├── depend.txt -│ │ │ ... -``` - -The exercise **peano** follows the classical format : **prelude.ml**, -**prepare.ml**, **solution.ml**, **template.ml** and **test.ml**. -It also includes several dependencies (**check.ml**, **samples.ml**, **add.ml** -and **odd_even.ml**) which are declared as follows in **depend.txt**: - -```txt -../lib/check.mli -../lib/check.ml # a comment - -tests/samples.ml -tests/add.ml -tests/odd_even.ml -``` - -Here is in details the source code of the exercise : - -- **descr.md**: - > * implement the function `add : peano -> peano -> peano` ; - > * implement the functions `odd : peano -> bool` and `even : peano -> bool`. - -- **prelude.ml**: - ```ocaml - type peano = Z | S of peano - ``` - -- **solution.ml**: - ```ocaml - let rec add n = function - | Z -> n - | S m -> S (add n m) - - let rec odd = function - | Z -> false - | S n -> even n - and even = function - | Z -> true - | S n -> odd n - ``` - -- **test.ml**: - ```ocaml - let () = - Check.safe_set_result [ Add.test ; Odd_even.test ] - ``` - -Note that **test.ml** is very compact because it simply combines functions -defined in separated files. - -- **../lib/check.ml**: - ```ocaml - open Test_lib - open Report - - let safe_set_result tests = - set_result @@ - ast_sanity_check code_ast @@ fun () -> - List.mapi (fun i test -> - Section ([ Text ("Question " ^ string_of_int i ^ ":") ], - test ())) tests - ``` - -- **../lib/check.mli**: - ```ocaml - val safe_set_result : (unit -> Report.t) list -> unit - ``` - -- **tests/add.ml**: - ```ocaml - let test () = - Test_lib.test_function_2_against_solution - [%ty : peano -> peano -> peano ] "add" - [ (Z, Z) ; (S(Z), S(S(Z))) ] - ``` - -- **tests/odd_even.ml**: - ```ocaml - let test () = - Test_lib.test_function_1_against_solution - [%ty : peano -> bool ] "odd" - [ Z ; S(Z) ; S(S(Z)) ] - @ - Test_lib.test_function_1_against_solution - [%ty : peano -> bool ] "even" - [ Z ; S(Z) ; S(S(Z)) ] - ``` - -Remember that **Test_lib** internally requires a user-defined sampler -`sample_peano : unit -> peano` to generate value of type `peano`. This sampler -has to be present in the toplevel environment -- and not in a module -- in order -to be found by the introspection primitives during grading. Therefore, -we define this sampler in a file starting with the annotation `[@@@included]`. - -- **tests/samples.ml**: - ```ocaml - [@@@included] - - let sample_peano () = - let rec aux = function - | 0 -> Z - | n -> S (aux (n-1)) - in aux (Random.int 42) - ``` - -Finally, the content of **test.ml** will be evaluated in the following -environment: - -```ocaml -val print_html : 'a -> 'b - -type peano = Z | S of peano - -module Code : sig - val add : peano -> peano -> peano - val odd : peano -> bool - val even : peano -> bool -end - -module Solution : sig - val add : peano -> peano -> peano - val odd : peano -> bool - val even : peano -> bool -end - -module Test_lib : Test_lib.S - -module Report = Learnocaml_report - -module Check : sig val check_all : (unit -> Report.t) list -> unit end - -val sample_peano : unit -> peano - -module Add : sig val test : unit -> Report.t end - -module Odd_even : sig val test : unit -> Report.t end -``` - -In the end, this feature can provide an increased comfort for writing large -automated graders and for reusing them in other exercises. diff --git a/docs/tutorials/step-9.md b/docs/tutorials/step-9.md deleted file mode 100644 index 2c51e3db0..000000000 --- a/docs/tutorials/step-9.md +++ /dev/null @@ -1,3 +0,0 @@ -# Step 9: Introspection of students code - -This document explains how to do an introspection of students code. diff --git a/dune b/dune index cacc11a85..39cdae163 100644 --- a/dune +++ b/dune @@ -7,7 +7,7 @@ ) (env - (release (flags -safe-string -w +a-4-42-44-45-48-3-58) + (release (flags -safe-string -w +a-4-42-44-45-48-3-58-32-33) (ocamlc_flags) (ocamlopt_flags)) ) diff --git a/dune-project b/dune-project index fbcc6d71b..9b0bd8e86 100644 --- a/dune-project +++ b/dune-project @@ -1,4 +1,4 @@ -(lang dune 2.3) +(lang dune 2.4) (name learn-ocaml) (version 0.16.0) (allow_approximate_merlin) diff --git a/learn-ocaml-client.opam b/learn-ocaml-client.opam index 4e67d4605..2ee63112e 100644 --- a/learn-ocaml-client.opam +++ b/learn-ocaml-client.opam @@ -18,7 +18,7 @@ homepage: "https://github.com/ocaml-sf/learn-ocaml" bug-reports: "https://github.com/ocaml-sf/learn-ocaml/issues" dev-repo: "git+https://github.com/ocaml-sf/learn-ocaml" depends: [ - "asak" {< "0.4"} + "asak" {>= "0.4"} "base64" "base" {>= "v0.9.4"} "cmdliner" {>= "1.1.0"} diff --git a/learn-ocaml-client.opam.locked b/learn-ocaml-client.opam.locked index 725f5ffb6..536f861b1 100644 --- a/learn-ocaml-client.opam.locked +++ b/learn-ocaml-client.opam.locked @@ -22,18 +22,17 @@ homepage: "https://github.com/ocaml-sf/learn-ocaml" bug-reports: "https://github.com/ocaml-sf/learn-ocaml/issues" depends: [ "angstrom" {= "0.15.0"} - "asak" {= "0.3"} + "asak" {= "0.4"} "astring" {= "0.8.5"} - "base" {= "v0.14.1"} + "base" {= "v0.14.3"} "base-bigarray" {= "base"} "base-bytes" {= "base"} "base-threads" {= "base"} "base-unix" {= "base"} "base64" {= "3.5.0"} - "bigarray-compat" {= "1.0.0"} + "bigarray-compat" {= "1.1.0"} "bigstringaf" {= "0.8.0"} - "biniou" {= "1.2.1"} - "cmdliner" {= "1.1.1"} + "cmdliner" {= "1.1.0"} "cohttp" {= "4.0.0"} "cohttp-lwt" {= "4.0.0"} "cohttp-lwt-unix" {= "4.0.0"} @@ -42,51 +41,50 @@ depends: [ "conduit-lwt-unix" {= "1.3.0"} "conf-libssl" {= "3"} "conf-pkg-config" {= "2"} - "cppo" {= "1.6.7"} + "cppo" {= "1.6.8"} "csexp" {= "1.5.1"} - "cstruct" {= "5.0.0"} - "digestif" {= "1.0.0"} - "dune" {= "2.9.0"} - "dune-configurator" {= "2.9.0"} - "easy-format" {= "1.3.2"} - "eqaf" {= "0.7"} - "ezjsonm" {= "1.1.0"} + "cstruct" {= "5.2.0"} + "digestif" {= "1.1.0"} + "dune" {= "2.9.3"} + "dune-configurator" {= "2.9.3"} + "eqaf" {= "0.8"} + "ezjsonm" {= "1.3.0"} "fieldslib" {= "v0.14.0"} - "fmt" {= "0.8.9"} + "fmt" {= "0.9.0"} "gg" {= "0.9.3"} "hex" {= "1.4.0"} "ipaddr" {= "2.9.0"} "jane-street-headers" {= "v0.14.0"} - "js_of_ocaml" {= "3.9.0"} - "js_of_ocaml-compiler" {= "3.9.1"} - "js_of_ocaml-ppx" {= "3.9.0"} + "js_of_ocaml" {= "4.0.0"} + "js_of_ocaml-compiler" {= "4.0.0"} + "js_of_ocaml-ppx" {= "4.0.0"} "jsonm" {= "1.0.1"} "jst-config" {= "v0.14.1"} "logs" {= "0.7.0"} - "lwt" {= "5.4.1"} + "lwt" {= "5.5.0"} "lwt_ssl" {= "1.1.3"} - "magic-mime" {= "1.1.3"} - "menhir" {= "20210419"} - "menhirLib" {= "20210419"} - "menhirSdk" {= "20210419"} + "magic-mime" {= "1.2.0"} + "menhir" {= "20220210"} + "menhirLib" {= "20220210"} + "menhirSdk" {= "20220210"} "mmap" {= "1.1.0"} "num" {= "1.4"} "ocaml" {= "4.12.1"} - "ocaml-compiler-libs" {= "v0.12.3"} + "ocaml-compiler-libs" {= "v0.12.4"} "ocaml-config" {= "2"} "ocaml-migrate-parsetree" {= "1.8.0"} "ocaml-options-vanilla" {= "1"} "ocaml-syntax-shims" {= "1.0.0"} - "ocamlbuild" {= "0.14.0"} - "ocamlfind" {= "1.9.1"} + "ocamlbuild" {= "0.14.1"} + "ocamlfind" {= "1.9.3"} "ocp-indent-nlfork" {= "1.5.4"} "ocp-ocamlres" {= "0.4"} - "ocplib-endian" {= "1.1"} + "ocplib-endian" {= "1.2"} "ocplib-json-typed" {= "0.7.1"} "octavius" {= "1.2.2"} "omd" {= "1.3.1"} - "parsexp" {= "v0.14.1"} - "pprint" {= "20200410"} + "parsexp" {= "v0.14.2"} + "pprint" {= "20220103"} "ppx_assert" {= "v0.14.0"} "ppx_base" {= "v0.14.0"} "ppx_cold" {= "v0.14.0"} @@ -101,11 +99,11 @@ depends: [ "ppx_js_style" {= "v0.14.1"} "ppx_optcomp" {= "v0.14.0"} "ppx_sexp_conv" {= "v0.14.1"} - "ppx_tools" {= "6.3"} + "ppx_tools" {= "6.4"} "ppxlib" {= "0.15.0"} - "re" {= "1.9.0"} + "re" {= "1.10.3"} "result" {= "1.5"} - "seq" {= "0.2.2"} + "seq" {= "base"} "sexplib" {= "v0.14.0"} "sexplib0" {= "v0.14.0"} "ssl" {= "0.5.12"} @@ -113,13 +111,13 @@ depends: [ "stdlib-shims" {= "0.3.0"} "stringext" {= "1.6.0"} "time_now" {= "v0.14.0"} - "topkg" {= "1.0.3"} + "topkg" {= "1.0.5"} "uchar" {= "0.0.2"} "uri" {= "4.2.0"} "uri-sexp" {= "4.2.0"} - "uutf" {= "1.0.2"} + "uutf" {= "1.0.3"} "vg" {= "0.9.4"} - "yojson" {= "1.7.0"} + "yojson" {= "2.1.0"} ] build: ["dune" "build" "@install" "-p" name "-j" jobs] dev-repo: "git+https://github.com/ocaml-sf/learn-ocaml" diff --git a/learn-ocaml.opam b/learn-ocaml.opam index c43a9a695..01d9d8041 100644 --- a/learn-ocaml.opam +++ b/learn-ocaml.opam @@ -18,7 +18,7 @@ homepage: "https://github.com/ocaml-sf/learn-ocaml" bug-reports: "https://github.com/ocaml-sf/learn-ocaml/issues" dev-repo: "git+https://github.com/ocaml-sf/learn-ocaml" depends: [ - "asak" {< "0.4"} + "asak" { >= "0.4"} "base64" "base" {>= "v0.9.4"} "cmdliner" {>= "1.1.0"} diff --git a/learn-ocaml.opam.locked b/learn-ocaml.opam.locked index 5f05b1be7..6fb43cd0d 100644 --- a/learn-ocaml.opam.locked +++ b/learn-ocaml.opam.locked @@ -19,89 +19,89 @@ bug-reports: "https://github.com/ocaml-sf/learn-ocaml/issues" dev-repo: "git+https://github.com/ocaml-sf/learn-ocaml" depends: [ "angstrom" {= "0.15.0"} - "asak" {= "0.3"} + "asak" {= "0.4"} "astring" {= "0.8.5"} - "base" {= "v0.14.1"} + "base" {= "v0.14.3"} "base-bigarray" {= "base"} "base-bytes" {= "base"} "base-threads" {= "base"} "base-unix" {= "base"} "base64" {= "3.5.0"} - "bigarray-compat" {= "1.0.0"} + "bigarray-compat" {= "1.1.0"} "bigstringaf" {= "0.8.0"} - "biniou" {= "1.2.1"} - "checkseum" {= "0.3.1"} - "cmdliner" {= "1.1.1"} + "checkseum" {= "0.3.2"} + "cmdliner" {= "1.1.0"} "cohttp" {= "4.0.0"} "cohttp-lwt" {= "4.0.0"} "cohttp-lwt-unix" {= "4.0.0"} "conduit" {= "1.3.0"} "conduit-lwt" {= "1.3.0"} "conduit-lwt-unix" {= "1.3.0"} - "conf-git" {= "1.0"} + "conf-git" {= "1.1"} "conf-libssl" {= "3"} "conf-pkg-config" {= "2"} - "conf-which" {= "1"} - "cppo" {= "1.6.7"} + "cppo" {= "1.6.8"} "csexp" {= "1.5.1"} - "cstruct" {= "5.0.0"} + "cstruct" {= "5.2.0"} "decompress" {= "0.8.1"} - "digestif" {= "1.0.0"} - "dune" {= "2.9.0"} - "dune-configurator" {= "2.9.0"} + "digestif" {= "1.1.0"} + "dune" {= "2.9.3"} + "dune-configurator" {= "2.9.3"} "easy-format" {= "1.3.2"} - "eqaf" {= "0.7"} - "ezjsonm" {= "1.1.0"} - "fmt" {= "0.8.9"} + "eqaf" {= "0.8"} + "ezjsonm" {= "1.3.0"} + "fmt" {= "0.9.0"} "fpath" {= "0.7.3"} "gg" {= "0.9.3"} "hex" {= "1.4.0"} "ipaddr" {= "2.9.0"} "jane-street-headers" {= "v0.14.0"} - "js_of_ocaml" {= "3.9.0"} - "js_of_ocaml-compiler" {= "3.9.1"} - "js_of_ocaml-lwt" {= "3.9.0"} - "js_of_ocaml-ppx" {= "3.9.0"} - "js_of_ocaml-toplevel" {= "3.9.0"} - "js_of_ocaml-tyxml" {= "3.9.0"} + "js_of_ocaml" {= "4.0.0"} + "js_of_ocaml-compiler" {= "4.0.0"} + "js_of_ocaml-lwt" {= "4.0.0"} + "js_of_ocaml-ppx" {= "4.0.0"} + "js_of_ocaml-toplevel" {= "4.0.0"} + "js_of_ocaml-tyxml" {= "4.0.0"} "jsonm" {= "1.0.1"} "jst-config" {= "v0.14.1"} "logs" {= "0.7.0"} - "lwt" {= "5.4.1"} - "lwt_react" {= "1.1.4"} + "lwt" {= "5.5.0"} + "lwt_log" {= "1.1.1"} + "lwt_react" {= "1.1.5"} "lwt_ssl" {= "1.1.3"} - "magic-mime" {= "1.1.3"} - "markup" {= "0.8.2"} + "magic-mime" {= "1.2.0"} + "markup" {= "1.0.2"} "markup-lwt" {= "0.5.0"} - "menhir" {= "20210419"} - "menhirLib" {= "20210419"} - "menhirSdk" {= "20210419"} + "menhir" {= "20220210"} + "menhirLib" {= "20220210"} + "menhirSdk" {= "20220210"} "mmap" {= "1.1.0"} "num" {= "1.4"} "ocaml" {= "4.12.1"} - "ocaml-compiler-libs" {= "v0.12.3"} + "ocaml-compiler-libs" {= "v0.12.4"} "ocaml-config" {= "2"} "ocaml-migrate-parsetree" {= "1.8.0"} "ocaml-options-vanilla" {= "1"} "ocaml-syntax-shims" {= "1.0.0"} - "ocamlbuild" {= "0.14.0"} - "ocamlfind" {= "1.9.1"} + "ocamlbuild" {= "0.14.1"} + "ocamlfind" {= "1.9.3"} "ocp-indent-nlfork" {= "1.5.4"} "ocp-ocamlres" {= "0.4"} - "ocplib-endian" {= "1.1"} + "ocplib-endian" {= "1.2"} "ocplib-json-typed" {= "0.7.1"} "ocplib-json-typed-browser" {= "0.7.1"} "octavius" {= "1.2.2"} - "odoc" {= "1.5.3"} + "odoc" {= "2.1.0"} + "odoc-parser" {= "1.0.0"} "omd" {= "1.3.1"} "optint" {= "0.1.0"} - "parsexp" {= "v0.14.1"} - "pprint" {= "20200410"} + "parsexp" {= "v0.14.2"} + "pprint" {= "20220103"} "ppx_assert" {= "v0.14.0"} "ppx_base" {= "v0.14.0"} "ppx_cold" {= "v0.14.0"} "ppx_compare" {= "v0.14.0"} - "ppx_cstruct" {= "5.0.0"} + "ppx_cstruct" {= "5.2.0"} "ppx_derivers" {= "1.2.1"} "ppx_enumerate" {= "v0.14.0"} "ppx_expect" {= "v0.14.0"} @@ -111,14 +111,14 @@ depends: [ "ppx_js_style" {= "v0.14.1"} "ppx_optcomp" {= "v0.14.0"} "ppx_sexp_conv" {= "v0.14.1"} - "ppx_tools" {= "6.3"} + "ppx_tools" {= "6.4"} "ppx_tools_versioned" {= "5.4.0"} "ppxlib" {= "0.15.0"} - "re" {= "1.9.0"} - "react" {= "1.2.1"} - "reactiveData" {= "0.2.1"} + "re" {= "1.10.3"} + "react" {= "1.2.2"} + "reactiveData" {= "0.2.2"} "result" {= "1.5"} - "seq" {= "0.2.2"} + "seq" {= "base"} "sexplib" {= "v0.14.0"} "sexplib0" {= "v0.14.0"} "ssl" {= "0.5.12"} @@ -126,14 +126,14 @@ depends: [ "stdlib-shims" {= "0.3.0"} "stringext" {= "1.6.0"} "time_now" {= "v0.14.0"} - "topkg" {= "1.0.3"} - "tyxml" {= "4.4.0"} + "topkg" {= "1.0.5"} + "tyxml" {= "4.5.0"} "uchar" {= "0.0.2"} "uri" {= "4.2.0"} "uri-sexp" {= "4.2.0"} - "uutf" {= "1.0.2"} + "uutf" {= "1.0.3"} "vg" {= "0.9.4"} - "yojson" {= "1.7.0"} + "yojson" {= "2.1.0"} ] build: [ [make "static"] diff --git a/src/ace-lib/ace.ml b/src/ace-lib/ace.ml index 00da23396..d971e475a 100644 --- a/src/ace-lib/ace.ml +++ b/src/ace-lib/ace.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019-2022 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/ace-lib/ocaml_mode.ml b/src/ace-lib/ocaml_mode.ml index b3cca0fda..a2b962d65 100644 --- a/src/ace-lib/ocaml_mode.ml +++ b/src/ace-lib/ocaml_mode.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/app/learnocaml_common.ml b/src/app/learnocaml_common.ml index e36fcac4b..a5a12d2d6 100644 --- a/src/app/learnocaml_common.ml +++ b/src/app/learnocaml_common.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019-2022 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/app/learnocaml_description_main.ml b/src/app/learnocaml_description_main.ml index 6484d9f2a..e215555be 100644 --- a/src/app/learnocaml_description_main.ml +++ b/src/app/learnocaml_description_main.ml @@ -1,3 +1,10 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2022-2023 OCaml Software Foundation. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + open Js_of_ocaml open Js_of_ocaml_tyxml open Js_utils @@ -66,12 +73,12 @@ let () = match get_encoded_token () with | Some { arg_name = _; raw_arg = _; token } -> begin let exercise_fetch = - retrieve (Learnocaml_api.Exercise (Some token, id)) + retrieve (Learnocaml_api.Exercise (Some token, id, true)) in init_tabs (); exercise_fetch >>= fun (ex_meta, exo, _deadline) -> (* display exercise questions and prelude *) - setup_tab_text_prelude_pane Learnocaml_exercise.(decipher File.prelude exo); + setup_tab_text_prelude_pane Learnocaml_exercise.(decipher File.prelude_ml exo); let text_iframe = Dom_html.createIframe Dom_html.document in Manip.replaceChildren title_container Tyxml_js.Html5.[ h1 [ txt ex_meta.title] ]; diff --git a/src/app/learnocaml_exercise_main.ml b/src/app/learnocaml_exercise_main.ml index ad4187c39..0ac7d113d 100644 --- a/src/app/learnocaml_exercise_main.ml +++ b/src/app/learnocaml_exercise_main.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019-2022 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -119,20 +119,29 @@ let () = Js.string (id ^ " - " ^ "Learn OCaml" ^" v."^ Learnocaml_api.version); let exercise_fetch = token >>= fun token -> - retrieve (Learnocaml_api.Exercise (token, id)) + retrieve (Learnocaml_api.Exercise (token, id, true)) in let after_init top = exercise_fetch >>= fun (_meta, exo, _deadline) -> - begin match Learnocaml_exercise.(decipher File.prelude exo) with - | "" -> Lwt.return true - | prelude -> - Learnocaml_toplevel.load ~print_outcome:true top - ~message: [%i"loading the prelude..."] - prelude - end >>= fun r1 -> - Learnocaml_toplevel.load ~print_outcome:false top - (Learnocaml_exercise.(decipher File.prepare exo)) >>= fun r2 -> - if not r1 || not r2 then failwith [%i"error in prelude"] ; + let exercise_js = Learnocaml_exercise.(decipher File.exercise_js exo) in + Learnocaml_toplevel.load_cmi_from_string top + Learnocaml_exercise.(decipher File.prelude_cmi exo) >>= fun _ -> + Learnocaml_toplevel.load_cmi_from_string top + Learnocaml_exercise.(decipher File.prepare_cmi exo) >>= fun _ -> + Learnocaml_toplevel.load_js ~print_outcome:false top + exercise_js + >>= fun r -> + if not r then Lwt.fail_with [%i"error in prelude"] else + Learnocaml_toplevel.load top "include Prelude ;;" + ~message: [%i"loading the prelude..."] >>= fun r -> + if not r then Lwt.fail_with [%i"error in prelude"] else + Learnocaml_toplevel.load ~print_outcome:false top "module Prelude = struct end;;" >>= fun r -> + if not r then Lwt.fail_with [%i"error in prelude"] else + Learnocaml_toplevel.load ~print_outcome:false top "include Prepare ;;" >>= fun r -> + if not r then Lwt.fail_with [%i"error in prelude"] else + Learnocaml_toplevel.load ~print_outcome:false top "module Prepare = struct end;;" >>= fun r -> + if not r then Lwt.fail_with [%i"error in prelude"] else + (* TODO: maybe remove Prelude, Prepare modules from the env ? *) Learnocaml_toplevel.set_checking_environment top >>= fun () -> Lwt.return () in let toplevel_launch = @@ -189,7 +198,7 @@ let () = EB.eval top select_tab; let typecheck = typecheck top ace editor in (*------------- prelude -----------------*) - setup_prelude_pane ace Learnocaml_exercise.(decipher File.prelude exo); + setup_prelude_pane ace Learnocaml_exercise.(decipher File.prelude_ml exo); Js.Opt.case (text_iframe##.contentDocument) (fun () -> failwith "cannot edit iframe document") diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 883e65574..893626e64 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019-2022 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/app/learnocaml_local_storage.ml b/src/app/learnocaml_local_storage.ml index 26522633c..c77aa6db7 100644 --- a/src/app/learnocaml_local_storage.ml +++ b/src/app/learnocaml_local_storage.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019-2022 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/app/learnocaml_partition_view.ml b/src/app/learnocaml_partition_view.ml index d1571a151..a3e77ce99 100644 --- a/src/app/learnocaml_partition_view.ml +++ b/src/app/learnocaml_partition_view.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/app/learnocaml_playground_main.ml b/src/app/learnocaml_playground_main.ml index d0b11074d..f1e4e5792 100644 --- a/src/app/learnocaml_playground_main.ml +++ b/src/app/learnocaml_playground_main.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/app/learnocaml_student_view.ml b/src/app/learnocaml_student_view.ml index 8e7f7ee45..7dbef0e28 100644 --- a/src/app/learnocaml_student_view.ml +++ b/src/app/learnocaml_student_view.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -515,7 +515,7 @@ let () = | None -> () | Some ex_id -> Lwt.async @@ fun () -> - retrieve (Learnocaml_api.Exercise (Some teacher_token, ex_id)) + retrieve (Learnocaml_api.Exercise (Some teacher_token, ex_id, true)) >>= fun (meta, exo, _) -> clear_tabs (); let ans = SMap.find_opt ex_id save.Save.all_exercise_states in diff --git a/src/app/learnocaml_teacher_tab.ml b/src/app/learnocaml_teacher_tab.ml index b9bc2e5d5..c615e0b10 100644 --- a/src/app/learnocaml_teacher_tab.ml +++ b/src/app/learnocaml_teacher_tab.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/app/server_caller.ml b/src/app/server_caller.ml index 4ad49b5f4..9cb7a873a 100644 --- a/src/app/server_caller.ml +++ b/src/app/server_caller.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -114,8 +114,8 @@ let fetch_lesson_index () = let fetch_lesson id = request_exn (Learnocaml_api.Lesson id) -let fetch_exercise token id = - request_exn (Learnocaml_api.Exercise (token,id)) +let fetch_exercise token id js = + request_exn (Learnocaml_api.Exercise (token,id,js)) let fetch_tutorial_index () = request_exn (Learnocaml_api.Tutorial_index ()) diff --git a/src/app/server_caller.mli b/src/app/server_caller.mli index 10da0bc39..932344be0 100644 --- a/src/app/server_caller.mli +++ b/src/app/server_caller.mli @@ -24,7 +24,7 @@ exception Cannot_fetch of string val request_exn: 'a Learnocaml_api.request -> 'a Lwt.t val[@deprecated] fetch_exercise: - Token.t option -> Exercise.id -> (Exercise.Meta.t * Exercise.t * float option) Lwt.t + Token.t option -> Exercise.id -> bool -> (Exercise.Meta.t * Exercise.t * float option) Lwt.t val[@deprecated] fetch_lesson_index: unit -> Lesson.Index.t Lwt.t val[@deprecated] fetch_lesson : string -> Lesson.t Lwt.t diff --git a/src/grader-plugins/dune b/src/grader-plugins/dune new file mode 100644 index 000000000..a0b860d55 --- /dev/null +++ b/src/grader-plugins/dune @@ -0,0 +1,17 @@ +(library + (name mutation_testing) + (public_name learn-ocaml.mutation_testing) + (wrapped false) + (modes byte) + (libraries compiler-libs) + ;; The following lines are specific for compiling from within learn-ocaml. + ;; When writing grader-helper libs, use instead: + ;; (libraries learn-ocaml.test_lib) + ;; (preprocess (action (run %{libexec:learn-ocaml.test_lib:grader-ppx} %{input-file}))) + (flags (:standard -I src/grader/test_lib -open Test_lib.Open_me)) + (modules mutation_test) + (preprocess (pps grader_ppx)) + (preprocessor_deps (file ../grader/grading.cma) + (alias ../grader/test_lib/test_lib_cmis)) + ;; these are not a preprocessor deps, but dune does not allow other kinds of deps... +) diff --git a/src/grader/mutation_test.ml b/src/grader-plugins/mutation_test.ml similarity index 90% rename from src/grader/mutation_test.ml rename to src/grader-plugins/mutation_test.ml index ccba461ff..f03b83a7a 100644 --- a/src/grader/mutation_test.ml +++ b/src/grader-plugins/mutation_test.ml @@ -1,3 +1,11 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2022-2023 OCaml Software Foundation. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +open Test_lib.Open_me open Learnocaml_report type 'a test_result = @@ -12,36 +20,8 @@ let uncurry3 f = fun (x, y, z) -> f x y z let uncurry4 f = fun (x, y, z, w) -> f x y z w let map_third f = fun (x, y, z) -> (x, y, f z) -module type S = sig - val run_test_against_mutant: - ?compare: ('b -> 'b -> bool) -> - ('a -> 'b) -> ('a * 'b) -> bool - val test_unit_tests_1: - ?test_student_soln: bool -> - ?test: ('b -> 'b -> bool) -> - ('a -> 'b) Ty.ty -> string -> ('a -> 'b) mutant_info list -> Learnocaml_report.t - val test_unit_tests_2: - ?test_student_soln: bool -> - ?test: ('c -> 'c -> bool) -> - ('a -> 'b -> 'c) Ty.ty -> string -> ('a -> 'b -> 'c) mutant_info list -> Learnocaml_report.t - val test_unit_tests_3: - ?test_student_soln: bool -> - ?test: ('d -> 'd -> bool) -> - ('a -> 'b -> 'c -> 'd) Ty.ty - -> string - -> ('a -> 'b -> 'c -> 'd) mutant_info list - -> Learnocaml_report.t - val test_unit_tests_4: - ?test_student_soln: bool -> - ?test: ('e -> 'e -> bool) -> - ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty - -> string - -> ('a -> 'b -> 'c -> 'd -> 'e) mutant_info list - -> Learnocaml_report.t - val passed_mutation_testing: Learnocaml_report.t -> bool -end - -module Make (Test_lib: Test_lib.S) : S = struct +(* module Make (Test_lib: module type of Test_lib) : S = struct *) +module M = struct open Test_lib let run_test_against ?(compare = (=)) f (input, expected) = @@ -319,3 +299,8 @@ module Make (Test_lib: Test_lib.S) : S = struct test_ty printer out_printer name soln stud muts end + +include M + +(* for backwards-compatibility *) +module Make (_: module type of Test_lib) = M diff --git a/src/grader/mutation_test.mli b/src/grader-plugins/mutation_test.mli similarity index 93% rename from src/grader/mutation_test.mli rename to src/grader-plugins/mutation_test.mli index f01c22027..f87bde703 100644 --- a/src/grader/mutation_test.mli +++ b/src/grader-plugins/mutation_test.mli @@ -32,15 +32,6 @@ type 'a mutant_info = string * int * 'a For testing a function called [foo], the student's tests should be in a variable called [foo_tests]. - This module needs to be instantiated with an instance of - [Test_lib], which is available to the grader code: - - {[ - module M = Mutation_test.Make (Test_lib) - - M.test_unit_tests_1 ... - ]} - A grading function is defined for each arity function from one to four: @@ -58,7 +49,7 @@ type 'a mutant_info = string * int * 'a expected and actual outputs, and defaults to structural equality ([(=)]). *) -module type S = sig +module M: sig (** Run a test (a pair of input and expected output) on a mutant function. @@ -109,4 +100,7 @@ module type S = sig val passed_mutation_testing: Learnocaml_report.t -> bool end -module Make (_: Test_lib.S) : S +include module type of M + +(** For backwards compatibility *) +module Make (_: module type of Test_lib): module type of M diff --git a/src/grader/dune b/src/grader/dune index a8df1184d..c181c614a 100644 --- a/src/grader/dune +++ b/src/grader/dune @@ -13,29 +13,52 @@ (action (run odoc compile --package learn-ocaml %{deps} -o %{targets})) ) +;; needs to be a separate lib because the module is shared between evaluator +;; parts (Grading) and dynamic parts (Test_lib) (library - (name testing) + (name introspection_intf) + (wrapped false) + (modules introspection_intf) + (modules_without_implementation introspection_intf) + (libraries learnocaml_report ty)) + +;; dynamic part, on which Test_lib depends +(library + (name pre_test) + (wrapped false) + (modules learnocaml_callback learnocaml_internal pre_test) + (modules_without_implementation learnocaml_callback learnocaml_internal pre_test) + (libraries compiler-libs + learnocaml_report + learnocaml_internal_intf + introspection_intf)) + +;; dynamic (but pre-compiled) part +(library + (name testing_dyn) (wrapped false) (modes byte) (library_flags :standard -linkall) (libraries ty toploop - learnocaml_ppx_metaquot learnocaml_ppx_metaquot_lib + grader_ppx ocplib-json-typed learnocaml_report - learnocaml_repository) - (modules Introspection_intf - Introspection - Test_lib - Mutation_test) - (modules_without_implementation Introspection_intf) - (preprocess (pps learnocaml_ppx_metaquot)) + learnocaml_repository + introspection_intf + pre_test) + (modules Test_lib) + (preprocess (pps grader_ppx)) ) +(rule + (target testing_dyn.js) + (deps testing_dyn.cma) + (action (run js_of_ocaml %{deps} --wrap-with dynload))) (rule (targets test_lib.odoc) - (deps .testing.objs/byte/test_lib.cmti) + (deps .testing_dyn.objs/byte/test_lib.cmti) (action (run odoc compile --package learn-ocaml %{deps} -o %{targets})) ) @@ -138,25 +161,16 @@ ) (rule - (targets embedded_grading_cmis.ml) - (deps (:compiler-cmis - %{ocaml-config:standard_library}/compiler-libs/longident.cmi - %{ocaml-config:standard_library}/compiler-libs/asttypes.cmi - %{ocaml-config:standard_library}/compiler-libs/ast_helper.cmi - %{ocaml-config:standard_library}/compiler-libs/ast_mapper.cmi - %{ocaml-config:standard_library}/compiler-libs/parsetree.cmi - %{ocaml-config:standard_library}/compiler-libs/location.cmi - %{ocaml-config:standard_library}/compiler-libs/parse.cmi - %{ocaml-config:standard_library}/compiler-libs/pprintast.cmi) - (:generated-cmis - ../ppx-metaquot/.ty.objs/byte/ty.cmi - ../ppx-metaquot/.fun_ty.objs/byte/fun_ty.cmi - .testing.objs/byte/introspection_intf.cmi - .learnocaml_report.objs/byte/learnocaml_report.cmi - .testing.objs/byte/test_lib.cmi - .testing.objs/byte/mutation_test.cmi)) + (targets embedded_grading_lib.ml) + (deps + .pre_test.objs/byte/learnocaml_callback.cmi + .pre_test.objs/byte/learnocaml_internal.cmi + ;; .pre_test.objs/byte/pre_test.cmi -- only test_lib should be needed + .testing_dyn.objs/byte/test_lib.cmi + testing_dyn.cma + testing_dyn.js) (action (with-stdout-to %{targets} - (run ocp-ocamlres -format ocamlres %{compiler-cmis} %{generated-cmis}))) + (run ocp-ocamlres -format ocamlres %{deps}))) ) (library @@ -164,15 +178,19 @@ (wrapped false) (modes byte) (library_flags :standard -linkall) - (libraries testing - learnocaml_ppx_metaquot + (libraries grader_ppx ocplib-ocamlres.runtime + toploop + learnocaml_internal_intf + introspection_intf embedded_cmis ocplib_i18n - learnocaml_report) - (modules Embedded_grading_cmis + learnocaml_report + learnocaml_repository) + (modules Introspection + Embedded_grading_lib Grading) - (preprocess (per_module ((pps ppx_ocplib_i18n learnocaml_ppx_metaquot) Grading))) + (preprocess (per_module ((pps ppx_ocplib_i18n grader_ppx) Grading))) ) diff --git a/src/grader/grader_cli.ml b/src/grader/grader_cli.ml index 19e0149ea..c3da7277c 100644 --- a/src/grader/grader_cli.ml +++ b/src/grader/grader_cli.ml @@ -1,15 +1,12 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the * included LICENSE file for details. *) let display_std_outputs = ref false -let dump_outputs = ref None -let dump_reports = ref None -let display_callback = ref false let display_outcomes = ref false let grade_student = ref None let individual_timeout = ref None @@ -30,7 +27,7 @@ let read_exercise exercise_dir = in Learnocaml_exercise.read_lwt ~read_field ~id:(Filename.basename exercise_dir) - ~decipher:false () + () let remove_trailing_slash s = let len = String.length s in @@ -47,29 +44,38 @@ let read_student_file exercise_dir path = else Lwt_io.with_file ~mode:Lwt_io.Input fn Lwt_io.read -let grade ?(print_result=false) ?dirname meta exercise output_json = +let grade ?(print_result=false) ?dirname + ~dump_outputs ~dump_reports ~display_callback + meta exercise output_json = Lwt.catch (fun () -> let code_to_grade = match !grade_student with | Some path -> read_student_file (Sys.getcwd ()) path - | None -> - Lwt.return (Learnocaml_exercise.(decipher File.solution exercise)) in + | None -> Lwt.return (Learnocaml_exercise.(decipher File.solution exercise)) in let callback = - if !display_callback then Some (Printf.eprintf "[ %s ]%!\r\027[K") else None in + if display_callback then Some (Printf.eprintf "[ %s ]%!\r\027[K") else None in let timeout = !individual_timeout in code_to_grade >>= fun code -> Grading_cli.get_grade ?callback ?timeout ?dirname exercise code >>= fun (result, stdout_contents, stderr_contents, outcomes) -> flush stderr; match result with - | Error exn -> + | Error (Grading.Internal_error _ as err) -> let dump_error ppf = - begin match Grading.string_of_exn exn with - | Some msg -> - Format.fprintf ppf "%s@." msg - | None -> - Format.fprintf ppf "%a@." Location.report_exception exn - end; + Format.fprintf ppf "%s@." (Grading.string_of_err err) + in + begin match dump_outputs with + | None -> () + | Some prefix -> + let oc = open_out (prefix ^ ".error") in + dump_error (Format.formatter_of_out_channel oc) ; + close_out oc + end ; + dump_error Format.err_formatter ; + Lwt.return (Error (-1)) + | Error err -> + let dump_error ppf = + Format.fprintf ppf "%s@." (Grading.string_of_err err); if stdout_contents <> "" then begin Format.fprintf ppf "grader stdout:@.%s@." stdout_contents end ; @@ -79,7 +85,7 @@ let grade ?(print_result=false) ?dirname meta exercise output_json = if outcomes <> "" then begin Format.fprintf ppf "grader outcomes:@.%s@." outcomes end in - begin match !dump_outputs with + begin match dump_outputs with | None -> () | Some prefix -> let oc = open_out (prefix ^ ".error") in @@ -92,7 +98,7 @@ let grade ?(print_result=false) ?dirname meta exercise output_json = let (max, failure) = Learnocaml_report.result report in if !display_reports then Learnocaml_report.print (Format.formatter_of_out_channel stderr) report; - begin match !dump_reports with + begin match dump_reports with | None -> () | Some prefix -> let oc = open_out (prefix ^ ".report.txt") in @@ -103,7 +109,7 @@ let grade ?(print_result=false) ?dirname meta exercise output_json = close_out oc end ; if stderr_contents <> "" then begin - begin match !dump_outputs with + begin match dump_outputs with | None -> () | Some prefix -> let oc = open_out (prefix ^ ".stderr") in @@ -114,7 +120,7 @@ let grade ?(print_result=false) ?dirname meta exercise output_json = Format.eprintf "%s" stderr_contents end ; if stdout_contents <> "" then begin - begin match !dump_outputs with + begin match dump_outputs with | None -> () | Some prefix -> let oc = open_out (prefix ^ ".stdout") in @@ -125,7 +131,7 @@ let grade ?(print_result=false) ?dirname meta exercise output_json = Format.printf "%s" stdout_contents end ; if outcomes <> "" then begin - begin match !dump_outputs with + begin match dump_outputs with | None -> () | Some prefix -> let oc = open_out (prefix ^ ".outcomes") in @@ -163,7 +169,8 @@ let grade ?(print_result=false) ?dirname meta exercise output_json = Lwt.return (Ok ()) end) (fun exn -> - begin match !dump_outputs with + Lwt.wrap @@ fun () -> + begin match dump_outputs with | None -> () | Some prefix -> let oc = open_out (prefix ^ ".error") in @@ -172,10 +179,13 @@ let grade ?(print_result=false) ?dirname meta exercise output_json = "%a@!" Location.report_exception exn ; close_out oc end ; - Format.eprintf "%a" Location.report_exception exn ; - Lwt.return (Error (-1))) + Format.eprintf "%a" Location.report_exception exn; + Error (-1)) -let grade_from_dir ?(print_result=false) exercise_dir output_json = +let grade_from_dir + ?(print_result=false) + ~dump_outputs ~dump_reports ~display_callback + exercise_dir output_json = let exercise_dir = remove_trailing_slash exercise_dir in read_exercise exercise_dir >>= fun exo -> Lwt_io.(with_file ~mode:Input (String.concat Filename.dir_sep [exercise_dir; "meta.json"]) read) >>= fun content -> @@ -183,4 +193,6 @@ let grade_from_dir ?(print_result=false) exercise_dir output_json = | "" -> `O [] | s -> Ezjsonm.from_string s) |> Json_encoding.destruct Learnocaml_data.Exercise.Meta.enc in - grade ~print_result ~dirname:exercise_dir meta exo output_json + grade + ~dump_outputs ~dump_reports ~display_callback + ~print_result ~dirname:exercise_dir meta exo output_json diff --git a/src/grader/grader_cli.mli b/src/grader/grader_cli.mli index 838a3896c..c08cb4dfb 100644 --- a/src/grader/grader_cli.mli +++ b/src/grader/grader_cli.mli @@ -11,15 +11,6 @@ (** Should stdout / stderr of the grader be echoed *) val display_std_outputs: bool ref -(** Should outputs of the grader be saved and where *) -val dump_outputs: string option ref - -(** Should the reports be saved and where *) -val dump_reports: string option ref - -(** Should the message from 'test.ml' be displayed on stdout ? *) -val display_callback: bool ref - (** Should compiler outcome be printed ? *) val display_outcomes: bool ref @@ -39,9 +30,14 @@ val dump_dot: string option ref (** Runs the grading process *) val grade: - ?print_result:bool -> ?dirname:string -> Learnocaml_data.Exercise.Meta.t -> Learnocaml_exercise.t -> string option -> + ?print_result:bool -> ?dirname:string -> + dump_outputs:string option -> dump_reports:string option -> + display_callback:bool -> + Learnocaml_data.Exercise.Meta.t -> Learnocaml_exercise.t -> string option -> (unit, int) result Lwt.t val grade_from_dir: - ?print_result:bool -> string -> string option -> + ?print_result:bool -> + dump_outputs:string option -> dump_reports:string option -> display_callback:bool -> + string -> string option -> (unit, int) result Lwt.t diff --git a/src/grader/grader_jsoo_messages.ml b/src/grader/grader_jsoo_messages.ml index 8a38f204c..a80b19a5d 100644 --- a/src/grader/grader_jsoo_messages.ml +++ b/src/grader/grader_jsoo_messages.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/grader/grader_jsoo_worker.ml b/src/grader/grader_jsoo_worker.ml index 7f14b8e34..0ad89a0a8 100644 --- a/src/grader/grader_jsoo_worker.ml +++ b/src/grader/grader_jsoo_worker.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -23,7 +23,6 @@ let get_grade ?callback exo solution = | OCamlRes.Res.Error _ -> () in rec_mount [] (OCamlRes.Res.Dir ("worker_cmis", Embedded_cmis.root)); - rec_mount [] (OCamlRes.Res.Dir ("grading_cmis", Embedded_grading_cmis.root)); (try Toploop_jsoo.initialize ["/worker_cmis"; "/grading_cmis"] with | Typetexp.Error (loc, env, error) -> Js_utils.log "FAILED INIT %a at %a" @@ -34,7 +33,16 @@ let get_grade ?callback exo solution = let divert name chan cb = let redirection = Toploop_jsoo.redirect_channel name chan cb in fun () -> Toploop_jsoo.stop_channel_redirection redirection in - Grading.get_grade ?callback ~divert exo solution + let load_code compiled_code = + try + Toploop_jsoo.use_compiled_string compiled_code.Learnocaml_exercise.js; + flush_all (); + Toploop_ext.Ok (true, []) + with exn -> + prerr_endline (Printexc.to_string exn); + Toploop_ext.Ok (false, []) + in + Grading.get_grade ?callback ~divert ~load_code exo solution open Grader_jsoo_messages @@ -51,8 +59,8 @@ let () = match get_grade ~callback exercise solution with | Ok report, stdout, stderr, outcomes -> Answer (report, stdout, stderr, outcomes) - | Error exn, stdout, stderr, outcomes -> - let msg = match exn with + | Error err, stdout, stderr, outcomes -> + let msg = match err with | Grading.User_code_error err -> Format.asprintf [%if"Error in your solution:\n%a\n%!"] Location.print_report (Toploop_results.to_error err) @@ -61,9 +69,7 @@ let () = step Location.print_report (Toploop_results.to_error err) | Grading.Invalid_grader -> - [%i"Internal error:\nThe grader did not return a report."] - | exn -> - [%i"Unexpected error:\n"] ^ Printexc.to_string exn in + [%i"Internal error:\nThe grader did not return a report."] in let report = Learnocaml_report.[ Message ([ Code msg ], Failure) ] in Answer (report, stdout, stderr, outcomes) | exception exn -> diff --git a/src/grader/grading.ml b/src/grader/grading.ml index b5c8e0cbf..ba7cdd998 100644 --- a/src/grader/grading.ml +++ b/src/grader/grading.ml @@ -1,45 +1,42 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the * included LICENSE file for details. *) -exception Internal_error of string * Toploop_ext.error -exception User_code_error of Toploop_ext.error -exception Invalid_grader +(* Define a non-extensible type to allow marshalling *) +type error = + | Internal_error of string * Toploop_ext.error + | User_code_error of Toploop_ext.error + | Invalid_grader -let string_of_exn = function +exception Grading_error of error + +let string_of_err = function | Internal_error (msg, error) -> - let msg = - Format.asprintf [%if"Exercise definition error %s:\n%a\n%!"] - msg Location.print_report (Toploop_results.to_error error) - in - Some msg + Format.asprintf [%if"Exercise definition error %s:\n%a\n%!"] + msg Location.print_report (Toploop_results.to_error error) | User_code_error error -> - let msg = - Format.asprintf [%if"Error in user code:\n\n%a\n%!"] - Location.print_report (Toploop_results.to_error error) - in - Some msg - | _ -> None + Format.asprintf [%if"Error in user code:\n\n%a\n%!"] + Location.print_report (Toploop_results.to_error error) + | Invalid_grader -> + [%i"The grader is invalid"] let () = - Location.register_error_of_exn (fun exn -> - match string_of_exn exn with - | Some msg -> Some (Location.error msg) - | None -> None) - + Location.register_error_of_exn (function + | Grading_error e -> Some (Location.error (string_of_err e)) + | _ -> None) let internal_error name err = - raise (Internal_error (name, err)) + raise (Grading_error (Internal_error (name, err))) let user_code_error err = - raise (User_code_error err) + raise (Grading_error (User_code_error err)) let get_grade - ?callback ?timeout ?(dirname="") ~divert + ?callback ?timeout ?(dirname="") ~divert ~load_code (exo : Learnocaml_exercise.t) code = let file f = String.concat Filename.dir_sep [dirname; f] in @@ -93,115 +90,118 @@ let get_grade fail err in let result = try - handle_error (internal_error [%i"while preparing the tests"]) @@ - Toploop_ext.use_string ~print_outcome ~ppf_answer - {|let print_html _ = assert false|}; - - set_progress [%i"Loading the prelude."] ; - handle_error (internal_error [%i"while loading the prelude"]) @@ - Toploop_ext.use_string ~print_outcome ~ppf_answer ~filename:(file "prelude.ml") - (Learnocaml_exercise.(decipher File.prelude exo)) ; + let saved_toplevel_state = Symtable.current_state () in + let () = + (* Prelude/Prepare might use these callbacks, but they shouldn't appear + in the solutions: provide dummy implementations here *) + Toploop_ext.load_cmi_from_string + OCamlRes.(Res.find (Path.of_string "learnocaml_callback.cmi") Embedded_grading_lib.root) ; + let module Learnocaml_callback: Learnocaml_internal_intf.CALLBACKS = struct + let print_html s = output_string stdout s + let print_svg s = output_string stdout s + end in + Toploop_ext.inject_global "Learnocaml_callback" + (Obj.repr (module Learnocaml_callback: Learnocaml_internal_intf.CALLBACKS)); + in + let () = + let module Learnocaml_internal: Learnocaml_internal_intf.INTERNAL = struct + let install_printer = Toploop_ext.install_printer + exception Undefined + end in + Toploop_ext.inject_global "Learnocaml_internal" + (Obj.repr (module Learnocaml_internal: Learnocaml_internal_intf.INTERNAL)) + in set_progress [%i"Preparing the test environment."] ; + Toploop_ext.load_cmi_from_string (Learnocaml_exercise.(decipher File.prelude_cmi exo)) ; + Toploop_ext.load_cmi_from_string (Learnocaml_exercise.(decipher File.prepare_cmi exo)) ; + + handle_error (internal_error [%i"while preparing the tests"]) @@ + load_code Learnocaml_exercise.{ + cma = decipher File.exercise_cma exo ; + js = decipher File.exercise_js exo ; + }; + handle_error (internal_error [%i"while preparing the tests"]) @@ - Toploop_ext.use_string ~print_outcome ~ppf_answer ~filename:(file "prepare.ml") - (Learnocaml_exercise.(decipher File.prepare exo)) ; + Toploop_ext.use_string ~print_outcome ~ppf_answer + {|include Prelude|}; + handle_error (internal_error [%i"while preparing the tests"]) @@ + Toploop_ext.use_string ~print_outcome:false ~ppf_answer + {|module Prelude = struct end|}; + handle_error (internal_error [%i"while preparing the tests"]) @@ + Toploop_ext.use_string ~print_outcome:false ~ppf_answer + {|include Prepare|}; + handle_error (internal_error [%i"while preparing the tests"]) @@ + Toploop_ext.use_string ~print_outcome:false ~ppf_answer + {|module Prepare = struct end|}; set_progress [%i"Loading your code."] ; handle_error user_code_error @@ Toploop_ext.use_mod_string ~print_outcome ~ppf_answer ~modname:"Code" ~filename:(file "solution.ml") code ; - set_progress [%i"Loading the solution."] ; - handle_error (internal_error [%i"while loading the solution"]) @@ - Toploop_ext.use_mod_string ~print_outcome ~ppf_answer ~modname:"Solution" - (Learnocaml_exercise.(decipher File.solution exo)) ; + Toploop_ext.load_cmi_from_string (Learnocaml_exercise.(decipher File.solution_cmi exo)) ; set_progress [%i"Preparing to launch the tests."] ; - Introspection.allow_introspection ~divert ; - Introspection.insert_mod_ast_in_env ~var_name: "code_ast" code ; - let get_result = - Introspection.create_ref "results" - [%ty: Learnocaml_report.t option] - None in - Introspection.register_callback "set_progress" - [%ty: string] - set_progress ; - Introspection.insert_in_env "timeout" [%ty: int option] timeout ; + let module Intro_inner = + (val Introspection.allow_introspection ~divert) + in + let code_ast = Introspection.get_mod_ast ~var_name:"code_ast" code in + let results: Learnocaml_report.t option ref = ref None in + let get_result () = !results in + let () = + let module Pre_test: Introspection_intf.PRE_TEST = struct + module Introspection = Intro_inner + let code_ast = code_ast + let results = results + let set_progress = set_progress + let timeout = timeout + end in + (* Hack: register Pre_test as a compilation unit usable by the compiled + modules loaded later-on *) + Toploop_ext.inject_global "Pre_test" + (Obj.repr (module Pre_test: Introspection_intf.PRE_TEST)); + in + Toploop_ext.load_cmi_from_string + OCamlRes.(Res.find (Path.of_string "test_lib.cmi") + Embedded_grading_lib.root) ; handle_error (internal_error [%i"while preparing the tests"]) @@ - Toploop_ext.use_string ~print_outcome ~ppf_answer - "module Test_lib = Test_lib.Make(struct\n\ - \ let results = results\n\ - \ let set_progress = set_progress\n\ - \ let timeout = timeout\n\ - \ module Introspection = Introspection\n\ - end)" ; + load_code + { Learnocaml_exercise. + cma = OCamlRes.(Res.find (Path.of_string "testing_dyn.cma") + Embedded_grading_lib.root) ; + js = OCamlRes.(Res.find (Path.of_string "testing_dyn.js") + Embedded_grading_lib.root) }; handle_error (internal_error [%i"while preparing the tests"]) @@ - Toploop_ext.use_string ~print_outcome ~ppf_answer - "module Report = Learnocaml_report" ; - (* The following 3 lines are just a workaround for issue #457 *) + Toploop_ext.use_string ~print_outcome:false ~ppf_answer {|open! Test_lib.Open_me|}; + (* Registering the samplers that may be defined in [test.ml] requires + having their types and the definitions of the types they sample, hence + the need for an opened [test_cmi]*) + Toploop_ext.load_cmi_from_string (Learnocaml_exercise.(decipher File.test_cmi exo)) ; handle_error (internal_error [%i"while preparing the tests"]) @@ - Toploop_ext.use_string ~print_outcome ~ppf_answer - "module Introspection = Introspection" ; - set_progress [%i"Launching the test bench."] ; - - let () = - let open Learnocaml_exercise in - let files = File.dependencies (access File.depend exo) in - let rec load_dependencies signatures = function - | [] -> () (* signatures without implementation are ignored *) - | file::fs -> - let path = File.key file - and content = decipher file exo in - let modname = String.capitalize_ascii @@ - Filename.remove_extension @@ Filename.basename path in - match Filename.extension path with - | ".mli" -> load_dependencies ((modname,content) :: signatures) fs - | ".ml" -> - let included,content = - (* the first line of an .ml file can contain an annotation *) - (* [@@@included] which denotes that this file has to be included *) - (* directly in the toplevel environment, and not in an module. *) - match String.index_opt content '\n' with - | None -> (false,content) - | Some i -> - (match String.trim (String.sub content 0 i) with - | "[@@@included]" -> - let content' = String.sub content i @@ - (String.length content - i) - in (true,content') - | _ -> (false,content)) - in - (handle_error (internal_error [%i"while loading user dependencies"]) @@ - match included with - | true -> Toploop_ext.use_string ~print_outcome ~ppf_answer - ~filename:(Filename.basename path) content - | false -> - let use_mod = - Toploop_ext.use_mod_string ~print_outcome ~ppf_answer ~modname in - match List.assoc_opt modname signatures with - | Some sig_code -> use_mod ~sig_code content - | None -> use_mod content); - load_dependencies signatures fs - | _ -> failwith ("uninterpreted dependency \"" ^ path ^ - "\", file extension expected : .ml or .mli") in - load_dependencies [] files - in - + Toploop_ext.use_string ~print_outcome:false ~ppf_answer {|open! Test|}; handle_error (internal_error [%i"while testing your solution"]) @@ - Toploop_ext.use_string ~print_outcome ~ppf_answer ~filename:(file "test.ml") - (Learnocaml_exercise.(decipher File.test exo)) ; + load_code Learnocaml_exercise.{ + cma = decipher File.test_cma exo ; + js = decipher File.test_js exo ; + }; (* Memory cleanup... *) Toploop.initialize_toplevel_env () ; - (* TODO: Also clear the object table, once the OCaml's Toploop allows to. *) + Symtable.restore_state saved_toplevel_state; + (* TODO: Also clear the object table, once the OCaml's Toploop allows to. + Toploop.toplevel_value_bindings := String.Map.empty; (* not exported :( *) + here we run in a forked sub-process then exit as a workaround *) !flush_stderr () ; !flush_stdout () ; match get_result () with | Some report -> Ok report | None -> Error Invalid_grader - with exn -> - Error exn in + with + | Grading_error err -> Error err + | e -> Error (Internal_error (Printexc.to_string e, + ((Location.none, ""),[]))) + in Format.fprintf ppf_answer "@." ; (result, Buffer.contents stdout_buffer, diff --git a/src/grader/grading.mli b/src/grader/grading.mli index 4963d90d6..a3c41afb0 100644 --- a/src/grader/grading.mli +++ b/src/grader/grading.mli @@ -8,22 +8,27 @@ open Toploop_ext -exception Internal_error of string * error -exception User_code_error of error -exception Invalid_grader +type error = + | Internal_error of string * Toploop_ext.error + | User_code_error of Toploop_ext.error + | Invalid_grader + +exception Grading_error of error (** Take an exercise, a solution, and return the report, stdout, stderr and outcomes of the toplevel, or raise ont of the exceptions above. The divert mechanism is a platform dependent way of rerouting the standard channel descriptors, as implemented by - {!Toploop_unix} and {!Toploop_jsoo}. *) + {!Toploop_unix} and {!Toploop_jsoo}. {load_code} is expected to load + compiled code, either in {cmo} or {js} depending on the backend. *) val get_grade: ?callback:(string -> unit) -> ?timeout:int -> ?dirname:string -> divert:(string -> out_channel -> (string -> unit) -> (unit -> unit)) -> - Learnocaml_exercise.t -> string -> (Learnocaml_report.t, exn) result * string * string * string + load_code:(Learnocaml_exercise.compiled_lib -> bool Toploop_ext.toplevel_result) -> + Learnocaml_exercise.t -> string -> (Learnocaml_report.t, error) result * string * string * string (** Returns user-friendly messages when called on [Internal_error] or [User_code_error] *) -val string_of_exn: exn -> string option +val string_of_err: error -> string diff --git a/src/grader/grading_cli.ml b/src/grader/grading_cli.ml index a90f1576b..a8822498a 100644 --- a/src/grader/grading_cli.ml +++ b/src/grader/grading_cli.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -18,35 +18,78 @@ and remove dir name = let file = Filename.concat dir name in if Sys.is_directory file then remove_dir file else Lwt_unix.unlink file -let with_temp_dir f = - let rec get_dir () = - let d = - Filename.concat - (Filename.get_temp_dir_name ()) - (Printf.sprintf "grader_%6X" (Random.int 0xFFFFFF)) - in - Lwt.catch (fun () -> Lwt_unix.mkdir d 0o700 >>= fun () -> Lwt.return d) - @@ function - | Unix.Unix_error(Unix.EEXIST, _, _) -> get_dir () - | e -> raise e +let rec mk_temp_dir () = + let d = + Filename.concat + (Filename.get_temp_dir_name ()) + (Printf.sprintf "grader_%06X" (Random.int 0xFFFFFF)) in - get_dir () >>= fun dir -> - Lwt.catch - (fun () -> f dir >>= fun res -> remove_dir dir >>= fun () -> Lwt.return res) - (fun e -> remove_dir dir >>= fun () -> Lwt.fail e) + Lwt.catch (fun () -> Lwt_unix.mkdir d 0o700 >>= fun () -> Lwt.return d) + @@ function + | Unix.Unix_error(Unix.EEXIST, _, _) -> mk_temp_dir () + | e -> Lwt.fail e + +(* The answer of the grader will be returned marshalled through a pipe: + type it explicitely and avoid any exceptions inside. *) +type grader_answer = + (Learnocaml_report.t, Grading.error) Stdlib.result * string * string * string + +let cmis_dir = lazy begin + mk_temp_dir () >>= fun cmis_dir -> + let module ResDump = OCamlResFormats.Files (OCamlResSubFormats.Raw) in + ResDump.output { OCamlResFormats.base_output_dir = cmis_dir } + Embedded_cmis.root; + Lwt_main.at_exit (fun () -> remove_dir cmis_dir); + Lwt.return cmis_dir +end let get_grade ?callback ?timeout ?dirname exo solution = - with_temp_dir @@ fun cmis_dir -> - let module ResDump = - OCamlResFormats.Files (OCamlResSubFormats.Raw) in - let dump_cmis = - ResDump.output { OCamlResFormats.base_output_dir = cmis_dir } in - dump_cmis Embedded_cmis.root ; - dump_cmis Embedded_grading_cmis.root ; - Load_path.init [ cmis_dir ] ; - Toploop_unix.initialize () ; - let divert name chan cb = - let redirection = Toploop_unix.redirect_channel name chan cb in - fun () -> Toploop_unix.stop_channel_redirection redirection in - Lwt.wrap @@ fun () -> - Grading.get_grade ?callback ?timeout ?dirname ~divert exo solution + Lazy.force cmis_dir >>= fun cmis_dir -> + Lwt_io.flush_all () >>= fun () -> + flush_all (); + let in_fd, out_fd = Unix.pipe ~cloexec:true () in + match Lwt_unix.fork () with + | 0 -> + (* /!\ there must be strictly no Lwt calls in the child *) + Unix.close in_fd; + let () = + try + let oc = Unix.out_channel_of_descr out_fd in + let (ret: grader_answer) = + Load_path.init [ cmis_dir ] ; + Toploop_unix.initialize () ; + let divert name chan cb = + let redirection = Toploop_unix.redirect_channel name chan cb in + fun () -> Toploop_unix.stop_channel_redirection redirection in + let load_code compiled_code = + try + Toploop_unix.use_compiled_string + compiled_code.Learnocaml_exercise.cma; + Toploop_ext.Ok (true, []) + with _ -> Toploop_ext.Ok (false, []) + in + Grading.get_grade ?callback ?timeout ?dirname ~divert ~load_code + exo solution + in + output_value oc ret + with e -> + Format.eprintf "Subprocess failed with: %s\n%!" (Printexc.to_string e) + in + flush_all (); + Unix._exit 0 + | child_pid -> + Unix.close out_fd; + let ic = Lwt_io.of_unix_fd ~mode:Lwt_io.Input in_fd in + Lwt.catch + (fun () -> Lwt_io.read_value ic >|= Option.some) + (function End_of_file -> Lwt.return_none | exn -> Lwt.fail exn) + >>= fun (ans: grader_answer option) -> + Lwt_unix.waitpid [] child_pid >>= fun (_pid, stat) -> + Lwt_io.close ic >>= fun () -> + match ans, stat with + | _, Unix.WSIGNALED n -> + Printf.ksprintf Lwt.fail_with "Grading sub-process was killed (%d)" n + | Some ans, Unix.WEXITED 0 -> + Lwt.return ans + | _ -> + Lwt.fail_with "Grading sub-process error" diff --git a/src/grader/grading_cli.mli b/src/grader/grading_cli.mli index bf3e8c6d0..e41425308 100644 --- a/src/grader/grading_cli.mli +++ b/src/grader/grading_cli.mli @@ -7,11 +7,11 @@ * included LICENSE file for details. *) (** Take an exercise, a solution, and return the report, stdout, - stderr and outcomes of the toplevel, or raise ont of the + stderr and outcomes of the toplevel, or raise one of the exceptions defined in module {!Grading}. *) val get_grade: ?callback:(string -> unit) -> ?timeout:int -> ?dirname:string -> Learnocaml_exercise.t -> string -> - ((Learnocaml_report.t, exn) result * string * string * string) Lwt.t + ((Learnocaml_report.t, Grading.error) result * string * string * string) Lwt.t diff --git a/src/grader/grading_jsoo.ml b/src/grader/grading_jsoo.ml index f60a31b52..11afbfa1f 100644 --- a/src/grader/grading_jsoo.ml +++ b/src/grader/grading_jsoo.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -21,12 +21,9 @@ let get_grade let t, u = Lwt.task () in let worker = Worker.create worker_js_file in Lwt.on_cancel t (fun () -> - Js_utils.js_warn "Grading worker END"; worker##terminate) ; let onmessage (ev : Json_repr_browser.Repr.value Worker.messageEvent Js.t) = let json = ev##.data in - Js_utils.js_warn ("msg from grading worker:"); - Js_utils.js_warn json; begin match Json_repr_browser.Json_encoding.destruct from_worker_enc json with | Callback text -> callback text | Answer (report, stdout, stderr, outcomes) -> @@ -52,8 +49,6 @@ let get_grade fun solution -> let req = { exercise ; solution } in let json = Json_repr_browser.Json_encoding.construct to_worker_enc req in - Js_utils.js_warn ("Sending to grading worker: "); - Js_utils.js_warn json; worker##(postMessage json) ; let timer = Lwt_js.sleep timeout >>= fun () -> diff --git a/src/grader/introspection.ml b/src/grader/introspection.ml index 55370faca..0873c84ca 100644 --- a/src/grader/introspection.ml +++ b/src/grader/introspection.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -8,6 +8,9 @@ (** Introspection *) +exception Introspection_failure of string +let failwith msg = raise (Introspection_failure msg) + let split s c = let rec loop i = match String.index_from s i c with @@ -51,7 +54,7 @@ let insert_in_env (type t) name (ty : t Ty.ty) (value : t) = match ty.ctyp_desc with | Ttyp_package { pack_type; _ } -> Env.add_module - (Ident.create_local name) + (Ident.create_persistent name) Types.Mp_present pack_type !Toploop.toplevel_env @@ -59,7 +62,7 @@ let insert_in_env (type t) name (ty : t Ty.ty) (value : t) = end; Toploop.setvalue name (Obj.repr value) -let insert_mod_ast_in_env ~var_name impl_code = +let get_mod_ast ~var_name impl_code = let init_loc lb filename = Location.input_name := filename; Location.input_lexbuf := Some lb; @@ -92,15 +95,14 @@ let insert_mod_ast_in_env ~var_name impl_code = Pstr_module { pmb_expr = { pmod_desc = Pmod_constraint ({ pmod_desc = Pmod_structure s; _ }, _); _ }; _ }; _}] -> - let ty = Ty.repr (Ast_helper.(Typ.constr (Location.mknoloc (parse_lid "Parsetree.structure")) [])) in - insert_in_env var_name (ty : Parsetree.structure Ty.ty) s + s | _ (* should not happen *) -> assert false) let treat_lookup_errors fn = match fn () with | result -> result | exception Not_found -> Absent - | exception Failure msg -> + | exception Introspection_failure msg -> Incompatible msg | exception Ctype.Unify args -> Incompatible @@ -165,6 +167,9 @@ let get_value lid ty = else failwith (Format.asprintf "Wrong type %a." Printtyp.type_sch val_type) +let base_print_value env obj ppf ty = + !Oprint.out_value ppf @@ + Toploop_ext.Printer.outval_of_value 300 100 (fun _ _ _ -> None) env obj ty let print_value ppf v ty = let { Typedtree.ctyp_type = ty; _ } = Typetexp.transl_type_scheme !Toploop.toplevel_env (Ty.obj ty) in @@ -190,24 +195,106 @@ let print_value ppf v ty = done) (fun () -> ()) in begin try - Toploop.print_value !Toploop.toplevel_env (Obj.repr v) tmp_ppf ty ; + base_print_value !Toploop.toplevel_env (Obj.repr v) tmp_ppf ty ; Format.pp_print_flush tmp_ppf () with Exit -> () end ; match !state with `Start | `Decided false | `Undecided -> false | `Decided true -> true in if needs_parentheses then begin Format.fprintf ppf "@[(" ; - Toploop.print_value !Toploop.toplevel_env (Obj.repr v) ppf ty ; + base_print_value !Toploop.toplevel_env (Obj.repr v) ppf ty ; Format.fprintf ppf ")@]" end else begin Format.fprintf ppf "@[" ; - Toploop.print_value !Toploop.toplevel_env (Obj.repr v) ppf ty ; + base_print_value !Toploop.toplevel_env (Obj.repr v) ppf ty ; Format.fprintf ppf "@]" end + +(* for a type [('a, 'b) foo] => [register_sampler "foo" f] where [f] must have + type ['a sampler -> 'b sampler -> ('a, 'b) foo sampler]. + - find the sampler's type from its name and the cmi + - lookup type [foo] + - build the expected sampler type from the type params of [foo] + - match with the sampler type +*) +let register_sampler modname id tyname f = + let open Types in + let inmodpath id = + match String.split_on_char '.' modname with + | md::r -> + List.fold_left (fun acc id -> Path.Pdot (acc, id)) + (Path.Pident (Ident.create_persistent md)) (r @ [id]) + | [] -> + Path.Pident (Ident.create_local id) + in + let sampler_path = inmodpath id in + let env = !Toploop.toplevel_env in + let gen_sampler_type = + Path.Pdot + (Path.Pident (Ident.create_persistent "Test_lib"), + "sampler") + in + let ty_path1 = inmodpath tyname in + match + Env.find_value sampler_path env, + try ty_path1, Env.find_type ty_path1 env + with Not_found -> Env.find_type_by_name (Longident.Lident tyname) env + with + | exception Not_found -> + Format.eprintf + "Warning: ignored bad sampler registration %s.sample_%s. The type and \ + sampler must be found in the cmi file (no mli file allowed)@." + modname tyname + | sampler_desc, (sampled_ty_path, sampled_ty_decl) -> + Ctype.begin_def(); + let ty_args = + List.map (fun _ -> Ctype.newvar ()) sampled_ty_decl.type_params + in + let ty_target = + Ctype.newty (Tconstr (sampled_ty_path, ty_args, ref Mnil)) + in + let fn_args = + List.map (fun ty -> Ctype.newconstr gen_sampler_type [ty]) ty_args + in + let sampler_ty_expected = + List.fold_right (fun fn_arg ty -> + Ctype.newty (Tarrow (Asttypes.Nolabel, fn_arg, ty, Cunknown))) + fn_args (Ctype.newconstr gen_sampler_type [ty_target]) + in + (try + Ctype.unify env + sampler_ty_expected + (Ctype.instance sampler_desc.val_type) + with Ctype.Unify _ -> + Format.kasprintf failwith + "Mismatching type for sampling function %s.sample_%s.@;\ + The type must be@ @[%aunit -> %a%s@]@." + modname tyname + (Format.pp_print_list + (fun ppf -> Format.fprintf ppf "(unit -> %a) ->@ " (Printtyp.type_expr))) + ty_args + (fun ppf -> function + | [] -> () + | [arg] -> Format.fprintf ppf "%a " Printtyp.type_expr arg + | args -> + Format.fprintf ppf "(%a) " + (Format.pp_print_list + ~pp_sep:(fun ppf () -> Format.pp_print_string ppf ", ") + Printtyp.type_expr) + args) + ty_args + tyname); + Ctype.end_def (); + let def_name = "sample_" ^ tyname in + Toploop.toplevel_env := + Env.add_value (Ident.create_local def_name) sampler_desc + !Toploop.toplevel_env; + Toploop.setvalue def_name (Obj.repr f) + let sample_value ty = let { Typedtree.ctyp_type = ty; _ } = Typetexp.transl_type_scheme !Toploop.toplevel_env (Ty.obj ty) in - let lid = Format.asprintf "sample_%04X" (Random.int 0xFFFF) in + let lid = Format.asprintf "sample_%06X" (Random.int 0xFFFFFF) in let phrase = let open Asttypes in let open Types in @@ -216,9 +303,9 @@ let sample_value ty = Exp.ident (Location.mknoloc (Longident.Lident ("sample_" ^ suffix))) in let rec phrase ty = match ty.desc with | Tconstr (path, [], _) -> - sampler_id (Path.name path) + sampler_id (Path.last path) | Tconstr (path, tl, _) -> - Exp.apply (sampler_id (Path.name path)) + Exp.apply (sampler_id (Path.last path)) (List.map (fun arg -> Asttypes.Nolabel, phrase arg) tl) | Ttuple tys -> begin match tys with @@ -249,6 +336,14 @@ let sample_value ty = | exception Typetexp.Error (_loc, env, err) -> Typetexp.report_error env ppf err; failwith ("type error while defining sampler: " ^ Buffer.contents buf) + | exception Env.Error e -> + Format.kasprintf failwith "error while defining sampler: %s%a" (Buffer.contents buf) Env.report_error e + | exception Symtable.(Error (Uninitialized_global "Test")) -> + Format.kasprintf failwith "Missing sampler registration for %a" + Printtyp.type_expr ty + | exception Symtable.Error e -> + Format.kasprintf failwith "error while defining sampler: %s%a" + (Buffer.contents buf) Symtable.report_error e | exception e -> failwith ("error while defining sampler: " ^ Buffer.contents buf ^ Printexc.to_string e) @@ -266,14 +361,10 @@ let create_ref name (ty: 'a Ty.ty) (v: 'a) = let ty = Ty.repr @@ Ast_helper.Typ.constr ref_lid [Ty.obj ty] in let r = ref v in insert_in_env name ty r; - (fun () -> !r) - -let setup = lazy (Ast_mapper.register "ppx_metaquot" Ppx_metaquot.expander) + (r, ty), (fun () -> !r) let allow_introspection ~divert = - Lazy.force setup ; - let module Introspection = struct type 'a t = 'a value = @@ -338,14 +429,14 @@ let allow_introspection ~divert = stderr_cb := bad_stderr_cb ; res + let install_printer path ty pr = Toploop_ext.Printer.install_printer path ty pr let get_printer ty = fun ppf v -> print_value ppf v ty + + let register_sampler name f = register_sampler name f let get_sampler ty = sample_value ty let parse_lid name = parse_lid name end in - insert_in_env - "Introspection" - [%ty: (module Introspection_intf.INTROSPECTION)] - (module Introspection : Introspection_intf.INTROSPECTION) + (module Introspection : Introspection_intf.INTROSPECTION) diff --git a/src/grader/introspection.mli b/src/grader/introspection.mli index 9182f9a48..fdc06bc4d 100644 --- a/src/grader/introspection.mli +++ b/src/grader/introspection.mli @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -17,10 +17,10 @@ val sample_value: 'a Ty.ty -> 'a val insert_in_env: string -> 'a Ty.ty -> 'a -> unit -val insert_mod_ast_in_env: var_name:string -> string -> unit -val create_ref: string -> 'a Ty.ty -> 'a -> unit -> 'a +val get_mod_ast: var_name:string -> string -> Parsetree.structure + val register_callback: string -> 'a Ty.ty -> ('a -> unit) -> unit val allow_introspection: divert:(string -> out_channel -> (string -> unit) -> (unit -> unit)) -> - unit + (module Introspection_intf.INTROSPECTION) diff --git a/src/grader/introspection_intf.mli b/src/grader/introspection_intf.mli index eac0d0e29..c65207957 100644 --- a/src/grader/introspection_intf.mli +++ b/src/grader/introspection_intf.mli @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -35,8 +35,30 @@ module type INTROSPECTION = sig val release_stderr: unit -> string val get_sampler: 'a Ty.ty -> (unit -> 'a) + + val install_printer: + Path.t -> Types.type_expr -> (Format.formatter -> Obj.t -> unit) -> unit + val get_printer: 'a Ty.ty -> (Format.formatter -> 'a -> unit) val parse_lid: string -> Longident.t + (**/**) + (** Only for use by learnocaml's ppx *) + (* The sampler type is actually [['x sampler ->]* t sampler] with ['x] all the + type variables of [t]. It is dynamically checked at runtime, based on the + cmi of the module that must be already loaded and opened. *) + val register_sampler: + string -> string -> string -> ('a -> 'b) -> unit +end + +(** Interface of the module that gets automatically injected in the environment + of the grader before the tests are run. *) +module type PRE_TEST = sig + module Introspection: INTROSPECTION + + val code_ast: Parsetree.structure + val results: Learnocaml_report.t option ref + val set_progress: string -> unit + val timeout: int option end diff --git a/src/grader/learnocaml_callback.mli b/src/grader/learnocaml_callback.mli new file mode 100644 index 000000000..125a95dce --- /dev/null +++ b/src/grader/learnocaml_callback.mli @@ -0,0 +1,8 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2022-2023 OCaml Software Foundation. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +include Learnocaml_internal_intf.CALLBACKS diff --git a/src/grader/learnocaml_internal.mli b/src/grader/learnocaml_internal.mli new file mode 100644 index 000000000..c572a3ac7 --- /dev/null +++ b/src/grader/learnocaml_internal.mli @@ -0,0 +1,11 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2022 OCaml Software Foundation. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +(* This interface is used to pre-compile modules for the toplevel, giving them + access to specific toplevel functions. It should not be made accessible to + the non-precompiled code running in the toplevel *) +include Learnocaml_internal_intf.INTERNAL diff --git a/src/grader/learnocaml_report.ml b/src/grader/learnocaml_report.ml index 51a5600ed..424aac602 100644 --- a/src/grader/learnocaml_report.ml +++ b/src/grader/learnocaml_report.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/grader/pre_test.mli b/src/grader/pre_test.mli new file mode 100644 index 000000000..38aef9b83 --- /dev/null +++ b/src/grader/pre_test.mli @@ -0,0 +1,16 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2022 OCaml Software Foundation. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +(* These values are injected into the environment after the exercise and + solutions are loaded, and before the tests are loaded *) + +(* Loaded from the exercise: {[ + module Code + module Solution + ]} *) + +include Introspection_intf.PRE_TEST diff --git a/src/grader/test_lib.ml b/src/grader/test_lib.ml index b48ce0cf3..0691c796e 100644 --- a/src/grader/test_lib.ml +++ b/src/grader/test_lib.ml @@ -1,461 +1,15 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the * included LICENSE file for details. *) -module type S = sig - - val set_result : Learnocaml_report.t -> unit - - type nonrec 'a result = ('a, exn) result - - (*----------------------------------------------------------------------------*) - - module Ast_checker : sig - type 'a ast_checker = - ?on_expression: (Parsetree.expression -> Learnocaml_report.t) -> - ?on_pattern: (Parsetree.pattern -> Learnocaml_report.t) -> - ?on_structure_item: (Parsetree.structure_item -> Learnocaml_report.t) -> - ?on_external: (Parsetree.value_description -> Learnocaml_report.t) -> - ?on_include: (Parsetree.include_declaration -> Learnocaml_report.t) -> - ?on_open: (Parsetree.open_declaration -> Learnocaml_report.t) -> - ?on_module_occurence: (string -> Learnocaml_report.t) -> - ?on_variable_occurence: (string -> Learnocaml_report.t) -> - ?on_function_call: ((Parsetree.expression * (string * Parsetree.expression) list) -> Learnocaml_report.t) -> - 'a -> Learnocaml_report.t - - val ast_check_expr : Parsetree.expression ast_checker - val ast_check_structure : Parsetree.structure ast_checker - - val find_binding : Parsetree.structure -> string -> (Parsetree.expression -> Learnocaml_report.t) -> Learnocaml_report.t - - val forbid : string -> ('a -> string) -> 'a list -> ('a -> Learnocaml_report.t) - val restrict : string -> ('a -> string) -> 'a list -> ('a -> Learnocaml_report.t) - val require : string -> ('a -> string) -> 'a -> ('a -> Learnocaml_report.t) - - val forbid_expr : string -> Parsetree.expression list -> (Parsetree.expression -> Learnocaml_report.t) - val restrict_expr : string -> Parsetree.expression list -> (Parsetree.expression -> Learnocaml_report.t) - val require_expr : string -> Parsetree.expression -> (Parsetree.expression -> Learnocaml_report.t) - val forbid_syntax : string -> (_ -> Learnocaml_report.t) - val require_syntax : string -> (_ -> Learnocaml_report.t) - - val ast_sanity_check : ?modules: string list -> Parsetree.structure -> (unit -> Learnocaml_report.t) -> Learnocaml_report.t - - end - - (*----------------------------------------------------------------------------*) - - type 'a tester = - 'a Ty.ty -> 'a result -> 'a result -> Learnocaml_report.t - - type io_tester = - string -> string -> Learnocaml_report.t - - type io_postcond = - string -> Learnocaml_report.t - - exception Timeout of int - - (*----------------------------------------------------------------------------*) - - module Tester : sig - - val test : 'a tester - val test_ignore : 'a tester - val test_eq : ('a result -> 'a result -> bool) -> 'a tester - val test_eq_ok : ('a -> 'a -> bool) -> 'a tester - val test_eq_exn : (exn -> exn -> bool) -> 'a tester - val test_canon : ('a result -> 'a result) -> 'a tester - val test_canon_ok : ('a -> 'a) -> 'a tester - val test_canon_error : (exn -> exn) -> 'a tester - val test_translate : ('a -> 'b) -> 'b tester -> 'b Ty.ty -> 'a tester - - val io_test_ignore : io_tester - val io_test_equals : - ?trim: char list -> ?drop: char list -> io_tester - val io_test_lines : - ?trim: char list -> ?drop: char list -> - ?skip_empty: bool -> ?test_line: io_tester -> io_tester - val io_test_items : - ?split: char list -> ?trim: char list -> ?drop: char list -> - ?skip_empty: bool -> ?test_item: io_tester -> io_tester - - end - - (*----------------------------------------------------------------------------*) - - module Mutation : sig - - type 'arg arg_mutation_test_callbacks = - { before_reference : 'arg -> unit ; - before_user : 'arg -> unit ; - test : 'ret. ?test_result: 'ret tester -> 'ret tester } - - val arg_mutation_test_callbacks: - ?test: 'a tester -> dup: ('a -> 'a) -> blit:('a -> 'a -> unit) -> 'a Ty.ty -> - 'a arg_mutation_test_callbacks - - val array_arg_mutation_test_callbacks: - ?test: 'a array tester -> 'a array Ty.ty -> - 'a array arg_mutation_test_callbacks - - val ref_arg_mutation_test_callbacks: - ?test: 'a ref tester -> 'a ref Ty.ty -> - 'a ref arg_mutation_test_callbacks - - end - - (*----------------------------------------------------------------------------*) - - module Sampler : sig - type 'a sampler = unit -> 'a - val sample_int : int sampler - val sample_float : float sampler - val sample_string : string sampler - val sample_char : char sampler - val sample_bool : bool sampler - val sample_list : ?min_size: int -> ?max_size: int -> ?dups: bool -> ?sorted: bool -> 'a sampler -> 'a list sampler - val sample_array : ?min_size: int -> ?max_size: int -> ?dups: bool -> ?sorted: bool -> 'a sampler -> 'a array sampler - val sample_pair : 'a sampler -> 'b sampler -> ('a * 'b) sampler - val sample_alternatively : 'a sampler list -> 'a sampler - val sample_cases : 'a list -> 'a sampler - val sample_option : 'a sampler -> 'a option sampler - - val printable_fun : string -> (_ -> _ as 'f) -> 'f - end - -(*----------------------------------------------------------------------------*) - - module Test_functions_ref_var : sig - - val test_ref : - 'a Ty.ty -> 'a ref -> 'a -> Learnocaml_report.t - - val test_variable : - 'a Ty.ty -> string -> 'a -> Learnocaml_report.t - - val test_variable_property : - 'a Ty.ty -> string -> ('a -> Learnocaml_report.t) -> Learnocaml_report.t - - val test_variable_against_solution : - 'a Ty.ty -> string -> Learnocaml_report.t - - end - - (*----------------------------------------------------------------------------*) - - module Test_functions_types : sig - val compatible_type : expected:string -> string -> Learnocaml_report.t - - val existing_type : ?score:int -> string -> bool * Learnocaml_report.t - - val abstract_type : ?allow_private:bool -> ?score:int -> string -> bool * Learnocaml_report.t - - val test_student_code : 'a Ty.ty -> ('a -> Learnocaml_report.t) -> Learnocaml_report.t - - val test_module_property : - 'a Ty.ty -> string -> ('a -> Learnocaml_report.t) -> Learnocaml_report.t - end - - (*----------------------------------------------------------------------------*) - - module Test_functions_function : sig - - val test_function_1 : - ?test: 'b tester -> - ?test_stdout: io_tester -> - ?test_stderr: io_tester -> - ?before : ('a -> unit) -> - ?after : ('a -> ('b * string * string) -> ('b * string * string) -> Learnocaml_report.t) -> - ('a -> 'b) Ty.ty -> string -> ('a * 'b * string * string) list -> Learnocaml_report.t - - val test_function_1_against : - ?gen: int -> - ?test: 'b tester -> - ?test_stdout: io_tester -> - ?test_stderr: io_tester -> - ?before_reference : ('a -> unit) -> - ?before_user : ('a -> unit) -> - ?after : ('a -> ('b * string * string) -> ('b * string * string) -> Learnocaml_report.t) -> - ?sampler : (unit -> 'a) -> - ('a -> 'b) Ty.ty -> string -> ('a -> 'b) -> 'a list -> Learnocaml_report.t - - val test_function_1_against_solution : - ?gen: int -> - ?test: 'b tester -> - ?test_stdout: io_tester -> - ?test_stderr: io_tester -> - ?before_reference : ('a -> unit) -> - ?before_user : ('a -> unit) -> - ?after : ('a -> ('b * string * string) -> ('b * string * string) -> Learnocaml_report.t) -> - ?sampler : (unit -> 'a) -> - ('a -> 'b) Ty.ty -> string -> 'a list -> Learnocaml_report.t - - val test_function_1_against_postcond : - ?gen: int -> - ?test_stdout: io_postcond -> - ?test_stderr: io_postcond -> - ?before_reference : ('a -> unit) -> - ?before_user : ('a -> unit) -> - ?after : ('a -> ('b * string * string) -> Learnocaml_report.t) -> - ?sampler : (unit -> 'a) -> - ('a -> 'b Ty.ty -> 'b result -> Learnocaml_report.t) -> - ('a -> 'b) Ty.ty -> string -> 'a list -> Learnocaml_report.t - - (*----------------------------------------------------------------------------*) - - val test_function_2 : - ?test: 'c tester -> - ?test_stdout: io_tester -> - ?test_stderr: io_tester -> - ?before : ('a -> 'b -> unit) -> - ?after : ('a -> 'b -> ('c * string * string) -> ('c * string * string) -> Learnocaml_report.t) -> - ('a -> 'b -> 'c) Ty.ty -> string -> ('a * 'b * 'c * string * string) list -> Learnocaml_report.t - - val test_function_2_against : - ?gen: int -> - ?test: 'c tester -> - ?test_stdout: io_tester -> - ?test_stderr: io_tester -> - ?before_reference : ('a -> 'b -> unit) -> - ?before_user : ('a -> 'b -> unit) -> - ?after : ('a -> 'b -> ('c * string * string) -> ('c * string * string) -> Learnocaml_report.t) -> - ?sampler : (unit -> 'a * 'b) -> - ('a -> 'b -> 'c) Ty.ty -> string -> ('a -> 'b -> 'c) -> ('a * 'b) list -> Learnocaml_report.t - - val test_function_2_against_solution : - ?gen: int -> - ?test: 'c tester -> - ?test_stdout: io_tester -> - ?test_stderr: io_tester -> - ?before_reference : ('a -> 'b -> unit) -> - ?before_user : ('a -> 'b -> unit) -> - ?after : ('a -> 'b -> ('c * string * string) -> ('c * string * string) -> Learnocaml_report.t) -> - ?sampler : (unit -> 'a * 'b) -> - ('a -> 'b -> 'c) Ty.ty -> string -> ('a * 'b) list -> Learnocaml_report.t - - val test_function_2_against_postcond : - ?gen: int -> - ?test_stdout: io_postcond -> - ?test_stderr: io_postcond -> - ?before_reference : ('a -> 'b -> unit) -> - ?before_user : ('a -> 'b -> unit) -> - ?after : ('a -> 'b -> ('c * string * string) -> Learnocaml_report.t) -> - ?sampler : (unit -> 'a * 'b) -> - ('a -> 'b -> 'c Ty.ty -> 'c result -> Learnocaml_report.t) -> - ('a -> 'b -> 'c) Ty.ty -> string -> ('a * 'b) list -> Learnocaml_report.t - - (*----------------------------------------------------------------------------*) - - val test_function_3 : - ?test: 'd tester -> - ?test_stdout: io_tester -> - ?test_stderr: io_tester -> - ?before : ('a -> 'b -> 'c -> unit) -> - ?after : ('a -> 'b -> 'c -> ('d * string * string) -> ('d * string * string) -> Learnocaml_report.t) -> - ('a -> 'b -> 'c -> 'd) Ty.ty -> string -> ('a * 'b * 'c * 'd * string * string) list -> Learnocaml_report.t - - val test_function_3_against : - ?gen: int -> - ?test: 'd tester -> - ?test_stdout: io_tester -> - ?test_stderr: io_tester -> - ?before_reference : ('a -> 'b -> 'c -> unit) -> - ?before_user : ('a -> 'b -> 'c -> unit) -> - ?after : ('a -> 'b -> 'c -> ('d * string * string) -> ('d * string * string) -> Learnocaml_report.t) -> - ?sampler : (unit -> 'a * 'b * 'c) -> - ('a -> 'b -> 'c -> 'd) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd) -> ('a * 'b * 'c) list -> Learnocaml_report.t - - val test_function_3_against_solution : - ?gen: int -> - ?test: 'd tester -> - ?test_stdout: io_tester -> - ?test_stderr: io_tester -> - ?before_reference : ('a -> 'b -> 'c -> unit) -> - ?before_user : ('a -> 'b -> 'c -> unit) -> - ?after : ('a -> 'b -> 'c -> ('d * string * string) -> ('d * string * string) -> Learnocaml_report.t) -> - ?sampler : (unit -> 'a * 'b * 'c) -> - ('a -> 'b -> 'c -> 'd) Ty.ty -> string -> ('a * 'b * 'c) list -> Learnocaml_report.t - - val test_function_3_against_postcond : - ?gen: int -> - ?test_stdout: io_postcond -> - ?test_stderr: io_postcond -> - ?before_reference : ('a -> 'b -> 'c -> unit) -> - ?before_user : ('a -> 'b -> 'c -> unit) -> - ?after : ('a -> 'b -> 'c -> ('d * string * string) -> Learnocaml_report.t) -> - ?sampler : (unit -> 'a * 'b * 'c) -> - ('a -> 'b -> 'c -> 'd Ty.ty -> 'd result -> Learnocaml_report.t) -> - ('a -> 'b -> 'c -> 'd) Ty.ty -> string -> ('a * 'b * 'c) list -> Learnocaml_report.t - - (*----------------------------------------------------------------------------*) - - val test_function_4 : - ?test: 'e tester -> - ?test_stdout: io_tester -> - ?test_stderr: io_tester -> - ?before : ('a -> 'b -> 'c -> 'd -> unit) -> - ?after : ('a -> 'b -> 'c -> 'd -> ('e * string * string) -> ('e * string * string) -> Learnocaml_report.t) -> - ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty -> string -> ('a * 'b * 'c * 'd * 'e * string * string) list -> Learnocaml_report.t - - val test_function_4_against : - ?gen: int -> - ?test: 'e tester -> - ?test_stdout: io_tester -> - ?test_stderr: io_tester -> - ?before_reference : ('a -> 'b -> 'c -> 'd -> unit) -> - ?before_user : ('a -> 'b -> 'c -> 'd -> unit) -> - ?after : ('a -> 'b -> 'c -> 'd -> ('e * string * string) -> ('e * string * string) -> Learnocaml_report.t) -> - ?sampler : (unit -> 'a * 'b * 'c * 'd) -> - ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty -> string -> ('a -> 'b -> 'c -> 'd -> 'e) - -> ('a * 'b * 'c * 'd) list -> Learnocaml_report.t - - val test_function_4_against_solution : - ?gen: int -> - ?test: 'e tester -> - ?test_stdout: io_tester -> - ?test_stderr: io_tester -> - ?before_reference : ('a -> 'b -> 'c -> 'd -> unit) -> - ?before_user : ('a -> 'b -> 'c -> 'd -> unit) -> - ?after : ('a -> 'b -> 'c -> 'd -> ('e * string * string) -> ('e * string * string) -> Learnocaml_report.t) -> - ?sampler : (unit -> 'a * 'b * 'c * 'd) -> - ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty -> string -> ('a * 'b * 'c * 'd) list -> Learnocaml_report.t - - val test_function_4_against_postcond : - ?gen: int -> - ?test_stdout: io_postcond -> - ?test_stderr: io_postcond -> - ?before_reference : ('a -> 'b -> 'c -> 'd -> unit) -> - ?before_user : ('a -> 'b -> 'c -> 'd -> unit) -> - ?after : ('a -> 'b -> 'c -> 'd -> ('e * string * string) -> Learnocaml_report.t) -> - ?sampler : (unit -> 'a * 'b * 'c * 'd) -> - ('a -> 'b -> 'c -> 'd -> 'e Ty.ty -> 'e result -> Learnocaml_report.t) -> - ('a -> 'b -> 'c -> 'd -> 'e) Ty.ty -> string -> ('a * 'b * 'c * 'd) list -> Learnocaml_report.t - - end - - (*----------------------------------------------------------------------------*) - - module Test_functions_generic : sig - - val run_timeout : ?time:int -> (unit -> 'a) -> 'a - - val exec : (unit -> 'a) -> ('a * string * string) result - - val result : (unit -> 'a) -> 'a result - - (*----------------------------------------------------------------------------*) - - include (module type of Fun_ty - with type ('a, 'b, 'c) args = ('a, 'b, 'c) Fun_ty.args - and type ('a, 'b, 'c) fun_ty = ('a, 'b, 'c) Fun_ty.fun_ty) - - val ty_of_prot : - (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty -> ('ar -> 'row) Ty.ty - [@@ocaml.deprecated "Use ty_of_fun_ty instead."] - - type 'a lookup = unit -> [ `Found of string * Learnocaml_report.t * 'a | `Unbound of string * Learnocaml_report.t ] - - val lookup : 'a Ty.ty -> ?display_name: string -> string -> 'a lookup - val lookup_student : 'a Ty.ty -> string -> 'a lookup - val lookup_solution : 'a Ty.ty -> string -> 'a lookup - val found : string -> 'a -> 'a lookup - val name : 'a lookup -> string - - val test_value : 'a lookup -> ('a -> Learnocaml_report.t) -> Learnocaml_report.t - - val test_function : - ?test: 'ret tester -> - ?test_stdout: io_tester -> - ?test_stderr: io_tester -> - ?before : - (('ar -> 'row, 'ar -> 'urow, 'ret) args -> - unit) -> - ?after : - (('ar -> 'row, 'ar -> 'urow, 'ret) args -> - ('ret * string * string) -> - ('ret * string * string) -> - Learnocaml_report.t) -> - (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty -> - ('ar -> 'row) lookup -> - (('ar -> 'row, 'ar -> 'urow, 'ret) args * (unit -> 'ret)) list -> - Learnocaml_report.t - - val test_function_against : - ?gen: int -> - ?test: 'ret tester -> - ?test_stdout: io_tester -> - ?test_stderr: io_tester -> - ?before_reference : - (('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) -> - ?before_user : - (('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) -> - ?after : - (('ar -> 'row, 'ar -> 'urow, 'ret) args -> - ('ret * string * string) -> - ('ret * string * string) -> - Learnocaml_report.t) -> - ?sampler: - (unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) args) -> - (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty -> - ('ar -> 'row) lookup -> ('ar -> 'row) lookup -> - ('ar -> 'row, 'ar -> 'urow, 'ret) args list -> - Learnocaml_report.t - - val test_function_against_solution : - ?gen:int -> - ?test: 'ret tester -> - ?test_stdout: io_tester -> - ?test_stderr: io_tester -> - ?before_reference: - (('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) -> - ?before_user: - (('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) -> - ?after: - (('ar -> 'row, 'ar -> 'urow, 'ret) args -> - 'ret * string * string -> - 'ret * string * string -> - Learnocaml_report.item list) -> - ?sampler: - (unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) args) -> - (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty -> - string -> - ('ar -> 'row, 'ar -> 'urow, 'ret) args list -> - Learnocaml_report.item list - - val (==>) : 'params -> 'ret -> 'params * (unit -> 'ret) - - end - - val (@@@) : ('a -> Learnocaml_report.t) -> ('a -> Learnocaml_report.t) -> ('a -> Learnocaml_report.t) - val (@@>) : Learnocaml_report.t -> (unit -> Learnocaml_report.t) -> Learnocaml_report.t - val (@@=) : Learnocaml_report.t -> (unit -> Learnocaml_report.t) -> Learnocaml_report.t - - (**/**) - include (module type of Ast_checker) - include (module type of Tester) - include (module type of Mutation) - include (module type of Sampler) - include (module type of Test_functions_types) - include (module type of Test_functions_ref_var) - include (module type of Test_functions_function) - include (module type of Test_functions_generic) - -end - -module Make - (Params : sig - val results : Learnocaml_report.t option ref - (* val set_progress : string -> unit *) - val timeout : int option - module Introspection : Introspection_intf.INTROSPECTION - end) : S = struct +module Intro = Pre_test.Introspection let set_result report = - Params.results := Some report + Pre_test.results := Some report type nonrec 'a result = ('a, exn) result @@ -818,24 +372,24 @@ module Make (*----------------------------------------------------------------------------*) module Test_functions_types = struct - open Params + open Pre_test let compatible_type ~expected:exp got = let open Learnocaml_report in [ Message ([ Text "Checking that " ; Code got ; Text "is compatible with " ; Code exp ], Informative) ; - match Introspection.compatible_type exp ("Code." ^ got) with - | Introspection.Absent -> + match Intro.compatible_type exp ("Code." ^ got) with + | Intro.Absent -> Message ([ Text "Type not found" ], Failure) - | Introspection.Incompatible msg -> + | Intro.Incompatible msg -> Message ([ Text msg ], Failure) - | Introspection.Present () -> + | Intro.Present () -> Message ([ Text "Type found and compatible" ], Success 5) ] let existing_type ?(score = 1) name = let open Learnocaml_report in try - let lid = Longident.parse ("Code." ^ name) in + let[@alert "-deprecated"] lid = Longident.parse ("Code." ^ name) in let path, _ = Env.find_type_by_name lid !Toploop.toplevel_env in let _ = Env.find_type path !Toploop.toplevel_env in true, [ Message ( [ Text "Type" ; Code name ; Text "found" ], Success score ) ] @@ -844,7 +398,7 @@ module Make let abstract_type ?(allow_private = true) ?(score = 5) name = let open Learnocaml_report in try - let lid = Longident.parse ("Code." ^ name) in + let[@alert "-deprecated"] lid = Longident.parse ("Code." ^ name) in let path, _ = Env.find_type_by_name lid !Toploop.toplevel_env in match Env.find_type path !Toploop.toplevel_env with | { Types. type_kind = Types.Type_abstract ; Types. type_manifest = None; _ } -> @@ -857,20 +411,20 @@ module Make let test_student_code ty cb = let open Learnocaml_report in - match Introspection.get_value "Code" ty with - | Introspection.Present v -> cb v - | Introspection.Absent -> assert false - | Introspection.Incompatible msg -> + match Intro.get_value "Code" ty with + | Intro.Present v -> cb v + | Intro.Absent -> assert false + | Intro.Incompatible msg -> [ Message ([ Text "Your code doesn't match the expected signature." ; Break ; Code msg (* TODO: hide or fix locations *) ], Failure) ] let test_module_property ty name cb = let open Learnocaml_report in - match Introspection.get_value ("Code." ^ name) ty with - | Introspection.Present v -> cb v - | Introspection.Absent -> + match Intro.get_value ("Code." ^ name) ty with + | Intro.Present v -> cb v + | Intro.Absent -> [ Message ([ Text "Module" ; Code name ; Text "not found." ], Failure) ] - | Introspection.Incompatible msg -> + | Intro.Incompatible msg -> [ Message ([ Text "Module" ; Code name ; Text "doesn't match the expected signature." ; Break ; Code msg (* TODO: hide or fix locations *) ], Failure) ] @@ -888,7 +442,7 @@ module Make string -> Learnocaml_report.t let typed_printer ty ppf v = - Introspection.print_value ppf v ty + Intro.print_value ppf v ty exception Timeout of int @@ -1122,7 +676,7 @@ module Make (*----------------------------------------------------------------------------*) module Test_functions_generic = struct - open Params + open Pre_test open Tester let sigalrm_handler time = @@ -1139,23 +693,23 @@ module Make reset_sigalrm (); raise exc let run_timeout ?time v = - match time, Params.timeout with + match time, Pre_test.timeout with | Some time, _ | None, Some time -> run_timeout ~time v | None, None -> v() let exec v = - Introspection.grab_stdout () ; - Introspection.grab_stderr () ; + Intro.grab_stdout () ; + Intro.grab_stderr () ; try let res = run_timeout v in - let out = Introspection.release_stdout () in - let err = Introspection.release_stderr () in + let out = Intro.release_stdout () in + let err = Intro.release_stderr () in Ok (res, out, err) with exn -> - ignore (Introspection.release_stdout ()) ; - ignore (Introspection.release_stderr ()) ; + ignore (Intro.release_stdout ()) ; + ignore (Intro.release_stderr ()) ; Error exn let result v = match exec v with @@ -1212,7 +766,7 @@ module Make module Aux = struct let typed_printer = typed_printer - let typed_sampler = Introspection.get_sampler + let typed_sampler = Intro.get_sampler end module FunTyAux = Make(Aux) @@ -1223,16 +777,16 @@ module Make let lookup ty ?display_name name = let display_name = match display_name with None -> name | Some name -> name in let open Learnocaml_report in - let res = match Introspection.get_value name ty with - | Introspection.Present v -> + let res = match Intro.get_value name ty with + | Intro.Present v -> let msg = [ Message ([ Text "Found" ; Code display_name ; Text "with compatible type." ], Informative) ] in `Found (display_name, msg, v) - | Introspection.Absent -> + | Intro.Absent -> `Unbound (name, [ Message ([ Text "Cannot find " ; Code display_name ], Failure) ]) - | Introspection.Incompatible msg -> + | Intro.Incompatible msg -> `Unbound (name, [ Message ([ Text "Found" ; Code display_name ; Text "with unexpected type:" ; Break ; @@ -1241,16 +795,16 @@ module Make let lookup_student ty name = let open Learnocaml_report in - let res = match Introspection.get_value ("Code." ^ name) ty with - | Introspection.Present v -> + let res = match Intro.get_value ("Code." ^ name) ty with + | Intro.Present v -> let msg = [ Message ([ Text "Found" ; Code name ; Text "with compatible type." ], Informative) ] in `Found (name, msg, v) - | Introspection.Absent -> + | Intro.Absent -> `Unbound (name, [ Message ([ Text "Cannot find " ; Code name ], Failure) ]) - | Introspection.Incompatible msg -> + | Intro.Incompatible msg -> `Unbound (name, [ Message ([ Text "Found" ; Code name ; Text "with unexpected type:" ; Break ; @@ -1259,14 +813,14 @@ module Make let lookup_solution ty name = let open Learnocaml_report in - let res = match Introspection.get_value ("Solution." ^ name) ty with - | Introspection.Present v -> + let res = match Intro.get_value ("Solution." ^ name) ty with + | Intro.Present v -> `Found (name, [], v) - | Introspection.Absent -> + | Intro.Absent -> `Unbound (name, [ Message ([ Text "Looking for " ; Code name ], Informative) ; Message ([ Text "Solution not found!" ], Failure) ]) - | Introspection.Incompatible msg -> + | Intro.Incompatible msg -> `Unbound (name, [ Message ([ Text "Looking for " ; Code name ], Informative) ; Message ([ Text "Solution is wrong!" ; Break ; Code msg ], Failure) ]) in @@ -1772,10 +1326,16 @@ module Make if sorted then Array.sort compare arr ; arr + let sample_list sample () = + (* version without parameters for ppx_autoregister *) + Array.to_list (sample_array sample ()) + let sample_list ?min_size ?max_size ?dups ?sorted sample () = Array.to_list (sample_array ?min_size ?max_size ?dups ?sorted sample ()) - let sample_pair sample1 sample2 () = + type ('a, 'b) pair = 'a * 'b + let sample_pair: 'a sampler -> 'b sampler -> ('a, 'b) pair sampler = + fun sample1 sample2 () -> (sample1 (), sample2 ()) let printable_funs = ref [] @@ -1797,7 +1357,22 @@ module Make let () = let path = Path.Pident (Ident.create_local "fun_printer") in let ty = Typetexp.transl_type_scheme !Toploop.toplevel_env (Ty.obj [%ty: _ -> _ ]) in - Toploop.install_printer path ty.Typedtree.ctyp_type fun_printer + Intro.install_printer path ty.Typedtree.ctyp_type fun_printer + end + module Sampler_reg = struct + include Sampler + let () = Intro.register_sampler "Test_lib.Sampler_reg" "sample_bool" "bool" sample_bool + let () = Intro.register_sampler "Test_lib.Sampler_reg" "sample_int" "int" sample_int + let () = Intro.register_sampler "Test_lib.Sampler_reg" "sample_float" "float" sample_float + let () = Intro.register_sampler "Test_lib.Sampler_reg" "sample_char" "char" sample_char + let () = Intro.register_sampler "Test_lib.Sampler_reg" "sample_string" "string" sample_string + let () = Intro.register_sampler "Test_lib.Sampler_reg" "sample_option" "option" sample_option + let sample_array sample () = sample_array sample () + let () = Intro.register_sampler "Test_lib.Sampler_reg" "sample_array" "array" sample_array + let sample_list sample () = sample_list sample () + let () = Intro.register_sampler "Test_lib.Sampler_reg" "sample_list" "list" sample_list + type ('a, 'b) pair = 'a * 'b + let () = Intro.register_sampler "Test_lib.Sampler_reg" "sample_pair" "pair" sample_pair end let (@@@) f g = fun x -> f x @ g x @@ -1814,7 +1389,12 @@ module Make include Test_functions_function include Test_functions_generic -end +(* end *) let () = Random.self_init () + +module Open_me = struct + module Report = Learnocaml_report + include Pre_test +end diff --git a/src/grader/test_lib.mli b/src/grader/test_lib.mli index 7d736127f..d6c14543d 100644 --- a/src/grader/test_lib.mli +++ b/src/grader/test_lib.mli @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -8,7 +8,6 @@ (** Documentation for [test_lib] library. [Test_lib] module can be used to write graders for learn-ocaml. *) -module type S = sig val set_result : Learnocaml_report.t -> unit @@ -498,6 +497,21 @@ module type S = sig val printable_fun : string -> (_ -> _ as 'f) -> 'f end + (** For internal use, needed for the default samplers registration *) + module Sampler_reg : sig + type 'a sampler = 'a Sampler.sampler + val sample_int : int sampler + val sample_float : float sampler + val sample_string : string sampler + val sample_char : char sampler + val sample_bool : bool sampler + val sample_list : 'a sampler -> 'a list sampler + val sample_array : 'a sampler -> 'a array sampler + val sample_option : 'a sampler -> 'a option sampler + type ('a, 'b) pair = 'a * 'b + val sample_pair : 'a sampler -> 'b sampler -> ('a, 'b) pair sampler + end + (** {1 Grading functions for references and variables } *) (** Grading function for variables and references. *) @@ -1248,12 +1262,18 @@ module type S = sig include (module type of Test_functions_ref_var) include (module type of Test_functions_function) include (module type of Test_functions_generic) +(* end *) + +(* module Make : functor + * (_ : sig + * val results : Learnocaml_report.t option ref + * val set_progress : string -> unit + * val timeout : int option + * module Introspection : Introspection_intf.INTROSPECTION + * end) -> S *) +(* module Report = Learnocaml_report + * include (module type of Pre_test) *) +module Open_me: sig + module Report = Learnocaml_report + include module type of Pre_test end - -module Make : functor - (_ : sig - val results : Learnocaml_report.t option ref - val set_progress : string -> unit - val timeout : int option - module Introspection : Introspection_intf.INTROSPECTION - end) -> S diff --git a/src/grader/test_lib/dune b/src/grader/test_lib/dune new file mode 100644 index 000000000..ef6511b32 --- /dev/null +++ b/src/grader/test_lib/dune @@ -0,0 +1,30 @@ +;; cmis that are needed to precompile the graders for exercises + +(rule + (alias test_lib_cmis) + (action (progn + (copy %{dep:../../ppx-metaquot/.ty.objs/byte/ty.cmi} ty.cmi) + (copy %{dep:../../ppx-metaquot/.fun_ty.objs/byte/fun_ty.cmi} fun_ty.cmi) + ;; (copy %{dep:../.exercise_init.objs/byte/exercise_init.cmi} exercise_init.cmi) + (copy %{dep:../.introspection_intf.objs/byte/introspection_intf.cmi} introspection_intf.cmi) + (copy %{dep:../.pre_test.objs/byte/learnocaml_internal.cmi} learnocaml_internal.cmi) + (copy %{dep:../.pre_test.objs/byte/pre_test.cmi} pre_test.cmi) + (copy %{dep:../.learnocaml_report.objs/byte/learnocaml_report.cmi} learnocaml_report.cmi) + (copy %{dep:../.pre_test.objs/byte/learnocaml_callback.cmi} learnocaml_callback.cmi) + (copy %{dep:../.testing_dyn.objs/byte/test_lib.cmi} test_lib.cmi))) +) + +(install + (section lib) + (package learn-ocaml) + (files + (ty.cmi as test_lib/ty.cmi) + (fun_ty.cmi as test_lib/fun_ty.cmi) + ;; (exercise_init.cmi as test_lib/exercise_init.cmi) + (introspection_intf.cmi as test_lib/introspection_intf.cmi) + (learnocaml_internal.cmi as test_lib/learnocaml_internal.cmi) + (pre_test.cmi as test_lib/pre_test.cmi) + (learnocaml_report.cmi as test_lib/learnocaml_report.cmi) + (learnocaml_callback.cmi as test_lib/learnocaml_callback.cmi) + (test_lib.cmi as test_lib/test_lib.cmi)) +) diff --git a/src/main/learnocaml_client.ml b/src/main/learnocaml_client.ml index f5ab864f4..cb1cb8dbc 100644 --- a/src/main/learnocaml_client.ml +++ b/src/main/learnocaml_client.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -484,7 +484,7 @@ let fetch server_url req = | Error (`Failure s) -> Lwt.fail_with ("Server request failed: "^ s) let fetch_exercise server_url token id = - Lwt.catch (fun () -> fetch server_url (Api.Exercise (token, id))) + Lwt.catch (fun () -> fetch server_url (Api.Exercise (token, id, false))) @@ function | Not_found -> Printf.ksprintf Lwt.fail_with @@ -792,13 +792,9 @@ module Grade = struct pr `Cyan "outcome" ex_outcome; if eo.verbosity >= 1 then prerr_newline (); match report with - | Error e -> - let str = - match Grading.string_of_exn e with - | Some s -> s - | None -> Printexc.to_string e - in - Printf.eprintf "[ERROR] Could not do the grading:\n%s\n" str; + | Error err -> + Printf.eprintf "[ERROR] Could not do the grading:\n%s\n" + (Grading.string_of_err err); Lwt.return 10 | Ok report -> (match eo.output_format with diff --git a/src/main/learnocaml_main.ml b/src/main/learnocaml_main.ml index 07f468717..4bc49bad4 100644 --- a/src/main/learnocaml_main.ml +++ b/src/main/learnocaml_main.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -111,38 +111,40 @@ module Args = struct type t = { exercises: string list; output_json: string option; + display_callback: bool; + dump_outputs: string option; + dump_reports: string option; } let grader_conf = - let apply exercises output_json = + let apply exercises output_json quiet dump_outputs dump_reports = let exercises = List.flatten exercises in - { exercises; output_json } + { exercises; output_json; display_callback = not quiet; + dump_outputs; dump_reports } in - Term.(const apply $exercises $output_json) + Term.(const apply $exercises $output_json $quiet $dump_outputs $dump_reports) let grader_cli = let apply - grade_student display_outcomes quiet display_std_outputs - dump_outputs dump_reports timeout verbose dump_dot + grade_student display_outcomes display_std_outputs + timeout verbose dump_dot = Grader_cli.grade_student := grade_student; Grader_cli.display_outcomes := display_outcomes; - Grader_cli.display_callback := not quiet; Grader_cli.display_std_outputs := display_std_outputs; - Grader_cli.dump_outputs := dump_outputs; - Grader_cli.dump_reports := dump_reports; Grader_cli.individual_timeout := timeout; Grader_cli.display_reports := verbose; Grader_cli.dump_dot := dump_dot; - Learnocaml_process_exercise_repository.dump_outputs := dump_outputs; - Learnocaml_process_exercise_repository.dump_reports := dump_reports; () in - Term.(const apply $grade_student $display_outcomes $quiet $display_std_outputs - $dump_outputs $dump_reports $timeout $verbose $dump_dot) + Term.(const apply $grade_student $display_outcomes $display_std_outputs + $timeout $verbose $dump_dot) let term = - let apply conf () = conf in + let apply conf () = + Learnocaml_process_exercise_repository.dump_outputs := conf.dump_outputs; + Learnocaml_process_exercise_repository.dump_reports := conf.dump_reports; + conf in Term.(const apply $grader_conf $grader_cli) end @@ -192,7 +194,7 @@ module Args = struct the entire repository. Can be repeated." let jobs = - value & opt int 1 & info ["jobs";"j"] ~docv:"INT" ~doc: + value & opt int 8 & info ["jobs";"j"] ~docv:"INT" ~doc: "Number of building jobs to run in parallel" type t = { @@ -307,7 +309,11 @@ let main o = in Lwt.catch (fun () -> - Grader_cli.grade_from_dir ~print_result:true ex json_output + Grader_cli.grade_from_dir ~print_result:true + ~dump_outputs:o.grader.Grader.dump_outputs + ~dump_reports:o.grader.Grader.dump_reports + ~display_callback:o.grader.Grader.display_callback + ex json_output >|= function Ok () -> i | Error _ -> 1) (fun e -> Printf.ksprintf failwith diff --git a/src/main/learnocaml_server_args.ml b/src/main/learnocaml_server_args.ml index 8b3c10784..f089df0ae 100644 --- a/src/main/learnocaml_server_args.ml +++ b/src/main/learnocaml_server_args.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -79,4 +79,4 @@ module Args (SN : Section_name) = struct calling the native server from learn-ocaml main *) Term.(const apply $ app_dir $ sync_dir $ base_url $ port $ cert) -end \ No newline at end of file +end diff --git a/src/main/learnocaml_server_main.ml b/src/main/learnocaml_server_main.ml index aad5b1199..00fccac88 100644 --- a/src/main/learnocaml_server_main.ml +++ b/src/main/learnocaml_server_main.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/ppx-metaquot/dune b/src/ppx-metaquot/dune index bb9b4fbb8..94de62ada 100644 --- a/src/ppx-metaquot/dune +++ b/src/ppx-metaquot/dune @@ -21,13 +21,44 @@ ) (library - (name learnocaml_ppx_metaquot) + (name ppx_autoregister) (wrapped false) - (libraries learnocaml_ppx_metaquot_lib ty fun_ty ocaml-migrate-parsetree) - (modules Ppx_metaquot_main) + (libraries ppxlib) + (modules Ppx_autoregister Printer_recorder)) + +(library + (name exercise_ppx) + (wrapped false) + (libraries ppx_autoregister) + (modules Exercise_ppx) + (kind ppx_rewriter) +) + +(library + (name grader_ppx) + (wrapped false) + (libraries learnocaml_ppx_metaquot_lib ty fun_ty ppx_autoregister) + (modules Sampler_recorder Grader_ppx) (kind ppx_rewriter) ) +(executable + (name exercise_ppx_main) + (modules exercise_ppx_main) + (libraries exercise_ppx)) + +(executable + (name grader_ppx_main) + (modules grader_ppx_main) + (libraries grader_ppx)) + +(install + (section libexec) + (package learn-ocaml) + (files (exercise_ppx_main.exe as test_lib/exercise-ppx) + (grader_ppx_main.exe as test_lib/grader-ppx)) +) + (library (name ty) (wrapped false) diff --git a/src/ppx-metaquot/exercise_ppx.ml b/src/ppx-metaquot/exercise_ppx.ml new file mode 100644 index 000000000..02714053b --- /dev/null +++ b/src/ppx-metaquot/exercise_ppx.ml @@ -0,0 +1,9 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2022-2023 OCaml Software Foundation. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +let () = + Ppxlib.Driver.register_transformation "print_recorder" ~impl:Printer_recorder.expand diff --git a/src/ppx-metaquot/exercise_ppx_main.ml b/src/ppx-metaquot/exercise_ppx_main.ml new file mode 100644 index 000000000..729261994 --- /dev/null +++ b/src/ppx-metaquot/exercise_ppx_main.ml @@ -0,0 +1,9 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2022-2023 OCaml Software Foundation. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +let () = + Migrate_parsetree.Driver.run_main ~exit_on_error:true () diff --git a/src/ppx-metaquot/fun_ty.ml b/src/ppx-metaquot/fun_ty.ml index 2d41330d5..0b8e31910 100644 --- a/src/ppx-metaquot/fun_ty.ml +++ b/src/ppx-metaquot/fun_ty.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/ppx-metaquot/grader_ppx.ml b/src/ppx-metaquot/grader_ppx.ml new file mode 100644 index 000000000..15e936df0 --- /dev/null +++ b/src/ppx-metaquot/grader_ppx.ml @@ -0,0 +1,12 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2022-2023 OCaml Software Foundation. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +let () = + Migrate_parsetree.Driver.register ~name:"ppx_metaquot" (module Migrate_parsetree.OCaml_412) + (fun _config _cookies -> Ppx_metaquot.Main.expander []); + Ppxlib.Driver.register_transformation "print_recorder" ~impl:Printer_recorder.expand; + Ppxlib.Driver.register_transformation "sample_recorder" ~impl:Sampler_recorder.expand diff --git a/src/ppx-metaquot/grader_ppx_main.ml b/src/ppx-metaquot/grader_ppx_main.ml new file mode 100644 index 000000000..729261994 --- /dev/null +++ b/src/ppx-metaquot/grader_ppx_main.ml @@ -0,0 +1,9 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2022-2023 OCaml Software Foundation. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +let () = + Migrate_parsetree.Driver.run_main ~exit_on_error:true () diff --git a/src/ppx-metaquot/ppx_autoregister.ml b/src/ppx-metaquot/ppx_autoregister.ml new file mode 100644 index 000000000..d38ae9cfd --- /dev/null +++ b/src/ppx-metaquot/ppx_autoregister.ml @@ -0,0 +1,91 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2022-2023 OCaml Software Foundation. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +open Ppxlib + +module type ARG = sig + val val_prefix: string + val inject_def: string -> string -> string loc -> expression +end + +module Make (Arg: ARG) = struct + +let pattern_defs = + object + inherit [(string * string loc) list] Ast_traverse.fold as super + + method! pattern p acc = + let acc = super#pattern p acc in + match p.ppat_desc with + | Ppat_var var | Ppat_alias (_, var) -> ( + match String.index_opt var.txt '_' with + | Some i when String.sub var.txt 0 i = Arg.val_prefix -> + let suffix = + String.sub var.txt (i + 1) (String.length var.txt - i - 1) + in + (suffix, var) :: acc + | _ -> acc) + | _ -> acc + end + +let rec get_defs bindings acc = + match bindings with + | [] -> List.rev @@ List.flatten acc + | binding :: rest -> + get_defs rest @@ (pattern_defs#pattern binding.pvb_pat [] :: acc) + +module Ast_builder = Ast_builder.Make (struct + let loc = Location.none +end) + +let gen_expr (name, e) = + let id = + (* Create a fresh id that will be exported in the interface, so that looking + up the register function type in the cmi can't be tricked by later + redefinitions with a different type *) + Printf.sprintf "learnocaml_autoregister_%s_%06X" + name (Random.int 0xFFFFFF) + in + ({txt=id; loc=e.loc}, e), Arg.inject_def id name e + +let val_recorder s = + let open Ast_builder in + let create_val_registration defs = + let ids, exprs = List.split (List.map gen_expr defs) in + let val_registration = esequence exprs in + let register_toplevel = + List.map (fun (id, e) -> + value_binding + ~pat:(Ast_builder.ppat_var id) + ~expr:(Ast_builder.pexp_ident + {txt=Longident.Lident e.txt; loc=e.loc})) + ids + @ [ value_binding ~pat:punit ~expr:val_registration ] + in + pstr_value Nonrecursive register_toplevel + in + List.fold_right + (fun si acc -> + match si.pstr_desc with + | Pstr_value (_, bindings) -> ( + match get_defs bindings [] with + | [] -> si :: acc + | defs -> si :: create_val_registration defs :: acc) + | _ -> si :: acc) + s [] + +let expand = val_recorder + +end + +let modname var = + (* This is fragile. Do we have a better way to recover the current + compilation unit name in a ppx ? *) + String.capitalize_ascii @@ + Filename.basename @@ + Filename.remove_extension @@ + var.Location.loc.Location.loc_start.Lexing.pos_fname diff --git a/src/ppx-metaquot/ppx_autoregister.mli b/src/ppx-metaquot/ppx_autoregister.mli new file mode 100644 index 000000000..f100b2ef4 --- /dev/null +++ b/src/ppx-metaquot/ppx_autoregister.mli @@ -0,0 +1,19 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2022 OCaml Software Foundation. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +module type ARG = sig + val val_prefix: string + val inject_def: string -> string -> string Ppxlib.loc -> Ppxlib.expression +end + +module Make (_: ARG): sig + val expand: Ppxlib.structure -> Ppxlib.structure +end + +(** Helper function extracting the module name from the location of a variable + (only at top-level) *) +val modname: 'a Location.loc -> string diff --git a/src/ppx-metaquot/ppx_metaquot_main.ml b/src/ppx-metaquot/ppx_metaquot_main.ml deleted file mode 100644 index 62a74f952..000000000 --- a/src/ppx-metaquot/ppx_metaquot_main.ml +++ /dev/null @@ -1,3 +0,0 @@ -let () = - Migrate_parsetree.Driver.register ~name:"ppx_metaquot" (module Migrate_parsetree.OCaml_412) - (fun _config _cookies -> Ppx_metaquot.Main.expander []) diff --git a/src/ppx-metaquot/printer_recorder.ml b/src/ppx-metaquot/printer_recorder.ml new file mode 100644 index 000000000..8e81c0abf --- /dev/null +++ b/src/ppx-metaquot/printer_recorder.ml @@ -0,0 +1,20 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2022-2023 OCaml Software Foundation. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +include Ppx_autoregister.Make(struct + let val_prefix = "print" + let inject_def id name var = + let open Ppxlib in + let open Ast_builder.Default in + let loc = var.Location.loc in + pexp_apply ~loc + (evar ~loc "Learnocaml_internal.install_printer") + [ Nolabel, estring ~loc (Ppx_autoregister.modname var); + Nolabel, estring ~loc id; + Nolabel, estring ~loc name; + Nolabel, evar ~loc var.txt ] + end) diff --git a/src/ppx-metaquot/printer_recorder.mli b/src/ppx-metaquot/printer_recorder.mli new file mode 100644 index 000000000..5b00dfcc1 --- /dev/null +++ b/src/ppx-metaquot/printer_recorder.mli @@ -0,0 +1,8 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2022 OCaml Software Foundation. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +val expand: Ppxlib.structure -> Ppxlib.structure diff --git a/src/ppx-metaquot/sampler_recorder.ml b/src/ppx-metaquot/sampler_recorder.ml new file mode 100644 index 000000000..3520f1d13 --- /dev/null +++ b/src/ppx-metaquot/sampler_recorder.ml @@ -0,0 +1,20 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2022-2023 OCaml Software Foundation. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +include Ppx_autoregister.Make(struct + let val_prefix = "sample" + let inject_def id name var = + let open Ppxlib in + let open Ast_builder.Default in + let loc = var.Location.loc in + pexp_apply ~loc + (evar ~loc "Introspection.register_sampler") + [ Nolabel, estring ~loc (Ppx_autoregister.modname var); + Nolabel, estring ~loc id; + Nolabel, estring ~loc name; + Nolabel, evar ~loc var.txt] + end) diff --git a/src/ppx-metaquot/sampler_recorder.mli b/src/ppx-metaquot/sampler_recorder.mli new file mode 100644 index 000000000..5b00dfcc1 --- /dev/null +++ b/src/ppx-metaquot/sampler_recorder.mli @@ -0,0 +1,8 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2022 OCaml Software Foundation. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +val expand: Ppxlib.structure -> Ppxlib.structure diff --git a/src/ppx-metaquot/ty.ml b/src/ppx-metaquot/ty.ml index 12beae6b7..444dc1940 100644 --- a/src/ppx-metaquot/ty.ml +++ b/src/ppx-metaquot/ty.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/repo/dune b/src/repo/dune index a82d333a3..2ffa050af 100644 --- a/src/repo/dune +++ b/src/repo/dune @@ -4,7 +4,7 @@ (modules Learnocaml_index Learnocaml_exercise) (libraries ocplib-json-typed - learnocaml_xor + base64 omd lwt ezjsonm) @@ -41,9 +41,10 @@ (name learnocaml_process_repository_lib) (wrapped false) (modules Learnocaml_process_common + Learnocaml_precompile_exercise Learnocaml_process_exercise_repository Learnocaml_process_tutorial_repository - Learnocaml_process_playground_repository) + Learnocaml_process_playground_repository) (libraries ezjsonm str lwt.unix diff --git a/src/repo/learnocaml_exercise.ml b/src/repo/learnocaml_exercise.ml index b010eaa22..6b53b8e56 100644 --- a/src/repo/learnocaml_exercise.ml +++ b/src/repo/learnocaml_exercise.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -8,42 +8,82 @@ type id = string +type compiled_lib = { cma: string; js: string } + +type compiled = { + prelude_cmi: string; + prepare_cmi: string; + solution_cmi: string; + test_cmi: string; + exercise_lib: compiled_lib; (* includes prelude, prepare and solution *) + test_lib: compiled_lib; +} + type t = { id : id ; - prelude : string ; + prelude_ml : string ; + prepare_ml : string ; + (* absent from the json, empty except when building the exercises *) template : string ; - descr : (string * string) list ; - prepare : string ; - test : string ; solution : string ; + (* absent from the json, empty except when building the exercises *) + descr : (string * string) list ; + compiled : compiled ; max_score : int ; depend : string option ; - dependencies : string list; + dependencies : string list; (* TODO: move to test.cma + list of cmi file contents *) } let encoding = let open Json_encoding in + let b64 = + (* TODO: try to use the native implementation on browsers ? *) + conv + (fun s -> Base64.encode_string s) + (fun b -> Result.get_ok (Base64.decode b)) + string + in + let compiled_lib_encoding = + conv + (fun {cma; js} -> cma, js) + (fun (cma, js) -> {cma; js}) + (obj2 + (dft "cma" b64 "") + (dft "js" string "")) + in + let compiled_encoding = + conv + (fun {prelude_cmi; prepare_cmi; solution_cmi; test_cmi; exercise_lib; test_lib} -> + (prelude_cmi, prepare_cmi, solution_cmi, test_cmi, exercise_lib, test_lib)) + (fun (prelude_cmi, prepare_cmi, solution_cmi, test_cmi, exercise_lib, test_lib) -> + {prelude_cmi; prepare_cmi; solution_cmi; test_cmi; exercise_lib; test_lib}) + (obj6 + (req "prelude_cmi" b64) + (req "prepare_cmi" b64) + (req "solution_cmi" b64) + (req "test_cmi" b64) + (req "exercise_lib" compiled_lib_encoding) + (req "test_lib" compiled_lib_encoding)) + in conv - (fun { id ; prelude ; template ; descr ; prepare ; test ; solution ; max_score ; depend ; dependencies} -> - id, prelude, template, descr, prepare, test, solution, max_score,depend, dependencies) - (fun (id, prelude, template, descr, prepare, test, solution, max_score,depend, dependencies) -> - { id ; prelude ; template ; descr ; prepare ; test ; solution ; max_score ; depend ; dependencies}) - (obj10 + (fun { id ; prelude_ml ; prepare_ml = _; template ; descr ; compiled ; max_score ; depend ; dependencies ; solution = _} -> + (id, prelude_ml, template, descr, compiled, max_score, depend, dependencies)) + (fun ((id, prelude_ml, template, descr, compiled, max_score, depend, dependencies)) -> + { id ; prelude_ml ; prepare_ml = ""; template ; descr ; compiled ; max_score ; depend ; dependencies; solution = ""}) + (obj8 (req "id" string) - (req "prelude" string) + (req "prelude_ml" string) (req "template" string) (req "descr" (list (tup2 string string))) - (req "prepare" string) - (req "test" string) - (req "solution" string) + (req "compiled" compiled_encoding) (req "max-score" int) - (opt "depend" (string)) + (opt "depend" string) (dft "dependencies" (list string) [])) (* let meta_from_string m = * Ezjsonm.from_string m * |> Json_encoding.destruct Learnocaml_meta.encoding - * + * * let meta_to_string m = * Json_encoding.construct Learnocaml_meta.encoding m * |> (function @@ -85,7 +125,6 @@ module File = struct type 'a file = { key : string ; - ciphered : bool ; decode : string -> 'a ; encode : 'a -> string ; field : t -> 'a ; @@ -94,37 +133,27 @@ module File = struct exception Missing_file of string - let get { key ; ciphered ; decode ; _ } ex = + let get { key ; decode ; _ } ex = try let raw = StringMap.find key ex in - if ciphered then - let prefix = - Digest.string (StringMap.find "id" ex ^ "_" ^ key) in - decode (Learnocaml_xor.decode ~prefix raw) - else - decode raw + decode raw with Not_found -> raise (Missing_file ("get " ^ key)) let get_opt file ex = - try (* a missing file here is necessarily [file] *) - get file ex - with Missing_file _ -> None + try (* a missing file here is necessarily [file] *) + get file ex + with Missing_file _ -> None let has { key ; _ } ex = StringMap.mem key ex - let set { key ; ciphered ; encode ; _ } raw ex = - if ciphered then - let prefix = - Digest.string (StringMap.find "id" ex ^ "_" ^ key) in - StringMap.add key (Learnocaml_xor.encode ~prefix (encode raw)) ex - else - StringMap.add key (encode raw) ex + let set { key ; encode ; _ } raw ex = + StringMap.add key (encode raw) ex let key file = file.key let id = - { key = "id" ; ciphered = false ; + { key = "id" ; decode = (fun v -> v) ; encode = (fun v -> v) ; field = (fun ex -> ex.id) ; update = (fun id ex -> { ex with id }) @@ -148,52 +177,81 @@ module File = struct * } *) let max_score = let key = "max_score.txt" in - { key ; ciphered = false ; + { key ; decode = (fun v -> int_of_string v) ; encode = (fun v -> string_of_int v) ; field = (fun ex -> ex.max_score); update = (fun max_score ex -> { ex with max_score }); } - let prelude = - { key = "prelude.ml" ; ciphered = false ; + let prelude_ml = + { key = "prelude.ml" ; + decode = (fun v -> v) ; encode = (fun v -> v) ; + field = (fun ex -> ex.prelude_ml) ; + update = (fun prelude_ml ex -> { ex with prelude_ml }) + } + let prepare_ml = + { key = "prepare.ml" ; decode = (fun v -> v) ; encode = (fun v -> v) ; - field = (fun ex -> ex.prelude) ; - update = (fun prelude ex -> { ex with prelude }) + field = (fun ex -> ex.prepare_ml) ; + update = (fun prepare_ml ex -> { ex with prepare_ml }) } let template = - { key = "template.ml" ; ciphered = false ; + { key = "template.ml" ; decode = (fun v -> v) ; encode = (fun v -> v) ; field = (fun ex -> ex.template) ; update = (fun template ex -> { ex with template }) } + let solution = + { key = "solution.ml" ; + decode = (fun v -> v) ; encode = (fun v -> v) ; + field = (fun ex -> ex.solution) ; + update = (fun solution ex -> { ex with solution }) + } let descr : (string * string) list file = - { key = "descr.html" ; ciphered = false ; + { key = "descr.html" ; decode = descrs_from_string ; encode = descrs_to_string ; field = (fun ex -> ex.descr) ; update = (fun descr ex -> { ex with descr }) } - let prepare = - { key = "prepare.ml" ; ciphered = true ; + let compiled key get set = + { key; decode = (fun v -> v) ; encode = (fun v -> v) ; - field = (fun ex -> ex.prepare) ; - update = (fun prepare ex -> { ex with prepare }) - } - let test = - { key = "test.ml" ; ciphered = true ; - decode = (fun v -> v) ; encode = (fun v -> v) ; - field = (fun ex -> ex.test) ; - update = (fun test ex -> { ex with test }) - } - let solution = - { key = "solution.ml" ; ciphered = true ; - decode = (fun v -> v) ; encode = (fun v -> v) ; - field = (fun ex -> ex.solution) ; - update = (fun solution ex -> { ex with solution }) - } - + field = (fun ex -> get ex.compiled) ; + update = (fun v ex -> { ex with compiled = set v ex.compiled }) } + let prelude_cmi = + compiled "prelude.cmi" + (fun comp -> comp.prelude_cmi) + (fun prelude_cmi c -> { c with prelude_cmi }) + let prepare_cmi = + compiled "prepare.cmi" + (fun comp -> comp.prepare_cmi) + (fun prepare_cmi c -> { c with prepare_cmi }) + let solution_cmi = + compiled "solution.cmi" + (fun comp -> comp.solution_cmi) + (fun solution_cmi c -> { c with solution_cmi }) + let test_cmi = + compiled "test.cmi" + (fun comp -> comp.test_cmi) + (fun test_cmi c -> { c with test_cmi }) + let compiled_lib key get set = + compiled (key^".cma") + (fun comp -> (get comp).cma) + (fun cma c -> let l = get c in set { l with cma } c), + compiled (key^".js") + (fun comp -> (get comp).js) + (fun js c -> let l = get c in set { l with js } c) + let exercise_cma, exercise_js = + compiled_lib "exercise" + (fun comp -> comp.exercise_lib) + (fun exercise_lib c -> { c with exercise_lib }) + let test_cma, test_js = + compiled_lib "test" + (fun comp -> comp.test_lib) + (fun test_lib c -> { c with test_lib }) let depend = - { key = "depend.txt" ; ciphered = false ; - decode = (fun v -> Some v) ; - encode = (function + { key = "depend.txt" ; + decode = (fun v -> Some v) ; + encode = (function | None -> "" (* no `depend` ~ empty `depend` *) | Some txt -> txt) ; field = (fun ex -> ex.depend) ; @@ -202,7 +260,7 @@ module File = struct (* [parse_dependencies txt] extracts dependencies from the string [txt]. Dependencies are file names separated by at least one line break. - [txt] may contain comments starting with characters ';' or '#' + [txt] may contain comments starting with characters ';' or '#' and ending by a line break. *) let parse_dependencies txt = let remove_comment ~start:c line = @@ -217,19 +275,19 @@ module File = struct | None -> [] | Some txt -> let filenames = parse_dependencies txt in - List.mapi + List.mapi (fun pos filename -> - { key = filename ; ciphered = true ; + { key = filename ; decode = (fun v -> v) ; encode = (fun v -> v) ; field = (fun ex -> List.nth ex.dependencies pos) ; - update = (fun v ex -> - let dependencies = + update = (fun v ex -> + let dependencies = List.mapi (fun i v' -> if i = pos then v else v') ex.dependencies in { ex with dependencies }) }) filenames - + module MakeReader (Concur : Concur) = struct - let read ~read_field ?id: ex_id ?(decipher = true) () = + let read ~read_field ?id: ex_id () = let open Concur in let ex = ref StringMap.empty in read_field id.key >>= fun pr_id -> @@ -248,18 +306,11 @@ module File = struct * return (meta_from_string meta_json) * end >>= fun meta_json -> * ex := set meta meta_json !ex; *) - let read_file ({ key ; ciphered ; decode ; _ } as field) = + let read_file ({ key ; decode ; _ } as field) = read_field key >>= function | Some raw -> - let deciphered = - if ciphered && decipher then - let prefix = - Digest.string (ex_id ^ "_" ^ key) in - Learnocaml_xor.decode ~prefix raw - else - raw in (* decode / encode now to catch malformed fields earlier *) - ex := set field (decode deciphered) !ex ; + ex := set field (decode raw) !ex ; return () | None -> return () in (* let read_title () = @@ -352,12 +403,19 @@ module File = struct in join [ (* read_title () ; *) - read_file prelude ; + read_file prelude_ml ; + read_file prepare_ml ; read_file template ; - read_descrs () ; - read_file prepare ; read_file solution ; - read_file test ; + read_descrs () ; + read_file prelude_cmi ; + read_file prepare_cmi ; + read_file solution_cmi ; + read_file test_cmi ; + read_file exercise_cma ; + read_file exercise_js ; + read_file test_cma ; + read_file test_js ; read_file depend ; (* read_max_score () *) ] >>= fun () -> join (List.map read_file (dependencies (get_opt depend !ex))) >>= fun () -> @@ -373,76 +431,83 @@ let access f ex = let decipher f ex = let open File in let raw = f.field ex in - if f.ciphered then - let prefix = - Digest.string (ex.id ^ "_" ^ f.key) in - f.decode (Learnocaml_xor.decode ~prefix raw) - else - f.decode raw + f.decode raw let update f v ex = f.File.update v ex let cipher f v ex = let open File in - if f.ciphered then - let prefix = - Digest.string (ex.id ^ "_" ^ f.key) in - f.update (Learnocaml_xor.encode ~prefix (f.encode v)) ex - else - f.update (f.encode v) ex + f.update (f.encode v) ex let field_from_file file files = try File.(StringMap.find file.key files |> file.decode) with Not_found -> raise File.(Missing_file file.key) +let strip need_js ex = + let f {cma; js} = + if need_js then {cma= ""; js} else {cma; js = ""} + in + { ex with + compiled = + { ex.compiled with + exercise_lib = f ex.compiled.exercise_lib; + test_lib = f ex.compiled.test_lib } } + + module MakeReaderAnddWriter (Concur : Concur) = struct - + module FileReader = File.MakeReader(Concur) - let read ~read_field ?id ?decipher () = + let read ~read_field ?id () = let open Concur in - FileReader.read ~read_field ?id ?decipher () >>= fun ex -> + FileReader.read ~read_field ?id () >>= fun ex -> try let depend = File.get_opt File.depend ex in return { id = field_from_file File.id ex; (* meta = field_from_file File.meta ex; *) - prelude = field_from_file File.prelude ex ; + prelude_ml = field_from_file File.prelude_ml ex ; + prepare_ml = field_from_file File.prepare_ml ex ; template = field_from_file File.template ex ; - descr = field_from_file File.descr ex ; - prepare = field_from_file File.prepare ex ; - test = field_from_file File.test ex ; solution = field_from_file File.solution ex ; + descr = field_from_file File.descr ex ; + compiled = { + prelude_cmi = field_from_file File.prelude_cmi ex; + prepare_cmi = field_from_file File.prepare_cmi ex; + solution_cmi = field_from_file File.solution_cmi ex; + test_cmi = field_from_file File.test_cmi ex; + exercise_lib = { + cma = field_from_file File.exercise_cma ex; + js = field_from_file File.exercise_js ex; + }; + test_lib = { + cma = field_from_file File.test_cma ex; + js = field_from_file File.test_js ex; + }; + }; max_score = 0 ; depend ; - dependencies = + dependencies = let field_from_dependency file = try field_from_file file ex - with File.Missing_file msg - -> let msg' = msg ^ ": dependency declared in " + with File.Missing_file msg + -> let msg' = msg ^ ": dependency declared in " ^ File.(key depend) ^ ", but not found" in - raise (File.Missing_file msg') - in - List.map field_from_dependency (File.dependencies depend) + raise (File.Missing_file msg') + in + List.map field_from_dependency (File.dependencies depend) } with File.Missing_file _ as e -> fail e - let write ~write_field ex ?(cipher = true) acc = + let write ~write_field ex acc = let open Concur in let open File in let acc = ref acc in - let ex_id = ex.id in - let write_field { key ; ciphered ; encode ; field ; _ } = + let write_field { key ; encode ; field ; _ } = try let raw = field ex |> encode in - let ciphered = if ciphered && (not cipher) then - let prefix = - Digest.string (ex_id ^ "_" ^ key) in - Learnocaml_xor.decode ~prefix raw - else - raw in - write_field key ciphered !acc >>= fun nacc -> + write_field key raw !acc >>= fun nacc -> acc := nacc ; return () with Not_found -> Concur.return () in @@ -450,14 +515,20 @@ module MakeReaderAnddWriter (Concur : Concur) = struct ([ write_field id ; (* write_field meta ; * write_field title ; *) - write_field prelude ; + write_field prelude_ml ; + (* prepare not written on purpose *) write_field template ; + (* solution not written on purpose *) write_field descr ; - write_field prepare ; - write_field solution ; - write_field test ; + write_field prelude_cmi ; + write_field prepare_cmi ; + write_field solution_cmi ; + write_field exercise_cma ; + write_field exercise_js ; + write_field test_cma ; + write_field test_js ; write_field depend ; - (* write_field max_score *) ] + (* write_field max_score *) ] @ (List.map write_field (dependencies (access depend ex))) ) >>= fun () -> return !acc diff --git a/src/repo/learnocaml_exercise.mli b/src/repo/learnocaml_exercise.mli index a2b1d286e..1b188774a 100644 --- a/src/repo/learnocaml_exercise.mli +++ b/src/repo/learnocaml_exercise.mli @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -13,8 +13,9 @@ type t type id = string -(* JSON encoding of the exercise representation. Includes cipher and decipher at - at encoding and decoding. *) +type compiled_lib = { cma: string; js: string } + +(* JSON encoding of the exercise representation. *) val encoding: t Json_encoding.encoding (** Intermediate representation of files, resulting of reading the exercise directory *) @@ -54,20 +55,34 @@ module File : sig (** Maximum score for the exercise *) val max_score: int file - (** Returns the (private, already deciphered) [prepare.ml] *) - val prepare: string file + (** Returns the (public) [prelude.ml] *) + val prelude_ml: string file + + (** Returns the (private) [prepare.ml] *) + val prepare_ml: string file + + (** Returns the (public) [template.ml] *) + val template: string file - (** Returns the (private, already deciphered) [solution.ml] *) + (** Returns the (private) [solution.ml], only when loaded from disk (for + building the exercises). Otherwise the empty string *) val solution: string file - (** Returns the (private, already deciphered) [test.ml] *) - val test: string file + val prelude_cmi: string file - (** Returns the (public) [prelude.ml] *) - val prelude: string file + val prepare_cmi: string file - (** Returns the (public) [template.ml] *) - val template: string file + val solution_cmi: string file + + val test_cmi: string file + + val exercise_cma: string file + + val exercise_js: string file + + val test_cma: string file + + val test_js: string file (** Returns the (public) [descr.html] *) val descr: (string * string) list file @@ -75,7 +90,7 @@ module File : sig (** Returns the (public) depend file *) val depend: string option file - (** [dependencies txt] create the (private, already deciphered) dependencies + (** [dependencies txt] create the (private, already deciphered) dependencies declared in [txt] *) val dependencies: string option -> string file list end @@ -97,28 +112,33 @@ val update: 'a File.file -> 'a -> t -> t ciphers it. *) val cipher: string File.file -> string -> t -> t +(** Selectively removes compiled data from an exercise. + If the first arg [js] is [true], keep only the javascript. + Otherwise, keep only the bytecode. *) +val strip: bool -> t -> t + (** Reader and decipherer *) val read: read_field:(string -> string option) -> - ?id:string -> ?decipher:bool -> unit -> + ?id:string -> unit -> t (** Writer and cipherer, ['a] can be [unit] *) val write: write_field:(string -> string -> 'a -> 'a) -> - t -> ?cipher:bool -> 'a -> + t -> 'a -> 'a (** Reader and decipherer with {!Lwt} *) val read_lwt: read_field:(string -> string option Lwt.t) -> - ?id:string -> ?decipher:bool -> unit -> + ?id:string -> unit -> t Lwt.t (** Writer and cipherer with {!Lwt}, ['a] can be [unit] *) val write_lwt: write_field:(string -> string -> 'a -> 'a Lwt.t) -> - t -> ?cipher:bool -> 'a -> + t -> 'a -> 'a Lwt.t (** JSON serializer, with {!id} file included *) diff --git a/src/repo/learnocaml_index.ml b/src/repo/learnocaml_index.ml index 50e3e8c2b..ec7571d3e 100644 --- a/src/repo/learnocaml_index.ml +++ b/src/repo/learnocaml_index.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/repo/learnocaml_lesson.ml b/src/repo/learnocaml_lesson.ml index 4403ab2b2..b35fd09e5 100644 --- a/src/repo/learnocaml_lesson.ml +++ b/src/repo/learnocaml_lesson.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/repo/learnocaml_precompile_exercise.ml b/src/repo/learnocaml_precompile_exercise.ml new file mode 100644 index 000000000..4358ea647 --- /dev/null +++ b/src/repo/learnocaml_precompile_exercise.ml @@ -0,0 +1,116 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2022-2023 OCaml Software Foundation. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +(* Compile objects from an exercise *) + +open Lwt.Infix + +(* FIXME: make these configurable *) +let grading_cmis_dir = + let prefix = Filename.dirname (Filename.dirname (Sys.executable_name)) in + let ( / ) = Filename.concat in + ref (prefix/"lib"/"learn-ocaml"/"test_lib") + +let extra_cmis_dirs = + let prefix = Filename.dirname (Filename.dirname (Sys.executable_name)) in + let ( / ) = Filename.concat in + ref [prefix/"lib"/"vg"; prefix/"lib"/"gg"] + +let run ?dir cmd args = + Lwt_process.exec ?cwd:dir ("", Array.of_list (cmd::args)) >>= function + | Unix.WEXITED 0 -> Lwt.return_unit + | _ -> Lwt.fail_with ("Compilation failed: " ^ String.concat " " (cmd::args)) + +let is_fresh = + let mtime f = Unix.((stat f).st_mtime) in + let exe_mtime = + try mtime (Sys.executable_name) with Unix.Unix_error _ -> max_float + in + fun ?(dir=".") target srcs -> + let target = Filename.concat dir target in + let srcs = List.map (Filename.concat dir) srcs in + try + let mt = mtime target in + mt > exe_mtime && List.for_all (fun f -> mt > mtime f) srcs + with Unix.Unix_error _ -> false + +let ocamlc ?(dir=Sys.getcwd ()) ?(opn=[]) ?(ppx=[]) ~source ~target args = + let d = Filename.concat dir in + if is_fresh ~dir target source then Lwt.return_unit else + let args = + List.fold_right (fun ppx args -> + "-ppx" :: Filename.concat !grading_cmis_dir (ppx^" --as-ppx") :: args) + ppx args + in + let args = "-I" :: dir :: "-I" :: !grading_cmis_dir :: args in + let args = + List.flatten (List.map (fun d -> ["-I"; d]) !extra_cmis_dirs) @ args + in + let args = args @ List.map d source @ ["-o"; d target] in + let args = List.fold_right (fun m acc -> "-open" :: m :: acc) opn args in + run "ocamlc" args + +let jsoo ?(dir=Sys.getcwd ()) ~source ~target args = + let d = Filename.concat dir in + if is_fresh ~dir target [source] then Lwt.return_unit else + let args = "--wrap-with=dynload" :: args in + let args = args @ [d source; "-o"; d target] in + run "js_of_ocaml" args + +let read_lines fopen = + try + let ic = fopen () in + let lines = ref [] in + try while true do lines := input_line ic :: !lines done; [] + with End_of_file -> + close_in ic; + List.rev !lines + with Sys_error _ -> [] + +let precompile ~exercise_dir = + let dir = exercise_dir in + let grader_libs = + read_lines (fun () -> open_in (Filename.concat dir "test_libs.txt")) in + let grader_flags = + List.fold_right (fun lib flags -> + let libflags = + read_lines (fun () -> + Printf.ksprintf Unix.open_process_in + "ocamlfind query %s -predicates byte -format \"-I&%%d&%%a\"" lib) + |> List.map (String.split_on_char '&') + |> List.flatten + in + List.append libflags flags) + grader_libs [] + in + ocamlc ~dir ["-c"] ~opn:["Learnocaml_callback"] + ~source:["prelude.ml"] ~target:"prelude.cmo" + >>= fun () -> + ocamlc ~dir ["-c"] ~opn:["Learnocaml_callback"; "Prelude"] ~ppx:["exercise-ppx"] + ~source:["prepare.ml"] ~target:"prepare.cmo" + >>= fun () -> + ocamlc ~dir ["-c"] ~opn:["Learnocaml_callback"; "Prelude"; "Prepare"] ~ppx:["exercise-ppx"] + ~source:["solution.ml"] ~target:"solution.cmo" + >>= fun () -> + Lwt.join [ + (ocamlc ~dir ["-a"] + ~source:["prelude.cmo"; "prepare.cmo"; "solution.cmo"] + ~target:"exercise.cma" + >>= fun () -> + jsoo ~dir [] ~source:"exercise.cma" ~target:"exercise.js"); + (ocamlc ~dir (["-c"; "-I"; "+compiler-libs"] @ grader_flags) + ~ppx:["grader-ppx"] + ~opn:["Learnocaml_callback"; "Prelude"; "Prepare"; "Test_lib.Open_me"] + ~source:["test.ml"] + ~target:"test.cmo" + >>= fun () -> + ocamlc ~dir (["-a"] @ grader_flags) + ~source:["test.cmo"] + ~target:"test.cma" + >>= fun () -> + jsoo ~dir [] ~source:"test.cma" ~target:"test.js"); + ] diff --git a/src/repo/learnocaml_process_common.ml b/src/repo/learnocaml_process_common.ml index a6acf5a65..2d733d226 100644 --- a/src/repo/learnocaml_process_common.ml +++ b/src/repo/learnocaml_process_common.ml @@ -15,5 +15,17 @@ let to_file encoding fn value = let from_file encoding fn = Lwt_io.(with_file ~mode: Input) fn @@ fun chan -> Lwt_io.read chan >>= fun str -> - let json = Ezjsonm.from_string str in + let json = + match Ezjsonm.from_string_result str with + | Ok json -> json + | Error err -> + let loc = match Ezjsonm.read_error_location err with + | None -> fn + | Some ((li, col), _) -> + Printf.sprintf "%s, line %d, column %d" fn li col + in + Printf.ksprintf failwith + "Parse error in %s:\n %s" loc + (Ezjsonm.read_error_description err); + in Lwt.return (Json_encoding.destruct encoding json) diff --git a/src/repo/learnocaml_process_exercise_repository.ml b/src/repo/learnocaml_process_exercise_repository.ml index bfe9abc7f..4b346f7a9 100644 --- a/src/repo/learnocaml_process_exercise_repository.ml +++ b/src/repo/learnocaml_process_exercise_repository.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -25,7 +25,7 @@ let read_exercise exercise_dir = in Learnocaml_exercise.read_lwt ~read_field ~id:(Filename.basename exercise_dir) - ~decipher:false () + () let exercises_dir = ref "./exercises" @@ -68,29 +68,22 @@ let spawn_grader ) in sleep () >>= fun () -> - Lwt_io.flush_all () >>= fun () -> - match Lwt_unix.fork () with - | 0 -> - Grader_cli.dump_outputs := dump_outputs; - Grader_cli.dump_reports := dump_reports; - Grader_cli.display_callback := false; - Lwt_main.run - (Lwt.catch (fun () -> - Grader_cli.grade ?print_result ?dirname meta exercise output_json - >|= fun r -> - print_grader_error exercise r; - match r with - | Ok () -> exit 0 - | Error _ -> exit 1) - (fun e -> - Printf.eprintf "%!Grader error: %s\n%!" (Printexc.to_string e); - exit 10)) - | pid -> - Lwt_unix.waitpid [] pid >>= fun (_pid, ret) -> + Lwt.catch (fun () -> + Grader_cli.grade + ~dump_outputs ~dump_reports ~display_callback:false + ?print_result ?dirname meta exercise output_json + >|= fun r -> + print_grader_error exercise r; incr n_processes; - match ret with - | Unix.WEXITED 0 -> Lwt.return (Ok ()) - | _ -> Lwt.return (Error (-1)) + r) + (fun e -> + incr n_processes; + Printf.eprintf "Grader error: %s\n%!" (Printexc.to_string e); + Lwt.return (Error 0)) + +let exe_mtime = + try Unix.((stat (Sys.executable_name)).st_mtime) + with Unix.Unix_error _ -> max_float let main dest_dir = let exercises_index = @@ -173,10 +166,9 @@ let main dest_dir = else from_file Meta.enc (!exercises_dir / id / "meta.json") - >>= fun meta -> - read_exercise (!exercises_dir / id) - >|= fun exercise -> - SMap.add id exercise all_exercises, + >|= fun meta -> + let exercise_dir = !exercises_dir / id in + SMap.add id exercise_dir all_exercises, (id, Some meta) :: acc) (all_exercises, []) (List.rev ids) >>= fun (all_exercises, exercises) -> @@ -195,11 +187,11 @@ let main dest_dir = let processes_arguments = List.rev @@ SMap.fold - (fun id exercise acc -> - let exercise_dir = !exercises_dir / id in + (fun id exercise_dir acc -> let json_path = dest_dir / Learnocaml_index.exercise_path id in let changed = try let { Unix.st_mtime = json_time ; _ } = Unix.stat json_path in + exe_mtime >= json_time || Sys.readdir exercise_dir |> Array.to_list |> List.map (fun f -> (Unix.stat (exercise_dir / f)).Unix.st_mtime ) |> @@ -213,7 +205,7 @@ let main dest_dir = match !dump_reports with | None -> None | Some dir -> Some (dir / id) in - (id, exercise_dir, exercise, json_path, + (id, exercise_dir, json_path, changed, dump_outputs, dump_reports) :: acc) all_exercises [] in begin @@ -222,15 +214,16 @@ let main dest_dir = Lwt_list.map_s, fun dump_outputs dump_reports ?print_result ?dirname meta exercise json_path -> - Grader_cli.dump_outputs := dump_outputs; - Grader_cli.dump_reports := dump_reports; - Grader_cli.grade ?print_result ?dirname meta exercise json_path + Grader_cli.grade + ~dump_outputs ~dump_reports ~display_callback:true + ?print_result ?dirname + meta exercise json_path >|= fun r -> print_grader_error exercise r; r else Lwt_list.map_p, spawn_grader in - listmap (fun (id, ex_dir, exercise, json_path, changed, dump_outputs,dump_reports) -> + listmap (fun (id, ex_dir, json_path, changed, dump_outputs,dump_reports) -> let dst_ex_dir = String.concat Filename.dir_sep [dest_dir; "static"; id] in Lwt_utils.mkdir_p dst_ex_dir >>= fun () -> Lwt_stream.iter_p (fun base -> @@ -242,10 +235,14 @@ let main dest_dir = (Lwt_unix.files_of_directory ex_dir) >>= fun () -> if not changed then begin Format.printf "%-24s (no changes)@." id ; - Lwt.return true + Lwt.return_true end else begin + Learnocaml_precompile_exercise.precompile ~exercise_dir:ex_dir + >>= fun () -> + read_exercise ex_dir + >>= fun exercise -> grade dump_outputs dump_reports - ~dirname:(!exercises_dir / id) (Index.find index id) exercise (Some json_path) + ~dirname:ex_dir (Index.find index id) exercise (Some json_path) >>= function | Ok () -> Format.printf "%-24s [OK]@." id ; diff --git a/src/repo/learnocaml_process_playground_repository.ml b/src/repo/learnocaml_process_playground_repository.ml index 8b3a54769..e9900d5e8 100644 --- a/src/repo/learnocaml_process_playground_repository.ml +++ b/src/repo/learnocaml_process_playground_repository.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/repo/learnocaml_process_tutorial_repository.ml b/src/repo/learnocaml_process_tutorial_repository.ml index fa7da5903..f1484de87 100644 --- a/src/repo/learnocaml_process_tutorial_repository.ml +++ b/src/repo/learnocaml_process_tutorial_repository.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/repo/learnocaml_tutorial.ml b/src/repo/learnocaml_tutorial.ml index 1eae8e88e..fe8888b07 100644 --- a/src/repo/learnocaml_tutorial.ml +++ b/src/repo/learnocaml_tutorial.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/repo/learnocaml_tutorial_checker_main.ml b/src/repo/learnocaml_tutorial_checker_main.ml index 08fb83e18..7f1c2225b 100644 --- a/src/repo/learnocaml_tutorial_checker_main.ml +++ b/src/repo/learnocaml_tutorial_checker_main.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/repo/learnocaml_tutorial_parser.ml b/src/repo/learnocaml_tutorial_parser.ml index b3bb52e38..15c5aae56 100644 --- a/src/repo/learnocaml_tutorial_parser.ml +++ b/src/repo/learnocaml_tutorial_parser.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/repo/learnocaml_tutorial_reader_main.ml b/src/repo/learnocaml_tutorial_reader_main.ml index 5a0a034ad..571729f7c 100644 --- a/src/repo/learnocaml_tutorial_reader_main.ml +++ b/src/repo/learnocaml_tutorial_reader_main.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 5100ba24e..af1fdd830 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -452,17 +452,18 @@ module Request_handler = struct | Api.Exercise_index None -> lwt_fail (`Forbidden, "Forbidden") - | Api.Exercise (Some token, id) -> + | Api.Exercise (Some token, id, js) -> (Exercise.Status.is_open id token >>= function | `Open | `Deadline _ as o -> Exercise.Meta.get id >>= fun meta -> Exercise.get id >>= fun ex -> + let ex = Learnocaml_exercise.strip js ex in respond_json cache (meta, ex, match o with `Deadline t -> Some (max t 0.) | `Open -> None) | `Closed -> lwt_fail (`Forbidden, "Exercise closed")) - | Api.Exercise (None, _) -> + | Api.Exercise (None, _, _) -> lwt_fail (`Forbidden, "Forbidden") | Api.Lesson_index () -> diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index 16496a9d0..655b7f0f9 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -120,7 +120,8 @@ type _ request = | Exercise_index: 'a token option -> (Exercise.Index.t * (Exercise.id * float) list) request | Exercise: - 'a token option * string -> (Exercise.Meta.t * Exercise.t * float option) request + 'a token option * string * bool -> + (Exercise.Meta.t * Exercise.t * float option) request | Lesson_index: unit -> (string * string) list request @@ -166,7 +167,7 @@ let supported_versions | Set_students_list (_, _) | Students_csv (_, _, _) | Exercise_index _ - | Exercise (_, _) + | Exercise (_, _, _) | Lesson_index _ | Lesson _ | Tutorial_index _ @@ -278,10 +279,10 @@ module Conversions (Json: JSON_CODEC) = struct let to_http_request : type resp. resp request -> http_request = - let get ?token path = { + let get ?token ?(args=[]) path = { meth = `GET; path; - args = match token with None -> [] | Some t -> ["token", Token.to_string t]; + args = (match token with None -> [] | Some t -> ["token", Token.to_string t]) @ args; } in let post ~token path body = { meth = `POST body; @@ -335,10 +336,13 @@ module Conversions (Json: JSON_CODEC) = struct | Exercise_index None -> get ["exercise-index.json"] - | Exercise (Some token, id) -> - get ~token ("exercises" :: String.split_on_char '/' (id^".json")) - | Exercise (None, id) -> + | Exercise (Some token, id, js) -> + get ~token + ("exercises" :: String.split_on_char '/' (id^".json")) + ~args:["mode", if js then "js" else "byte"] + | Exercise (None, id, js) -> get ("exercises" :: String.split_on_char '/' (id^".json")) + ~args:["mode", if js then "js" else "byte"] | Lesson_index () -> get ["lessons.json"] @@ -463,7 +467,8 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct (match token with | Some token -> let id = Filename.chop_suffix (String.concat "/" path) ".json" in - Exercise (Some token, id) |> k + let js = List.assoc_opt "mode" request.args = Some "js" in + Exercise (Some token, id, js) |> k | None -> Invalid_request "Missing token" |> k) | Some "" -> Static ["exercise.html"] |> k diff --git a/src/state/learnocaml_api.mli b/src/state/learnocaml_api.mli index 86f0ca385..984a3277a 100644 --- a/src/state/learnocaml_api.mli +++ b/src/state/learnocaml_api.mli @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -109,7 +109,8 @@ type _ request = | Exercise_index: 'a token option -> (Exercise.Index.t * (Exercise.id * float) list) request | Exercise: - 'a token option * string -> (Exercise.Meta.t * Exercise.t * float option) request + 'a token option * string * bool -> + (Exercise.Meta.t * Exercise.t * float option) request | Lesson_index: unit -> (string * string) list request diff --git a/src/state/learnocaml_data.ml b/src/state/learnocaml_data.ml index 0b73156a7..211ee9928 100644 --- a/src/state/learnocaml_data.ml +++ b/src/state/learnocaml_data.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/state/learnocaml_store.ml b/src/state/learnocaml_store.ml index 3d10c0f2e..04bd5d51e 100644 --- a/src/state/learnocaml_store.ml +++ b/src/state/learnocaml_store.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/toplevel/dune b/src/toplevel/dune index 337f82112..b0ce0edb6 100644 --- a/src/toplevel/dune +++ b/src/toplevel/dune @@ -8,6 +8,13 @@ toploop_results) ) +(library + (name learnocaml_internal_intf) + (wrapped false) + (modules learnocaml_internal_intf) + (modules_without_implementation learnocaml_internal_intf) +) + (executable (name learnocaml_toplevel_worker_main) (modes (byte js)) @@ -20,6 +27,7 @@ toploop_results ocplib-ocamlres.runtime embedded_cmis + learnocaml_internal_intf learnocaml_toplevel_worker_messages) (modules Learnocaml_toplevel_worker_main) (preprocess (pps js_of_ocaml-ppx)) diff --git a/src/toplevel/learnocaml_internal_intf.mli b/src/toplevel/learnocaml_internal_intf.mli new file mode 100644 index 000000000..57a57c853 --- /dev/null +++ b/src/toplevel/learnocaml_internal_intf.mli @@ -0,0 +1,20 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2022 OCaml Software Foundation. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +(** Interface of the module that gets automatically injected in the environment + before the Prelude is loaded. *) +module type CALLBACKS = sig + val print_html: string -> unit + val print_svg: string -> unit +end + + +(* (hidden) interface of the module that will be pre-loaded in the toplevel *) +module type INTERNAL = sig + val install_printer: string -> string -> string -> ('a -> 'b) -> unit + exception Undefined +end diff --git a/src/toplevel/learnocaml_toplevel.ml b/src/toplevel/learnocaml_toplevel.ml index e006ca755..09edec96d 100644 --- a/src/toplevel/learnocaml_toplevel.ml +++ b/src/toplevel/learnocaml_toplevel.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -259,6 +259,38 @@ let load top ?(print_outcome = true) ?timeout ?message content = warnings ; Lwt.return result +let load_js top ?(print_outcome = true) ?message content = + let phrase = Learnocaml_toplevel_output.phrase () in + protect_execution top @@ fun () -> + begin match message with + | None -> () + | Some message -> + Learnocaml_toplevel_output.output_code ~phrase top.output + ("(* " ^ message ^ "*)") + end ; + let pp_answer = + if print_outcome then + Learnocaml_toplevel_output.output_answer ~phrase top.output + else + ignore in + Lwt.protected @@ + Learnocaml_toplevel_worker_caller.use_compiled_string + top.worker ~pp_answer content + >>= fun result -> + let warnings, result = match Toploop_results.to_report result with + | Ok (result, warnings) -> warnings, result + | Error (error, warnings) -> + Learnocaml_toplevel_output.output_error top.output error ; + warnings, false in + List.iter + (Learnocaml_toplevel_output.output_warning top.output) + warnings ; + Lwt.return result + +let load_cmi_from_string top cmi = + protect_execution top @@ fun () -> + Learnocaml_toplevel_worker_caller.load_cmi_from_string top.worker cmi + let make_timeout_popup ?(countdown = 10) ?(refill_step = 10) diff --git a/src/toplevel/learnocaml_toplevel.mli b/src/toplevel/learnocaml_toplevel.mli index 9753876b5..e6fb2901a 100644 --- a/src/toplevel/learnocaml_toplevel.mli +++ b/src/toplevel/learnocaml_toplevel.mli @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -125,6 +125,25 @@ val load: ?message: string -> string -> bool Lwt.t +(** Loads a given piece of code, without displaying its output. The code is + expected to be already compiled to js. + + @param print_outcome + Tells if answers of the toplevel are to be displayed. + @param message + Displays [(* message *)] where the code should have been echoed. + @return + Returns [Success true] whenever the code was correctly + typechecked and its evaluation did not raise an exception nor + timeouted and [false] otherwise. *) +val load_js: + t -> + ?print_outcome:bool -> + ?message: string -> + string -> bool Lwt.t + +val load_cmi_from_string: t -> string -> unit Toploop_results.toplevel_result Lwt.t + (** Parse and typecheck a given source code. *) val check: t -> string -> unit Toploop_results.toplevel_result Lwt.t diff --git a/src/toplevel/learnocaml_toplevel_history.ml b/src/toplevel/learnocaml_toplevel_history.ml index 6465b7317..2c5bbbb11 100644 --- a/src/toplevel/learnocaml_toplevel_history.ml +++ b/src/toplevel/learnocaml_toplevel_history.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/toplevel/learnocaml_toplevel_input.ml b/src/toplevel/learnocaml_toplevel_input.ml index 0fb67163d..e8cb419f3 100644 --- a/src/toplevel/learnocaml_toplevel_input.ml +++ b/src/toplevel/learnocaml_toplevel_input.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/toplevel/learnocaml_toplevel_output.ml b/src/toplevel/learnocaml_toplevel_output.ml index b2a529c45..346195d13 100644 --- a/src/toplevel/learnocaml_toplevel_output.ml +++ b/src/toplevel/learnocaml_toplevel_output.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/toplevel/learnocaml_toplevel_pp.ml b/src/toplevel/learnocaml_toplevel_pp.ml index b312366fa..491b37fa8 100644 --- a/src/toplevel/learnocaml_toplevel_pp.ml +++ b/src/toplevel/learnocaml_toplevel_pp.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/toplevel/learnocaml_toplevel_worker_caller.ml b/src/toplevel/learnocaml_toplevel_worker_caller.ml index 2c5e52960..de3de6460 100644 --- a/src/toplevel/learnocaml_toplevel_worker_caller.ml +++ b/src/toplevel/learnocaml_toplevel_worker_caller.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -138,11 +138,13 @@ let ty_of_host_msg : type t. t host_msg -> t msg_ty = function | Reset -> Unit | Execute _ -> Bool | Use_string _ -> Bool + | Use_compiled_string _ -> Bool | Use_mod_string _ -> Bool | Set_debug _ -> Unit | Check _ -> Unit | Set_checking_environment -> Unit | Register_callback _ -> Unit + | Load_cmi_from_string _ -> Unit (** Threads created with [post] will always be wake-uped by [onmessage] by calling [Lwt.wakeup]. They should never end with @@ -253,6 +255,13 @@ let execute worker ?pp_code ~pp_answer ~print_outcome code = close_fd worker pp_answer; Lwt.return result +let use_compiled_string worker ~pp_answer code = + let pp_answer = create_fd worker pp_answer in + post worker @@ + Use_compiled_string (pp_answer, code) >>= fun result -> + close_fd worker pp_answer; + Lwt.return result + let use_string worker ?filename ~pp_answer ~print_outcome code = let pp_answer = create_fd worker pp_answer in post worker @@ @@ -275,3 +284,7 @@ let register_callback worker name callback = let fd = create_fd worker callback in post worker (Register_callback (name, fd)) >>? fun () -> return_unit_success + +let load_cmi_from_string worker cmi = + post worker @@ + Load_cmi_from_string cmi diff --git a/src/toplevel/learnocaml_toplevel_worker_caller.mli b/src/toplevel/learnocaml_toplevel_worker_caller.mli index b8ed084dd..8de5bfe2a 100644 --- a/src/toplevel/learnocaml_toplevel_worker_caller.mli +++ b/src/toplevel/learnocaml_toplevel_worker_caller.mli @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -84,6 +84,18 @@ val execute: val set_checking_environment: t -> unit toplevel_result Lwt.t +(** Execute a given compiled code (ocaml object or jsoo-compiled version). + + @param pp_answer see {!val:execute}. + + @return as {!val:execute}. + +*) +val use_compiled_string: + t -> + pp_answer:(string -> unit) -> + string -> bool toplevel_result Lwt.t + (** Execute a given source code. The code is parsed and typechecked all at once before to start the evaluation. @@ -131,6 +143,7 @@ val register_callback : t -> string -> (string -> unit) -> unit toplevel_result environment. *) val reset: t -> ?timeout:(unit -> unit Lwt.t) -> unit -> unit Lwt.t +val load_cmi_from_string: t -> string -> unit toplevel_result Lwt.t (** Terminate the toplevel, i.e. destroy the Web Worker. It does nothing if the toplevel as been created with [async=false]. *) diff --git a/src/toplevel/learnocaml_toplevel_worker_main.ml b/src/toplevel/learnocaml_toplevel_worker_main.ml index 9d2c7f022..0b15b1566 100644 --- a/src/toplevel/learnocaml_toplevel_worker_main.ml +++ b/src/toplevel/learnocaml_toplevel_worker_main.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -129,6 +129,15 @@ let make_answer_ppf fd_answer = (fun str -> check_first_call () ; orig_print_string str) (fun () -> check_first_call () ; orig_flush ()) +(* For callbacks that are part of Learnocaml_internal_intf.CALLBACKS and + expected to be registered in advance *) +let print_html_callback = ref (fun _ -> ()) +let print_svg_callback = ref (fun _ -> ()) +let pre_registered_callbacks = [ + "print_html", print_html_callback; + "print_svg", print_svg_callback; +] + (** Code compilation and execution *) (* TODO protect execution with a mutex! *) @@ -161,6 +170,20 @@ let handler : type a. a host_msg -> a return Lwt.t = function iter_option close_fd fd_code; close_fd fd_answer; unwrap_result result + | Use_compiled_string (fd_answer, js_code) -> + let ppf_answer = make_answer_ppf fd_answer in + if !debug then + Js_utils.debug "Worker: -> Use_js_string (%S)" js_code; + let result = + try Toploop_jsoo.use_compiled_string js_code; Toploop_ext.Ok (true, []) + with exn -> + Firebug.console##log (Js.string (Printexc.to_string exn)); + Format.fprintf ppf_answer "%s" (Printexc.to_string exn); Toploop_ext.Ok (false, []) + in + if !debug then + Js_utils.debug "Worker: <- Use_js_string (%B)" (is_success result); + close_fd fd_answer; + unwrap_result result | Use_string (filename, print_outcome, fd_answer, code) -> let ppf_answer = make_answer_ppf fd_answer in if !debug then @@ -210,6 +233,9 @@ let handler : type a. a host_msg -> a return Lwt.t = function val_loc = Location.none } !Toploop.toplevel_env ; Toploop.setvalue name (Obj.repr callback) ; + (match List.assoc_opt name pre_registered_callbacks with + | Some cbr -> cbr := callback + | None -> ()); return_unit_success | Check code -> let saved = !Toploop.toplevel_env in @@ -217,17 +243,22 @@ let handler : type a. a host_msg -> a return Lwt.t = function let result = Toploop_ext.check code in Toploop.toplevel_env := saved ; unwrap_result result + | Load_cmi_from_string cmi -> + Toploop_ext.load_cmi_from_string cmi; + return_unit_success let ty_of_host_msg : type t. t host_msg -> t msg_ty = function | Init -> Unit | Reset -> Unit | Execute _ -> Bool | Use_string _ -> Bool + | Use_compiled_string _ -> Bool | Use_mod_string _ -> Bool | Set_debug _ -> Unit | Check _ -> Unit | Set_checking_environment -> Unit | Register_callback _ -> Unit + | Load_cmi_from_string _ -> Unit let () = let handler (type t) data = @@ -267,3 +298,24 @@ let () = "debug_worker" (Toploop.Directive_bool (fun b -> debug := b)); Worker.set_onmessage (fun s -> Lwt.async (fun () -> handler s)) + +(* Register some dynamic modules that are expected by compiled artifacts loaded + into the exercises. These have no cmi (hence are invisible to non-compiled + code) and are lightweight, so they should not affect the non-exercise + toplevels *) + +let () = + let module Learnocaml_callback: Learnocaml_internal_intf.CALLBACKS = struct + let print_html s = !print_html_callback s + let print_svg s = !print_svg_callback s + end in + Toploop_ext.inject_global "Learnocaml_callback" + (Obj.repr (module Learnocaml_callback: Learnocaml_internal_intf.CALLBACKS)) + +let () = + let module Learnocaml_internal: Learnocaml_internal_intf.INTERNAL = struct + let install_printer = Toploop_ext.install_printer + exception Undefined + end in + Toploop_ext.inject_global "Learnocaml_internal" + (Obj.repr (module Learnocaml_internal: Learnocaml_internal_intf.INTERNAL)) diff --git a/src/toplevel/learnocaml_toplevel_worker_messages.mli b/src/toplevel/learnocaml_toplevel_worker_messages.mli index 146745817..686eb40f2 100644 --- a/src/toplevel/learnocaml_toplevel_worker_messages.mli +++ b/src/toplevel/learnocaml_toplevel_worker_messages.mli @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -15,11 +15,13 @@ type _ host_msg = | Reset : unit host_msg | Execute : int option * bool * int * string -> bool host_msg | Use_string : string option * bool * int * string -> bool host_msg + | Use_compiled_string : int * string -> bool host_msg | Use_mod_string : int * bool * string * string option * string -> bool host_msg | Set_debug : bool -> unit host_msg | Register_callback : string * int -> unit host_msg | Set_checking_environment : unit host_msg | Check : string -> unit host_msg + | Load_cmi_from_string : string -> unit host_msg type _ msg_ty = | Unit : unit msg_ty diff --git a/src/toploop/dune b/src/toploop/dune index a6ff55a40..913cca06d 100644 --- a/src/toploop/dune +++ b/src/toploop/dune @@ -28,6 +28,6 @@ (name toploop_unix) (wrapped false) (modes byte) - (libraries lwt.unix toploop) + (libraries toploop dynlink) (modules Toploop_unix) ) diff --git a/src/toploop/toploop_ext.ml b/src/toploop/toploop_ext.ml index 7e38a147a..577c1d9d0 100644 --- a/src/toploop/toploop_ext.ml +++ b/src/toploop/toploop_ext.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -239,3 +239,181 @@ let check ?(setenv = false) code = | End_of_file -> return_success () | exn -> return_exn exn +let inject_sig name sign = + Toploop.toplevel_env := + Env.add_module + (Ident.create_persistent name) + Types.Mp_present + (Types.Mty_signature sign) + !Toploop.toplevel_env + +let load_cmi_from_string cmi_str = + (* Cmi_format.input_cmi only supports reading from a channel *) + let magic_len = String.length Config.cmi_magic_number in + if String.length cmi_str < magic_len || + String.sub cmi_str 0 magic_len <> Config.cmi_magic_number then + Printf.ksprintf failwith "Bad cmi file"; + let (name, sign) = Marshal.from_string cmi_str magic_len in + (* we ignore crc and flags *) + inject_sig name sign + +let inject_global_hook: (Ident.t -> unit) ref = ref (fun _ -> ()) + +let set_inject_global_hook f = inject_global_hook := f + +let inject_global name obj = + let id = Ident.create_persistent name in + let fake_buf = Misc.LongString.create 4 in + let reloc = [Cmo_format.Reloc_setglobal id, 0] in + Symtable.patch_object fake_buf reloc; + (* we don't care about patching but this is the only entry point that allows us to register the global *) + Symtable.check_global_initialized reloc; + Symtable.update_global_table (); + Symtable.assign_global_value id obj; + !inject_global_hook id + + +(** Printing *) + +(* Replacement for [Toploop.print_value] that doesn't segfault on yet + unregistered extension constructors (needed for printing types defined in + test.ml from within test.ml). *) +module Printer = Genprintval.Make(Obj)(struct + type valu = Obj.t + exception Error + let eval_address = function + | Env.Aident id -> + if Ident.persistent id || Ident.global id then + Symtable.get_global_value id + else begin + let name = Translmod.toplevel_name id in + try Toploop.getvalue name + with _ -> raise Error + end + | Env.Adot(_, _) -> + (* in this case we bail out because this may refer to a + yet-unregistered extension constructor within the current module. + The printer has a reasonable fallback. *) + raise Error + let same_value v1 v2 = (v1 == v2) + end) + +let pending_installed_printers = ref [] + +(** Relies on the env (already loaded cmi) to get the correct type parameters + for the [Printer] functions *) +let install_printer modname id tyname pr = + let open Types in + let inmodpath id = + match String.split_on_char '.' modname with + | md::r -> + List.fold_left (fun acc id -> Path.Pdot (acc, id)) + (Path.Pident (Ident.create_persistent md)) (r @ [id]) + | [] -> + Path.Pident (Ident.create_local id) + in + let printer_path = inmodpath id in + let env = !Toploop.toplevel_env in + let ( @-> ) a b = Ctype.newty (Tarrow (Asttypes.Nolabel, a, b, Cunknown)) in + let gen_printer_type ty = + let format_ty = + let ( +. ) a b = Path.Pdot (a, b) in + Path.Pident (Ident.create_persistent "Stdlib") +. "Format" +. "formatter" + in + (Ctype.newty (Tconstr (format_ty, [], ref Mnil)) + @-> ty + @-> Predef.type_unit) + in + let ty_path1 = inmodpath tyname in + match + Env.find_value printer_path env, + try ty_path1, Env.find_type ty_path1 env + with Not_found -> Env.find_type_by_name (Longident.Lident tyname) env + with + | exception Not_found -> + Format.printf + "Warning: bad printer definition %s.print_%s. The type and printer \ + must be found in the cmi file (no mli file allowed).@." + modname tyname + | printer_desc, (ty_path, ty_decl) -> + Ctype.begin_def(); + let ty_args = List.map (fun _ -> Ctype.newvar ()) ty_decl.type_params in + let ty_target = + Ctype.expand_head env + (Ctype.newty (Tconstr (ty_path, ty_args, ref Mnil))) + in + let printer_ty_expected = + List.fold_right (fun argty ty -> gen_printer_type argty @-> ty) + ty_args + (gen_printer_type ty_target) + in + (try + Ctype.unify env + printer_ty_expected + (Ctype.instance printer_desc.val_type) + with Ctype.Unify _ -> + Format.printf + "Warning: mismatching type for print function %s.print_%s.@;\ + The type must be@ @[%aformatter -> %a%s -> unit@]@." + modname tyname + (Format.pp_print_list + (fun ppf -> Format.fprintf ppf "(formatter -> %a -> unit) ->@ " + (Printtyp.type_expr))) + ty_args + (fun ppf -> function + | [] -> () + | [arg] -> Format.fprintf ppf "%a " Printtyp.type_expr arg + | args -> + Format.fprintf ppf "(%a) " + (Format.pp_print_list + ~pp_sep:(fun ppf () -> Format.pp_print_string ppf ", ") + Printtyp.type_expr) + args) + ty_args + tyname); + Ctype.end_def (); + Ctype.generalize printer_ty_expected; + let register_as_path = inmodpath ("print_"^tyname) in + let rec build_generic v = function + | [] -> + Genprintval.Zero + (fun formatter repr -> Obj.obj v formatter (Obj.obj repr)) + | _ :: args -> + Genprintval.Succ + (fun fn -> build_generic ((Obj.obj v : _ -> Obj.t) fn) args) + in + (* Register for our custom 'Printer' as used by the graders *) + let () = + match ty_decl.type_params, ty_target.desc with + | [], _ -> + Printer.install_printer register_as_path ty_target + (fun ppf repr -> Obj.magic pr ppf (Obj.obj repr)) + | _, (Tconstr (ty_path, args, _) | Tlink {desc = Tconstr (ty_path, args, _); _}) + when Ctype.all_distinct_vars env args -> + Printer.install_generic_printer' register_as_path ty_path + (build_generic (Obj.repr pr) ty_decl.type_params) + | _, ty -> + Format.printf + "Warning: invalid printer for %a = %a: OCaml doesn't support \ + printers for types with partially instanciated variables. \ + Define a generic printer and a printer for the type of your \ + variable instead." + Printtyp.path ty_path + Printtyp.type_expr (Ctype.newty ty) + in + (* Register for the toplevel built-in printer (the API doesn't allow us to + override it). Attempting to use the printer registered this way before + the module is fully loaded would risk crashes (e.g. on extensible + variants) *) + let rec path_to_longident = function + | Path.Pdot (p, s) -> Longident.Ldot (path_to_longident p, s) + | Path.Pident i -> Longident.Lident (Ident.name i) + | Path.Papply _ -> assert false + in + pending_installed_printers := + path_to_longident printer_path :: !pending_installed_printers + +let register_pending_printers () = + List.iter (Topdirs.dir_install_printer Format.std_formatter) + (List.rev !pending_installed_printers); + pending_installed_printers := [] diff --git a/src/toploop/toploop_ext.mli b/src/toploop/toploop_ext.mli index 75f0c3c8b..be386ffc3 100644 --- a/src/toploop/toploop_ext.mli +++ b/src/toploop/toploop_ext.mli @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -91,9 +91,31 @@ val use_mod_string: ?sig_code:string -> string -> bool toplevel_result +(** Registers the given cmi files contents into the running toplevel *) +val load_cmi_from_string: + string -> unit + +(** Registers a global into the toplevel. Can be used to dynamically create + compilation units ([inject_global "Foo" (Obj.repr (module Foo))]). Does not + affect the environment (suppose a corresponding .cmi) *) +val inject_global: string -> Obj.t -> unit + +(** Register a hook to be called after inject_global on the newly registered + ident. Useful for jsoo which has additional registrations required. *) +val set_inject_global_hook: (Ident.t -> unit) -> unit + (** Helpers to embed PPX into the toplevel. *) module Ppx : sig val preprocess_structure: Parsetree.structure -> Parsetree.structure val preprocess_signature: Parsetree.signature -> Parsetree.signature val preprocess_phrase: Parsetree.toplevel_phrase -> Parsetree.toplevel_phrase end + +module Printer : Genprintval.S with type t = Obj.t + +(** Used by our ppx *) +val install_printer: string -> string -> string -> ('a -> 'b) -> unit + +(** Hook to be called after loading units so that the registered printers are + present also in the toplevel's built-in printer. *) +val register_pending_printers: unit -> unit diff --git a/src/toploop/toploop_jsoo.ml b/src/toploop/toploop_jsoo.ml index 35d36f3c5..9a2e6c89b 100644 --- a/src/toploop/toploop_jsoo.ml +++ b/src/toploop/toploop_jsoo.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -128,3 +128,27 @@ let stop_channel_redirection redir = Sys_js.set_channel_flusher redir.channel append ; with Not_found -> fail () + +let use_compiled_string code = + (* jsoo supports dynload, but relies on expectations on the parent object that + are no longer valid when running from a web-worker. Thus we compile with + `jsoo --wrap-with` and apply explicitely to the global object *) + let clean_code = + let b = Buffer.create (String.length code + 2) in + let i = String.rindex code '}' in + (* jsoo >=4 adds garbage after the fun def with --wrap-with *) + Buffer.add_char b '('; + Buffer.add_substring b code 0 (i+1); + Buffer.add_char b ')'; + Buffer.contents b + in + ignore @@ + Js.Unsafe.fun_call (Js.Unsafe.eval_string clean_code) + [|Js.Unsafe.inject Js.Unsafe.global|]; + Toploop_ext.register_pending_printers () + +let () = Toploop_ext.set_inject_global_hook @@ fun id -> + Js_of_ocaml.Js.Unsafe.set + (Js_of_ocaml.Js.Unsafe.js_expr "jsoo_runtime.caml_global_data") + (Js_of_ocaml.Js.string (Ident.name id)) + (Symtable.get_global_value id) diff --git a/src/toploop/toploop_jsoo.mli b/src/toploop/toploop_jsoo.mli index 387de8c75..2da1ff8a5 100644 --- a/src/toploop/toploop_jsoo.mli +++ b/src/toploop/toploop_jsoo.mli @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -10,6 +10,9 @@ argument*) val initialize: string list -> unit +(** Load compiled code as a string *) +val use_compiled_string: string -> unit + (** Materializes an output channel redirection. *) type redirection diff --git a/src/toploop/toploop_results.ml b/src/toploop/toploop_results.ml index cda6be8b5..819d6aa20 100644 --- a/src/toploop/toploop_results.ml +++ b/src/toploop/toploop_results.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/toploop/toploop_unix.ml b/src/toploop/toploop_unix.ml index 27f23201f..bcf58eb5e 100644 --- a/src/toploop/toploop_unix.ml +++ b/src/toploop/toploop_unix.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -70,3 +70,26 @@ let stop_channel_redirection ({ target_fd ; read_fd ; backup_fd ; _ } as redirec let initialize () = Toploop.initialize_toplevel_env () + +let use_compiled_string code = + let cma = Filename.temp_file "learnocaml-file" ".cma" in + let r = + try + let oc = open_out_bin cma in + output_string oc code; + close_out oc; + Topdirs.load_file Format.std_formatter cma + with + | Symtable.Error e -> + Format.kasprintf (fun msg -> Sys.remove cma; failwith msg) + "%a" + Symtable.report_error e + | exn -> + Sys.remove cma; + raise exn + in + Sys.remove cma; + Toploop_ext.register_pending_printers (); + flush_all (); + if r then () + else failwith "Failed to load compiled code" diff --git a/src/toploop/toploop_unix.mli b/src/toploop/toploop_unix.mli index 7a7c0d736..9828b6bed 100644 --- a/src/toploop/toploop_unix.mli +++ b/src/toploop/toploop_unix.mli @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -9,6 +9,9 @@ (** To be called before using any [Toploop] function. *) val initialize: unit -> unit +(** Load the given compiled code *) +val use_compiled_string: string -> unit + (** Materializes an output channel redirection. *) type redirection @@ -30,7 +33,7 @@ val flush_redirected_channel : redirection -> unit (** Flushes the channel and then cancel the redirection. The redirection must be the last one performed, otherwise an [Invalid_argument] will be raised. - A stack of redirections is maintained for all fire descriptors. So + A stack of redirections is maintained for all file descriptors. So the channel is then restored to either the previous redirection or to the original file descriptor. *) val stop_channel_redirection : redirection -> unit diff --git a/src/utils/dune b/src/utils/dune index cb9f0f4dc..afefe93c6 100644 --- a/src/utils/dune +++ b/src/utils/dune @@ -33,14 +33,6 @@ (modules Lwt_utils) ) -(library - (name learnocaml_xor) - (wrapped false) - (flags :standard -warn-error A-4-42-44-45-48) - (libraries base64) - (modules Learnocaml_xor) - ) - (library (name sha) (wrapped false) diff --git a/src/utils/learnocaml_partition_create.ml b/src/utils/learnocaml_partition_create.ml index daa967ca4..453e79a21 100644 --- a/src/utils/learnocaml_partition_create.ml +++ b/src/utils/learnocaml_partition_create.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -90,17 +90,27 @@ let asak_partition prof fun_name sol by_grade = (ans.Partition.bad_type @ bad_type, (i,ans.Partition.clusters) :: res) ) by_grade ([],[]) +let read_cmi_from_file cmi_str = + (* Cmi_format.input_cmi only supports reading from a channel *) + let magic_len = String.length Config.cmi_magic_number in + if String.length cmi_str < magic_len || + String.sub cmi_str 0 magic_len <> Config.cmi_magic_number then + Printf.ksprintf failwith "Bad cmi file"; + (* we ignore crc and flags *) + (Marshal.from_string cmi_str magic_len : (string*Types.signature_item list)) + let partition exo_name fun_name prof = Learnocaml_store.Exercise.get exo_name >>= fun exo -> - let prelude = Learnocaml_exercise.(access File.prelude exo) in - let prepare = Learnocaml_exercise.(decipher File.prepare exo) in + let prelude = Learnocaml_exercise.(access File.prelude_ml exo) in + let prepare = Learnocaml_exercise.(decipher File.prepare_ml exo) in let prelude = prelude ^ "\n" ^ prepare in - let solution = Learnocaml_exercise.(decipher File.solution exo) in - let solution = prelude ^ "\n" ^ solution in + let (_,solution) = + read_cmi_from_file (Learnocaml_exercise.(decipher File.solution_cmi exo)) in + let sol_typ = Asak.Partition.find_value_type_from_signature fun_name solution in get_all_saves exo_name prelude >|= fun saves -> let not_graded,lst = partition_was_graded saves in let by_grade = partition_by_grade fun_name lst in - let bad_type,partition_by_grade = asak_partition prof fun_name solution by_grade in + let bad_type,partition_by_grade = asak_partition prof fun_name sol_typ by_grade in {not_graded; bad_type; partition_by_grade} diff --git a/src/utils/learnocaml_xor.ml b/src/utils/learnocaml_xor.ml deleted file mode 100644 index 6f94d5fe0..000000000 --- a/src/utils/learnocaml_xor.ml +++ /dev/null @@ -1,45 +0,0 @@ -(* This file is part of Learn-OCaml. - * - * Copyright (C) 2019 OCaml Software Foundation. - * Copyright (C) 2015-2018 OCamlPro. - * - * Learn-OCaml is distributed under the terms of the MIT license. See the - * included LICENSE file for details. *) - -let alphabet = - Bytes.of_string - "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" - -let () = - Bytes.set alphabet 26 '+'; - Bytes.set alphabet 37 '/'; - for i = 0 to 25 do - Bytes.set alphabet i (Char.chr @@ 65 + i); - Bytes.set alphabet (i+38) (Char.chr @@ 97 + 25 - i) - done; - for i = 0 to 9 do - Bytes.set alphabet (i+27) (Char.chr @@ 48 + i) - done - -let xor_key = - "Caml1999I0150\153\200\232\027\154a\029u@\251\127SX\141\140\157\ - \219\195\000\228\020\180_CR\202\130\129\127\2491\130\011\183\ - \158b\022\"qB0\166+\169\212_\205\164 D\210Qn\181o\225\147q\156\ - \028u6\248b\177\002\164`\187\250\221\240o6\156\240\020\027\243o\ - \017h\218\208\168\164f\161+5\137\132ml\169\235\174\212\029" - -let xor ?prefix str = - let xor_key = - match prefix with - | None -> xor_key - | Some prefix -> prefix ^ xor_key in - let str' = Bytes.create (String.length str) in - for i = 0 to String.length str - 1 do - let c = Char.code xor_key.[i mod (String.length xor_key)] in - Bytes.set str' (i) (Char.chr (c lxor (Char.code (String.get str i)))) - done; - Bytes.to_string str' - -let alphabet = Base64.make_alphabet (Bytes.to_string alphabet) -let decode ?prefix str = xor ?prefix @@ (Base64.decode ~alphabet str |> Result.get_ok) -let encode ?prefix str = Base64.encode ~alphabet @@ xor ?prefix str |> Result.get_ok diff --git a/src/utils/learnocaml_xor.mli b/src/utils/learnocaml_xor.mli deleted file mode 100644 index d104a495b..000000000 --- a/src/utils/learnocaml_xor.mli +++ /dev/null @@ -1,12 +0,0 @@ -(* This file is part of Learn-OCaml. - * - * Copyright (C) 2019 OCaml Software Foundation. - * Copyright (C) 2015-2018 OCamlPro. - * - * Learn-OCaml is distributed under the terms of the MIT license. See the - * included LICENSE file for details. *) - -(* This is trivial and dummy "encryption" for the tests and the solutions. *) - -val encode: ?prefix:string -> string -> string -val decode: ?prefix:string -> string -> string diff --git a/src/utils/lwt_request.ml b/src/utils/lwt_request.ml index 8c2eab8b5..a5413889a 100644 --- a/src/utils/lwt_request.ml +++ b/src/utils/lwt_request.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the diff --git a/src/utils/lwt_utils.ml b/src/utils/lwt_utils.ml index df972c6e3..51ddabb91 100644 --- a/src/utils/lwt_utils.ml +++ b/src/utils/lwt_utils.ml @@ -1,6 +1,6 @@ (* This file is part of Learn-OCaml. * - * Copyright (C) 2019 OCaml Software Foundation. + * Copyright (C) 2019-2023 OCaml Software Foundation. * Copyright (C) 2015-2018 OCamlPro. * * Learn-OCaml is distributed under the terms of the MIT license. See the @@ -9,16 +9,18 @@ open Lwt.Infix let rec mkdir_p ?(perm=0o755) dir = - Lwt_unix.file_exists dir >>= function - | true -> + if Sys.file_exists dir then if Sys.is_directory dir then Lwt.return () else Lwt.fail_with (Printf.sprintf "Can't create dir: file %s is in the way" dir) - | false -> - mkdir_p (Filename.dirname dir) >>= fun () -> - Lwt_unix.mkdir dir perm + else + if Sys.file_exists (Filename.dirname dir) then + Lwt.return (Unix.mkdir dir perm) + else + mkdir_p ~perm (Filename.dirname dir) >>= fun () -> + mkdir_p ~perm dir let copy_file src dst = Lwt.catch (fun () -> diff --git a/tests/runtests.sh b/tests/runtests.sh index c1f06b506..2905f3704 100755 --- a/tests/runtests.sh +++ b/tests/runtests.sh @@ -67,16 +67,16 @@ wait_for_it () { run_server () { SYNC="$srcdir"/"$dir"/sync REPO="$srcdir"/"$dir"/repo + chmod -R a+w "$REPO" - mkdir "$SYNC" 2>/dev/null + mkdir -p "$SYNC" 2>/dev/null chmod o+w "$SYNC" # Run the server in background - SERVERID=$(set -x; docker run --entrypoint '' -d -p 8080:8080 \ + SERVERID=$(set -x; docker run -d -p 8080:8080 \ -v "$srcdir/$dir":/home/learn-ocaml/actual \ -v "$SYNC":/sync -v "$REPO":/repository \ - learn-ocaml /bin/sh -c \ - "learn-ocaml --sync-dir=/sync --repo=/repository build serve") + learn-ocaml) # Wait for the server to be initialized if ! wait_for_it "http://localhost:8080/version" "$build_timeout" sleep 1s || @@ -232,9 +232,11 @@ while IFS= read -r corpus; do echo "---> Testing corpus $corpus:" - if ! ( set -x; docker run --entrypoint '' \ + chmod -R a+w "$corpus" + + if ! ( set -x; docker run --rm \ -v "$(realpath "$corpus"):/repository" \ - learn-ocaml /bin/sh -c "learn-ocaml --repo=/repository build" ); then + learn-ocaml build ); then red "Failed to build $corpus" exit 1 fi diff --git a/translations/fr.po b/translations/fr.po index 201aad75a..9b7e4fd89 100644 --- a/translations/fr.po +++ b/translations/fr.po @@ -1,5 +1,5 @@ # LEARN-OCAML FRENCH TRANSLATION -# Copyright (C) 2019 OCaml Software Foundation. +# Copyright (C) 2019-2023 OCaml Software Foundation. # Copyright (C) 2018 OCamlPro # Louis Gesbert , 2018. # @@ -206,7 +206,7 @@ msgstr "Statistiques" #: File "src/app/learnocaml_common.ml", line 836, characters 37-48 #: "src/app/learnocaml_index_main.ml", 843, 29-40 #: "src/app/learnocaml_teacher_tab.ml", 375, 21-32 -#: "src/app/learnocaml_exercise_main.ml", 204, 23-34 +#: "src/app/learnocaml_exercise_main.ml", 213, 23-34 msgid "Exercises" msgstr "Exercices" @@ -338,55 +338,55 @@ msgstr "Métadonnées" msgid "The toplevel has been cleared.\n" msgstr "Le toplevel a été nettoyé.\n" -#: File "src/toplevel/learnocaml_toplevel.ml", line 271, characters 36-49 +#: File "src/toplevel/learnocaml_toplevel.ml", line 303, characters 36-49 msgid "%d seconds!" msgstr "%d secondes !" -#: File "src/toplevel/learnocaml_toplevel.ml", line 274, characters 20-30 +#: File "src/toplevel/learnocaml_toplevel.ml", line 306, characters 20-30 msgid "Kill it!" msgstr "Le terminer !" -#: File "src/toplevel/learnocaml_toplevel.ml", line 284, characters 24-40 +#: File "src/toplevel/learnocaml_toplevel.ml", line 316, characters 24-40 msgid "Infinite loop?" msgstr "Boucle infinie ?" -#: File "src/toplevel/learnocaml_toplevel.ml", line 286, characters 23-66 +#: File "src/toplevel/learnocaml_toplevel.ml", line 318, characters 23-66 msgid "The toplevel has not been responding for " msgstr "Le toplevel ne répond plus depuis " -#: File "src/toplevel/learnocaml_toplevel.ml", line 288, characters 23-34 292, +#: File "src/toplevel/learnocaml_toplevel.ml", line 320, characters 23-34 324, msgid " seconds." msgstr " secondes." -#: File "src/toplevel/learnocaml_toplevel.ml", line 290, characters 23-46 +#: File "src/toplevel/learnocaml_toplevel.ml", line 322, characters 23-46 msgid "It will be killed in " msgstr "Il sera terminé dans " -#: File "src/toplevel/learnocaml_toplevel.ml", line 321, characters 20-34 +#: File "src/toplevel/learnocaml_toplevel.ml", line 353, characters 20-34 msgid "Show anyway!" msgstr "Afficher quand même !" -#: File "src/toplevel/learnocaml_toplevel.ml", line 323, characters 20-34 +#: File "src/toplevel/learnocaml_toplevel.ml", line 355, characters 20-34 msgid "Hide output!" msgstr "Masquer la sortie !" -#: File "src/toplevel/learnocaml_toplevel.ml", line 332, characters 24-41 +#: File "src/toplevel/learnocaml_toplevel.ml", line 364, characters 24-41 msgid "Flooded output!" msgstr "La sortie déborde !" -#: File "src/toplevel/learnocaml_toplevel.ml", line 335, characters 30-69 +#: File "src/toplevel/learnocaml_toplevel.ml", line 367, characters 30-69 msgid "Your code is flooding the %s channel." msgstr "Votre code submerge le canal %s." -#: File "src/toplevel/learnocaml_toplevel.ml", line 337, characters 23-48 +#: File "src/toplevel/learnocaml_toplevel.ml", line 369, characters 23-48 msgid "It has already printed " msgstr "Il a déjà affiché " -#: File "src/toplevel/learnocaml_toplevel.ml", line 339, characters 23-32 +#: File "src/toplevel/learnocaml_toplevel.ml", line 371, characters 23-32 msgid " bytes." msgstr " octets." -#: File "src/toplevel/learnocaml_toplevel.ml", line 375, characters 44-80 +#: File "src/toplevel/learnocaml_toplevel.ml", line 407, characters 44-80 msgid "" "\n" "Interrupted output channel %s.\n" @@ -394,7 +394,7 @@ msgstr "" "\n" "Canal de sortie %s interrompu.\n" -#: File "src/toplevel/learnocaml_toplevel.ml", lines 407-412, characters 5-39 +#: File "src/toplevel/learnocaml_toplevel.ml", lines 439-444, characters 5-39 msgid "" "Printf.printf \"Welcome to OCaml %s\\n%!\" (Sys.ocaml_version);\n" "print_endline \" - type your OCaml phrase in the box below and press [Enter]\";\n" @@ -408,7 +408,7 @@ msgstr "" "print_endline \" - utilisez [Ctrl-\\xe2\\x86\\x91] pour retrouver votre entrée précédente\";\n" "print_endline \" - utilisez [Ctrl-\\xe2\\x86\\x91] / [Ctrl-\\xe2\\x86\\x93] pour naviguer dans l'historique\";;" -#: File "src/toplevel/learnocaml_toplevel.ml", line 518, characters 11-43 +#: File "src/toplevel/learnocaml_toplevel.ml", line 550, characters 11-43 msgid "The toplevel has been reset.\n" msgstr "Le toplevel a été redémarré.\n" @@ -968,7 +968,7 @@ msgstr "" "%a\n" "%!" -#: File "src/grader/grading.ml", line 22, characters 28-59 +#: File "src/grader/grading.ml", line 22, characters 26-57 msgid "" "Error in user code:\n" "\n" @@ -980,47 +980,28 @@ msgstr "" "%a\n" "%!" -#: File "src/grader/grading.ml", line 96, characters 38-65 106, 131, 139, 143, -msgid "while preparing the tests" -msgstr "lors de la préparation des tests" - -#: File "src/grader/grading.ml", line 100, characters 22-44 -msgid "Loading the prelude." -msgstr "Chargement du prélude." +#: File "src/grader/grading.ml", line 25, characters 9-32 +msgid "The grader is invalid" +msgstr "Le moteur de notation est invalide" -#: File "src/grader/grading.ml", line 101, characters 38-65 -msgid "while loading the prelude" -msgstr "lors du chargement du prélude" - -#: File "src/grader/grading.ml", line 105, characters 22-55 +#: File "src/grader/grading.ml", line 115, characters 22-55 msgid "Preparing the test environment." msgstr "Préparation de l'environnement de test." -#: File "src/grader/grading.ml", line 110, characters 22-42 +#: File "src/grader/grading.ml", line 119, characters 38-65 125, 128, 131, 134, +#: 168, 175, 181, +msgid "while preparing the tests" +msgstr "lors de la préparation des tests" + +#: File "src/grader/grading.ml", line 138, characters 22-42 msgid "Loading your code." msgstr "Chargement du code utilisateur." -#: File "src/grader/grading.ml", line 115, characters 22-45 -msgid "Loading the solution." -msgstr "Chargement de la solution." - -#: File "src/grader/grading.ml", line 116, characters 38-66 -msgid "while loading the solution" -msgstr "lors du chargement de la solution" - -#: File "src/grader/grading.ml", line 120, characters 22-54 +#: File "src/grader/grading.ml", line 145, characters 22-54 msgid "Preparing to launch the tests." msgstr "Préparation du lancement des tests." -#: File "src/grader/grading.ml", line 146, characters 22-49 -msgid "Launching the test bench." -msgstr "Lancement du banc de test." - -#: File "src/grader/grading.ml", line 175, characters 45-78 -msgid "while loading user dependencies" -msgstr "lors du chargement des dépendances" - -#: File "src/grader/grading.ml", line 191, characters 38-67 +#: File "src/grader/grading.ml", line 183, characters 38-67 msgid "while testing your solution" msgstr "lors du test de la solution utilisateur" @@ -1048,46 +1029,46 @@ msgstr "TEMPS ÉCOULÉ" msgid "The deadline for this exercise has expired. Any changes you make from now on will remain local only." msgstr "La date limite de rendu de cet exercice est passée. Vos changements ne seront plus sauvegardés sur le serveur." -#: File "src/app/learnocaml_exercise_main.ml", line 130, characters 25-49 -#: "src/app/learnocaml_playground_main.ml", 47, 19-43 -msgid "loading the prelude..." -msgstr "Chargement du prélude..." - -#: File "src/app/learnocaml_exercise_main.ml", line 135, characters 41-59 -#: "src/app/learnocaml_playground_main.ml", 50, 31-49 +#: File "src/app/learnocaml_exercise_main.ml", line 134, characters 36-54 137, +#: 35-53 139, 141, 143, "src/app/learnocaml_playground_main.ml", 50, 31-49 msgid "error in prelude" msgstr "erreur dans le prélude" -#: File "src/app/learnocaml_exercise_main.ml", line 216, characters 28-37 +#: File "src/app/learnocaml_exercise_main.ml", line 136, characters 19-43 +#: "src/app/learnocaml_playground_main.ml", 47, +msgid "loading the prelude..." +msgstr "Chargement du prélude..." + +#: File "src/app/learnocaml_exercise_main.ml", line 224, characters 28-37 #: "src/app/learnocaml_playground_main.ml", 84, msgid "Compile" msgstr "Compiler" -#: File "src/app/learnocaml_exercise_main.ml", line 220, characters 25-33 +#: File "src/app/learnocaml_exercise_main.ml", line 228, characters 29-37 msgid "Grade!" msgstr "Noter!" -#: File "src/app/learnocaml_exercise_main.ml", line 224, characters 48-55 +#: File "src/app/learnocaml_exercise_main.ml", line 232, characters 48-55 msgid "abort" msgstr "abandonner" -#: File "src/app/learnocaml_exercise_main.ml", lines 228-229, characters 35-65 +#: File "src/app/learnocaml_exercise_main.ml", lines 236-237, characters 35-65 msgid "Grading is taking a lot of time, maybe your code is looping? " msgstr "La notation prend du temps, peut-être une boucle infinie dans votre code ? " -#: File "src/app/learnocaml_exercise_main.ml", line 235, characters 35-57 +#: File "src/app/learnocaml_exercise_main.ml", line 243, characters 35-57 msgid "Launching the grader" msgstr "Lancement de la notation" -#: File "src/app/learnocaml_exercise_main.ml", line 258, characters 60-86 +#: File "src/app/learnocaml_exercise_main.ml", line 266, characters 60-86 msgid "Grading aborted by user." msgstr "Notation annulée par l'utilisateur." -#: File "src/app/learnocaml_exercise_main.ml", line 280, characters 38-59 +#: File "src/app/learnocaml_exercise_main.ml", line 288, characters 38-59 msgid "Error in your code." msgstr "Erreur dans le code." -#: File "src/app/learnocaml_exercise_main.ml", line 281, characters 27-85 +#: File "src/app/learnocaml_exercise_main.ml", line 289, characters 27-85 msgid "Cannot start the grader if your code does not typecheck." msgstr "La notation ne peut être lancée si le code ne compile pas." @@ -1172,7 +1153,7 @@ msgstr "Aucun rapport" msgid "Status of student: " msgstr "Suivi étudiant: " -#: File "src/grader/grader_jsoo_worker.ml", line 57, characters 34-67 +#: File "src/grader/grader_jsoo_worker.ml", line 65, characters 34-67 msgid "" "Error in your solution:\n" "%a\n" @@ -1182,7 +1163,7 @@ msgstr "" "%a\n" "%!" -#: File "src/grader/grader_jsoo_worker.ml", line 60, characters 34-68 +#: File "src/grader/grader_jsoo_worker.ml", line 68, characters 34-68 msgid "" "Error in the exercise %s\n" "%a\n" @@ -1192,7 +1173,7 @@ msgstr "" "%a\n" "%!" -#: File "src/grader/grader_jsoo_worker.ml", line 64, characters 17-71 +#: File "src/grader/grader_jsoo_worker.ml", line 72, characters 17-71 msgid "" "Internal error:\n" "The grader did not return a report." @@ -1200,10 +1181,8 @@ msgstr "" "Erreur interne:\n" "Le moteur de notation n'a pas retourné de rapport." -#: File "src/grader/grader_jsoo_worker.ml", line 66, characters 17-38 -msgid "Unexpected error:\n" -msgstr "Erreur inattendue:\n" - +#~ msgid "Unexpected error:\n" +#~ msgstr "Erreur inattendue:\n" #~ msgid "By prerequisites" #~ msgstr "Par prérequis" @@ -1222,14 +1201,6 @@ msgstr "Erreur inattendue:\n" #~ msgid "Download student data as CSV" #~ msgstr "Exporter les données étudiants en CSV" -#~ msgid "Fetch from server" -#~ msgstr "Télécharger du serveur" - -#~ msgid "Ignore & keep editing" -#~ msgstr "Ignorer & continuer d'éditer" - -#~ msgid "Fetch from server & overwrite" -#~ msgstr "Télécharger du serveur & écraser" #~ msgid "A more recent answer exists on the server. Do you want to fetch the new version?" #~ msgstr "Une version plus récente de cette réponse existe sur le serveur. Voulez-vous télécharger la nouvelle version ?"