diff --git a/src/lsp/cobol_ast/data_descr.ml b/src/lsp/cobol_ast/data_descr.ml index 361fbb9df..cdaa2b02a 100644 --- 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 \ No newline at end of file + | 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 index ea32e7089..7f3c0742a 100644 --- a/src/lsp/cobol_data/typing.ml +++ b/src/lsp/cobol_data/typing.ml @@ -60,6 +60,22 @@ 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 () @@ -67,9 +83,11 @@ let rec of_data_group | 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 index 8e77997ac..c43677104 100644 --- 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 }