diff options
| author | Andrew Burgess <andrew.burgess@embecosm.com> | 2021-02-11 13:34:06 +0000 |
|---|---|---|
| committer | Andrew Burgess <andrew.burgess@embecosm.com> | 2021-02-12 09:22:17 +0000 |
| commit | 96df3e28b835ccb5804bcca96f417761e5e8be67 (patch) | |
| tree | 6b09c8d9cb20a88b9cf4081f1814cfafaa86de62 /gdb/f-lang.c | |
| parent | 17e04eff810ecf1f8392a995876a98361c565ec7 (diff) | |
| download | fsf-binutils-gdb-96df3e28b835ccb5804bcca96f417761e5e8be67.zip fsf-binutils-gdb-96df3e28b835ccb5804bcca96f417761e5e8be67.tar.gz fsf-binutils-gdb-96df3e28b835ccb5804bcca96f417761e5e8be67.tar.bz2 | |
gdb/fortran: support ALLOCATED builtin
Add support for the ALLOCATED keyword to the Fortran expression
parser.
gdb/ChangeLog:
* f-exp.y (f77_keywords): Add allocated.
* f-lang.c (evaluate_subexp_f): Handle UNOP_FORTRAN_ALLOCATED.
(operator_length_f): Likewise.
(print_subexp_f): Likewise.
(dump_subexp_body_f): Likewise.
(operator_check_f): Likewise.
* std-operator.def (UNOP_FORTRAN_ALLOCATED): New operator.
gdb/testsuite/ChangeLog:
* gdb.fortran/allocated.exp: New file.
* gdb.fortran/allocated.f90: New file.
Diffstat (limited to 'gdb/f-lang.c')
| -rw-r--r-- | gdb/f-lang.c | 21 |
1 files changed, 21 insertions, 0 deletions
diff --git a/gdb/f-lang.c b/gdb/f-lang.c index 57dd2ed..08ed56a 100644 --- a/gdb/f-lang.c +++ b/gdb/f-lang.c @@ -906,6 +906,20 @@ evaluate_subexp_f (struct type *expect_type, struct expression *exp, return value_from_host_double (type, val); } + case UNOP_FORTRAN_ALLOCATED: + { + arg1 = evaluate_subexp (nullptr, exp, pos, noside); + if (noside == EVAL_SKIP) + return eval_skip_value (exp); + type = check_typedef (value_type (arg1)); + if (type->code () != TYPE_CODE_ARRAY) + error (_("ALLOCATED can only be applied to arrays")); + struct type *result_type + = builtin_f_type (exp->gdbarch)->builtin_logical; + LONGEST result_value = type_not_allocated (type) ? 0 : 1; + return value_from_longest (result_type, result_value); + } + case BINOP_FORTRAN_MODULO: { arg1 = evaluate_subexp (nullptr, exp, pos, noside); @@ -1118,6 +1132,7 @@ operator_length_f (const struct expression *exp, int pc, int *oplenp, case UNOP_FORTRAN_KIND: case UNOP_FORTRAN_FLOOR: case UNOP_FORTRAN_CEILING: + case UNOP_FORTRAN_ALLOCATED: oplen = 1; args = 1; break; @@ -1203,6 +1218,10 @@ print_subexp_f (struct expression *exp, int *pos, print_unop_subexp_f (exp, pos, stream, prec, "CEILING"); return; + case UNOP_FORTRAN_ALLOCATED: + print_unop_subexp_f (exp, pos, stream, prec, "ALLOCATED"); + return; + case BINOP_FORTRAN_CMPLX: print_binop_subexp_f (exp, pos, stream, prec, "CMPLX"); return; @@ -1252,6 +1271,7 @@ dump_subexp_body_f (struct expression *exp, case UNOP_FORTRAN_KIND: case UNOP_FORTRAN_FLOOR: case UNOP_FORTRAN_CEILING: + case UNOP_FORTRAN_ALLOCATED: case BINOP_FORTRAN_CMPLX: case BINOP_FORTRAN_MODULO: operator_length_f (exp, (elt + 1), &oplen, &nargs); @@ -1288,6 +1308,7 @@ operator_check_f (struct expression *exp, int pos, case UNOP_FORTRAN_KIND: case UNOP_FORTRAN_FLOOR: case UNOP_FORTRAN_CEILING: + case UNOP_FORTRAN_ALLOCATED: case BINOP_FORTRAN_CMPLX: case BINOP_FORTRAN_MODULO: case FORTRAN_LBOUND: |