Merge pull request #31 from ddeclerck/numeric_typing

More USAGE typing
OCamlPro · Sep 29, 2023 · f0c945a · f0c945a
2 parents 3f5f0ea + 22f1423
commit f0c945a
Show file tree

Hide file tree

Showing 3 changed files with 27 additions and 7 deletions.
diff --git a/src/lsp/cobol_ast/data_descr.ml b/src/lsp/cobol_ast/data_descr.ml
@@ -382,8 +382,8 @@ type usage_clause =
  | Pointer of name with_loc option                                (* +COB2002 *)
  | FunctionPointer of name with_loc                               (* +COB2002 *)
  | ProgramPointer of name with_loc option                         (* +COB2002 *)
- | UsagePending of [`Comp0 | `Comp1 | `Comp5 | `Comp6 | `CompX |
-                    `CompN | `Comp9 | `Comp10 | `Comp15 ]
+ | UsagePending of [`Comp0 | `Comp1 | `Comp2 | `Comp3 | `Comp5 | `Comp6 |
+                    `CompX | `CompN | `Comp9 | `Comp10 | `Comp15 ]
 [@@deriving ord]
 
 and signedness =
@@ -493,6 +493,8 @@ let pp_usage_clause ppf usage =
     match comp with
     | `Comp0 -> Fmt.pf ppf "COMP-0"
     | `Comp1 -> Fmt.pf ppf "COMP-1"
+    | `Comp2 -> Fmt.pf ppf "COMP-2"
+    | `Comp3 -> Fmt.pf ppf "COMP-3"
     | `Comp5 -> Fmt.pf ppf "COMP-5"
     | `Comp6 -> Fmt.pf ppf "COMP-6"
     | `CompX -> Fmt.pf ppf "COMP-X"
@@ -903,4 +905,4 @@ let pp_comm_clause ppf = function
   | CommTextLength n -> Fmt.pf ppf "TEXT LENGTH IS %a" pp_name' n
   | CommStatusKey n -> Fmt.pf ppf "STATUS KEY IS %a" pp_name' n
   | CommEndKey n -> Fmt.pf ppf "END KEY IS %a" pp_name' n
-  | CommErrorKey n -> Fmt.pf ppf "ERROR KEY IS %a" pp_name' n
+  | CommErrorKey n -> Fmt.pf ppf "ERROR KEY IS %a" pp_name' n
diff --git a/src/lsp/cobol_data/typing.ml b/src/lsp/cobol_data/typing.ml
@@ -60,16 +60,34 @@ let rec of_data_group
               (*     Result.ok @@ Elementary (({typ = Types.Pointer (\* L8 *\); level}, None) &@ loc) *)
               | ObjectReference _ ->
                   Ok (Elementary ({typ = Types.Object; level}, None) &@ loc)
+              | BinaryChar _
+              | BinaryShort _
+              | BinaryLong _
+              | BinaryDouble _
+              | FloatBinary32 _
+              | FloatBinary64 _
+              | FloatBinary128 _
+              | FloatDecimal16 _
+              | FloatDecimal34 _
+              | FloatShort
+              | FloatLong
+              | FloatExtended ->
+                  (* As per ISO/IEC 1989:2014, 8.5.2.10 Numeric category *)
+                  Ok (Elementary ({typ = Numeric; level}, None) &@ loc)
+              | UsagePending (`Comp1 | `Comp2) ->
+                  Ok (Elementary ({typ = Numeric; level}, None) &@ loc)
               | _ ->
                   Diags.error ~loc "Missing@ PICTURE@ clause";
                   Result.Error ()
             end
         | Some picture, Some usage ->
             let cobol_class = cobol_class_of_picture ~&picture in
             begin match usage, cobol_class with
-              | (Binary | PackedDecimal), Numeric ->
+              | (Binary | PackedDecimal |
+                UsagePending (`Comp3 | `Comp5 | `Comp6 | `CompX)), Numeric ->
                   Ok (Elementary ({ typ = cobol_class; level }, Some ~&picture) &@ loc)
-              | (Binary | PackedDecimal), _ ->
+              | (Binary | PackedDecimal |
+                UsagePending (`Comp3 | `Comp5 | `Comp6 | `CompX)), _ ->
                   Diags.error ~loc
                     "The picture associated with a USAGE clause of type BINARY \
                      (COMP) or PACKED-DECIMAL must be a numeric picture";

diff --git a/src/lsp/cobol_parser/grammar.mly b/src/lsp/cobol_parser/grammar.mly
@@ -1561,8 +1561,8 @@ usage [@context usage_clause   (* ok as none of leftmost terminals are C/S *)]:
   | COMP                                          { Binary }
   | COMP_0                                        { UsagePending `Comp0 }
   | COMP_1                                        { UsagePending `Comp1 }
-  | COMP_2                                        { FloatLong }
-  | COMP_3                                        { PackedDecimal }
+  | COMP_2                                        { UsagePending `Comp2 }
+  | COMP_3                                        { UsagePending `Comp3 }
   | COMP_4                                        { Binary }
   | COMP_5                                        { UsagePending `Comp5 }
   | COMP_6                                        { UsagePending `Comp6 }