Fix external analysis (#852)

* add tests showing behavior when externals have empty payload

* fix externals with empty payloads in playground

* add changelog entry

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
 ---------------

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'
 

test/blackbox-tests/external-with-empty-payload.t

@@ -0,0 +1,11 @@
+  $ . ./setup.sh
+  $ cat > x.ml <<EOF
+  > 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. */

test/blackbox-tests/melange-playground/compile-ml-external.t

@@ -0,0 +1,17 @@
+  $ cat > input.js <<EOF
+  > 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' }
+    ]
+  }

test/blackbox-tests/melange-playground/compile-ml-mel-attr.t

@@ -0,0 +1,52 @@
+  $ cat > input.js <<EOF
+  > 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'
+      }
+    ]
+  }