Report unsupported USAGE clauses

CHANGELOG.md

@@ -5,6 +5,7 @@
 ### Added
 - Enforcement of Area A checks only when the source format is `COBOL85` [#555](https://github.com/OCamlPro/superbol-studio-oss/pull/555) [#556](https://github.com/OCamlPro/superbol-studio-oss/pull/556)
 - Support for COMP-6 usage [#548](https://github.com/OCamlPro/superbol-studio-oss/pull/548)
+- Warnings on unsupported usage, where the reported data item size may be be wrong [#570](https://github.com/OCamlPro/superbol-studio-oss/pull/570)
 
 ### Fixed
 - Handling of alphanumeric literals with UTF-8 characters in fixed-format COBOL code [#564](https://github.com/OCamlPro/superbol-studio-oss/pull/564)

src/lsp/cobol_typeck/typeck_clauses.ml

@@ -176,6 +176,7 @@ let display_usage_from_literal: Cobol_ptree.literal -> usage =
 
 
 let data_error diags e = Data_error e :: diags
+let data_warning diags e = Data_warning e :: diags
 
 
 let ensure_picture diags
@@ -290,11 +291,11 @@ let to_usage_n_value ~item_name ~item_loc ~picture_config item_clauses =
         | Error diags' ->
             LIST.append ~loc:__LOC__ diags' diags, Some (Error picture_clause)
   in
-  let usage_clause = match item_clauses.usage with
+  let usage_clause, usage_clause_loc = match item_clauses.usage with
     | Some usage ->
-        ~&usage
+        ~&usage, Some  ~@usage
     | None ->                      (* fallback to DISPLAY *)
-        Display                   (* TODO: NATIONAL in case value is a natlit *)
+        Display, None             (* TODO: NATIONAL in case value is a natlit *)
   in
   let signedness s =
     Cobol_data.Types.{ signed = s <> Some Cobol_ptree.Unsigned }
@@ -403,11 +404,15 @@ let to_usage_n_value ~item_name ~item_loc ~picture_config item_clauses =
     | UsagePending `Comp6 ->                  (* == Packed_decimal without sign nibble *)
         let diags, picture
           = ensure_picture diags ~only:`Numeric_category
-              ~usage_clause:PackedDecimal picture in
+            ~usage_clause:PackedDecimal picture in
         diags, Some (Packed_decimal { picture; with_sign_nibble = false })
 
-    | _ ->                         (* FIXME: we ignore the other cases for now *)
-        diags, None
+    | Type _
+    | UsagePending (`Comp10|`CompN|`Comp5|`Comp0|`Comp15|`CompX|`Comp9) ->
+        (* Note: `usage_clause_loc = None` implies `usage_clause = Display`,
+           unreachable here. *)
+        let usage_clause = usage_clause &@ Option.get usage_clause_loc in
+        data_warning diags @@ Unsupported_usage { usage_clause }, None
   in
   let diags = match usage, item_clauses.picture with
     | _, None

src/lsp/cobol_typeck/typeck_data_diagnostics.ml

@@ -154,6 +154,10 @@ and warning =
         second_loc: srcloc;
         clause_name: string;
       }
+  | Unsupported_usage of
+      {
+        usage_clause: Cobol_ptree.usage_clause with_loc;
+      }
   (* | Extraneous_clause of *)
   (*     { *)
   (*       clause_name: string; *)
@@ -194,7 +198,8 @@ let error_loc = function
 let warning_loc = function
   | Duplicate_clause { second_loc = loc; _ }
   | Mismatching_usage_in_group { item_usage = { loc; _ }; _ }
-  | Redefinition_of_table_item { redef_loc = loc; _ } ->
+  | Redefinition_of_table_item { redef_loc = loc; _ }
+  | Unsupported_usage { usage_clause = { loc; _ } } ->
       Some loc
 
 let pp_data_name'_opt
@@ -292,5 +297,8 @@ let pp_warning ppf = function
         Cobol_ptree.pp_usage_clause ~&group_usage
   | Duplicate_clause { clause_name; _ } ->   (* TODO: addendum with second loc *)
       Pretty.print ppf "Duplicate %s clause" clause_name
+  | Unsupported_usage { usage_clause = c } ->
+      Pretty.print ppf "Unsupported@ USAGE@ %a"
+        Cobol_ptree.pp_usage_clause ~&c
   (* | Extraneous_clause { clause_name; _ } -> *)
   (*     Pretty.print ppf "Extraneous %s clause" clause_name *)