From 58a76c72648ce1e70bbba8320547a5c4353c48a3 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Mon, 8 Mar 2021 07:27:57 -0700 Subject: [PATCH] Introduce classes for Fortran bound intrinsics This adds class fortran_bound_1arg and fortran_bound_2arg, to implement the Fortran lbound and ubound intrinsics. gdb/ChangeLog 2021-03-08 Tom Tromey * f-lang.c (fortran_bound_1arg::evaluate) (fortran_bound_2arg::evaluate): New methods. * f-exp.h (class fortran_bound_1arg, class fortran_bound_2arg): New. --- gdb/ChangeLog | 7 +++++++ gdb/f-exp.h | 32 ++++++++++++++++++++++++++++++++ gdb/f-lang.c | 34 ++++++++++++++++++++++++++++++++++ 3 files changed, 73 insertions(+) diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 66f77053918..6f3037c8c28 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,10 @@ +2021-03-08 Tom Tromey + + * f-lang.c (fortran_bound_1arg::evaluate) + (fortran_bound_2arg::evaluate): New methods. + * f-exp.h (class fortran_bound_1arg, class fortran_bound_2arg): + New. + 2021-03-08 Tom Tromey * expop.h (class unop_addr_operation) : New diff --git a/gdb/f-exp.h b/gdb/f-exp.h index b569c33ad9c..e1d351a2bb4 100644 --- a/gdb/f-exp.h +++ b/gdb/f-exp.h @@ -159,6 +159,38 @@ private: enum noside noside); }; +/* Single-argument form of Fortran ubound/lbound intrinsics. */ +class fortran_bound_1arg + : public tuple_holding_operation +{ +public: + + using tuple_holding_operation::tuple_holding_operation; + + value *evaluate (struct type *expect_type, + struct expression *exp, + enum noside noside) override; + + enum exp_opcode opcode () const override + { return std::get<0> (m_storage); } +}; + +/* Two-argument form of Fortran ubound/lbound intrinsics. */ +class fortran_bound_2arg + : public tuple_holding_operation +{ +public: + + using tuple_holding_operation::tuple_holding_operation; + + value *evaluate (struct type *expect_type, + struct expression *exp, + enum noside noside) override; + + enum exp_opcode opcode () const override + { return std::get<0> (m_storage); } +}; + } /* namespace expr */ #endif /* FORTRAN_EXP_H */ diff --git a/gdb/f-lang.c b/gdb/f-lang.c index 6f7217dc94a..dcd7c48bbcf 100644 --- a/gdb/f-lang.c +++ b/gdb/f-lang.c @@ -1865,6 +1865,40 @@ fortran_undetermined::evaluate (struct type *expect_type, } } +value * +fortran_bound_1arg::evaluate (struct type *expect_type, + struct expression *exp, + enum noside noside) +{ + bool lbound_p = std::get<0> (m_storage) == FORTRAN_LBOUND; + value *arg1 = std::get<1> (m_storage)->evaluate (nullptr, exp, noside); + fortran_require_array (value_type (arg1), lbound_p); + return fortran_bounds_all_dims (lbound_p, exp->gdbarch, arg1); +} + +value * +fortran_bound_2arg::evaluate (struct type *expect_type, + struct expression *exp, + enum noside noside) +{ + bool lbound_p = std::get<0> (m_storage) == FORTRAN_LBOUND; + value *arg1 = std::get<1> (m_storage)->evaluate (nullptr, exp, noside); + fortran_require_array (value_type (arg1), lbound_p); + + /* User asked for the bounds of a specific dimension of the array. */ + value *arg2 = std::get<2> (m_storage)->evaluate (nullptr, exp, noside); + struct type *type = check_typedef (value_type (arg2)); + if (type->code () != TYPE_CODE_INT) + { + if (lbound_p) + error (_("LBOUND second argument should be an integer")); + else + error (_("UBOUND second argument should be an integer")); + } + + return fortran_bounds_for_dimension (lbound_p, exp->gdbarch, arg1, arg2); +} + } /* namespace expr */ /* Special expression lengths for Fortran. */ -- 2.30.2