diff --git a/Changes.md b/Changes.md index 1dd79daadd..ba8dc4c1b9 100644 --- a/Changes.md +++ b/Changes.md @@ -22,6 +22,8 @@ Unreleased 1. Exception ID `RE_EXN_ID` to `MEL_EXN_ID` 2. `BS_PRIVATE_NESTED_SOME_NONE` option marker to `MEL_PRIVATE_NESTED_SOME_NONE` +- Consistently handle empty payloads in externals: + ([#852](https://github.com/melange-re/melange/pull/852)) 2.1.0 2023-10-22 --------------- diff --git a/ppx/ast_attributes.ml b/ppx/ast_attributes.ml index 3ab33b774e..35893773aa 100644 --- a/ppx/ast_attributes.ml +++ b/ppx/ast_attributes.ml @@ -325,14 +325,17 @@ let external_attrs = |] let first_char_special (x : string) = - match String.unsafe_get x 0 with - | '#' | '?' | '%' -> true - | _ -> - (* XXX(anmonteiro): Upstream considers "builtin" attributes ones that - start with `?`. We keep the original terminology of `caml_` (and, - incidentally, `nativeint_`). *) - String.starts_with x ~prefix:"caml_" - || String.starts_with x ~prefix:"nativeint_" + match x with + | "" -> false + | _ -> ( + match String.unsafe_get x 0 with + | '#' | '?' | '%' -> true + | _ -> + (* XXX(anmonteiro): Upstream considers "builtin" attributes ones that + start with `?`. We keep the original terminology of `caml_` (and, + incidentally, `nativeint_`). *) + String.starts_with x ~prefix:"caml_" + || String.starts_with x ~prefix:"nativeint_") let first_marshal_char (x : string) = x <> "" && String.unsafe_get x 0 = '\132' diff --git a/test/blackbox-tests/external-with-empty-payload.t b/test/blackbox-tests/external-with-empty-payload.t new file mode 100644 index 0000000000..cf4ea1caf3 --- /dev/null +++ b/test/blackbox-tests/external-with-empty-payload.t @@ -0,0 +1,11 @@ + $ . ./setup.sh + $ cat > x.ml < external f : int = "" + > EOF + $ melc -ppx melppx x.ml + File "x.ml", line 1, characters 0-21: + 1 | external f : int = "" + ^^^^^^^^^^^^^^^^^^^^^ + Alert fragile: f : the external name is inferred from val name is unsafe from refactoring when changing value name + // Generated by Melange + /* This output is empty. Its source's type definitions, externals and/or unused code got optimized away. */ diff --git a/test/blackbox-tests/melange-playground/compile-ml-external.t b/test/blackbox-tests/melange-playground/compile-ml-external.t new file mode 100644 index 0000000000..afe19d0cec --- /dev/null +++ b/test/blackbox-tests/melange-playground/compile-ml-external.t @@ -0,0 +1,17 @@ + $ cat > input.js < require(process.env.DUNE_SOURCEROOT + '/_build/default/bin/jsoo_main.bc.js'); + > require(process.env.DUNE_SOURCEROOT + '/_build/default/bin/melange-cmijs.js'); + > console.log(ocaml.compileML("external f : int = \"\"")); + > EOF + + $ node input.js + File "_none_", line 1, characters 0-21: + Alert fragile: f : the external name is inferred from val name is unsafe from refactoring when changing value name + { + js_code: '// Generated by Melange\n' + + "/* This output is empty. Its source's type definitions, externals and/or unused code got optimized away. */\n", + warnings: [], + type_hints: [ + { start: [Object], end: [Object], kind: 'core_type', hint: 'int' } + ] + } diff --git a/test/blackbox-tests/melange-playground/compile-ml-mel-attr.t b/test/blackbox-tests/melange-playground/compile-ml-mel-attr.t new file mode 100644 index 0000000000..6141c3d9a4 --- /dev/null +++ b/test/blackbox-tests/melange-playground/compile-ml-mel-attr.t @@ -0,0 +1,52 @@ + $ cat > input.js < require(process.env.DUNE_SOURCEROOT + '/_build/default/bin/jsoo_main.bc.js'); + > require(process.env.DUNE_SOURCEROOT + '/_build/default/bin/melange-cmijs.js'); + > console.log(ocaml.compileML("external imul : int -> int -> int = \"imul\"[@@mel.scope \"Math\"]\nlet res = imul 1 2")); + > EOF + + $ node input.js + { + js_code: '// Generated by Melange\n' + + '\n' + + '\n' + + 'var res = Math.imul(1, 2);\n' + + '\n' + + 'export {\n' + + ' res ,\n' + + '}\n' + + '/* res Not a pure module */\n', + warnings: [], + type_hints: [ + { start: [Object], end: [Object], kind: 'expression', hint: 'int' }, + { start: [Object], end: [Object], kind: 'expression', hint: 'int' }, + { + start: [Object], + end: [Object], + kind: 'expression', + hint: 'int -> int -> int' + }, + { start: [Object], end: [Object], kind: 'expression', hint: 'int' }, + { + start: [Object], + end: [Object], + kind: 'pattern_type', + hint: 'int' + }, + { start: [Object], end: [Object], kind: 'binding', hint: 'int' }, + { start: [Object], end: [Object], kind: 'core_type', hint: 'int' }, + { start: [Object], end: [Object], kind: 'core_type', hint: 'int' }, + { + start: [Object], + end: [Object], + kind: 'core_type', + hint: 'int -> int' + }, + { start: [Object], end: [Object], kind: 'core_type', hint: 'int' }, + { + start: [Object], + end: [Object], + kind: 'core_type', + hint: 'int -> int -> int' + } + ] + }