diff options
Diffstat (limited to 'gdb/f-lang.c')
| -rw-r--r-- | gdb/f-lang.c | 430 |
1 files changed, 197 insertions, 233 deletions
diff --git a/gdb/f-lang.c b/gdb/f-lang.c index a1e425a2d55..521e45fa81d 100644 --- a/gdb/f-lang.c +++ b/gdb/f-lang.c @@ -50,8 +50,7 @@ static void show_repack_array_slices (struct ui_file *file, int from_tty, struct cmd_list_element *c, const char *value) { - gdb_printf (file, _("Repacking of Fortran array slices is %s.\n"), - value); + gdb_printf (file, _ ("Repacking of Fortran array slices is %s.\n"), value); } /* Debugging of Fortran's array slicing. */ @@ -63,16 +62,16 @@ show_fortran_array_slicing_debug (struct ui_file *file, int from_tty, struct cmd_list_element *c, const char *value) { - gdb_printf (file, _("Debugging of Fortran array slicing is %s.\n"), - value); + gdb_printf (file, _ ("Debugging of Fortran array slicing is %s.\n"), value); } /* Local functions */ static value *fortran_prepare_argument (struct expression *exp, - expr::operation *subexp, - int arg_num, bool is_internal_call_p, - struct type *func_type, enum noside noside); + expr::operation *subexp, int arg_num, + bool is_internal_call_p, + struct type *func_type, + enum noside noside); /* Return the encoding that should be used for the character type TYPE. */ @@ -95,7 +94,7 @@ f_language::get_encoding (struct type *type) break; default: - error (_("unrecognized character type")); + error (_ ("unrecognized character type")); } return encoding; @@ -112,9 +111,9 @@ fortran_require_array (struct type *type, bool lbound_p) if (type->code () != TYPE_CODE_ARRAY) { if (lbound_p) - error (_("LBOUND can only be applied to arrays")); + error (_ ("LBOUND can only be applied to arrays")); else - error (_("UBOUND can only be applied to arrays")); + error (_ ("UBOUND can only be applied to arrays")); } } @@ -123,8 +122,7 @@ fortran_require_array (struct type *type, bool lbound_p) array type). GDBARCH is the current architecture. */ static struct value * -fortran_bounds_all_dims (bool lbound_p, - struct gdbarch *gdbarch, +fortran_bounds_all_dims (bool lbound_p, struct gdbarch *gdbarch, struct value *array) { type *array_type = check_typedef (value_type (array)); @@ -133,8 +131,8 @@ fortran_bounds_all_dims (bool lbound_p, /* Allocate a result value of the correct type. */ struct type *range = create_static_range_type (nullptr, - builtin_f_type (gdbarch)->builtin_integer, - 1, ndimensions); + builtin_f_type (gdbarch)->builtin_integer, 1, + ndimensions); struct type *elm_type = builtin_f_type (gdbarch)->builtin_integer; struct type *result_type = create_array_type (nullptr, elm_type, range); struct value *result = allocate_value (result_type); @@ -142,8 +140,7 @@ fortran_bounds_all_dims (bool lbound_p, /* Walk the array dimensions backwards due to the way the array will be laid out in memory, the first dimension will be the most inner. */ LONGEST elm_len = elm_type->length (); - for (LONGEST dst_offset = elm_len * (ndimensions - 1); - dst_offset >= 0; + for (LONGEST dst_offset = elm_len * (ndimensions - 1); dst_offset >= 0; dst_offset -= elm_len) { LONGEST b; @@ -175,7 +172,7 @@ fortran_bounds_all_dims (bool lbound_p, static value * fortran_bounds_for_dimension (bool lbound_p, value *array, value *dim_val, - type* result_type) + type *result_type) { /* Check the requested dimension is valid for this array. */ type *array_type = check_typedef (value_type (array)); @@ -184,9 +181,9 @@ fortran_bounds_for_dimension (bool lbound_p, value *array, value *dim_val, if (dim < 1 || dim > ndimensions) { if (lbound_p) - error (_("LBOUND dimension must be from 1 to %d"), ndimensions); + error (_ ("LBOUND dimension must be from 1 to %d"), ndimensions); else - error (_("UBOUND dimension must be from 1 to %d"), ndimensions); + error (_ ("UBOUND dimension must be from 1 to %d"), ndimensions); } /* Walk the dimensions backwards, due to the ordering in which arrays are @@ -226,7 +223,7 @@ calc_f77_array_dims (struct type *array_type) return 1; if ((array_type->code () != TYPE_CODE_ARRAY)) - error (_("Can't get dimensions for a non-array type")); + error (_ ("Can't get dimensions for a non-array type")); tmp_type = array_type; @@ -242,15 +239,16 @@ calc_f77_array_dims (struct type *array_type) slices. This is a base class for two alternative repacking mechanisms, one for when repacking from a lazy value, and one for repacking from a non-lazy (already loaded) value. */ -class fortran_array_repacker_base_impl - : public fortran_array_walker_base_impl +class fortran_array_repacker_base_impl : public fortran_array_walker_base_impl { public: + /* Constructor, DEST is the value we are repacking into. */ fortran_array_repacker_base_impl (struct value *dest) : m_dest (dest), m_dest_offset (0) - { /* Nothing. */ } + { /* Nothing. */ + } /* When we start processing the inner most dimension, this is where we will be creating values for each element as we load them and then copy @@ -278,6 +276,7 @@ public: } protected: + /* Copy the contents of array element ELT into M_DEST at the next available offset. */ void copy_element_to_dest (struct value *elt) @@ -308,6 +307,7 @@ class fortran_lazy_array_repacker_impl : public fortran_array_repacker_base_impl { public: + /* Constructor. TYPE is the type of the slice being loaded from the parent value, so this type will correctly reflect the strides required to find all of the elements from the parent value. ADDRESS is the @@ -318,18 +318,20 @@ public: struct value *dest) : fortran_array_repacker_base_impl (dest), m_addr (address) - { /* Nothing. */ } + { /* Nothing. */ + } /* Create a lazy value in target memory representing a single element, then load the element into GDB's memory and copy the contents into the destination value. */ - void process_element (struct type *elt_type, LONGEST elt_off, - LONGEST index, bool last_p) + void process_element (struct type *elt_type, LONGEST elt_off, LONGEST index, + bool last_p) { copy_element_to_dest (value_at_lazy (elt_type, m_addr + elt_off)); } private: + /* The address in target memory where the parent value starts. */ CORE_ADDR m_addr; }; @@ -338,10 +340,10 @@ private: slices. This class is specialised for repacking an array slice from a previously loaded (non-lazy) array value, as such it fetches the element values from the contents of the parent value. */ -class fortran_array_repacker_impl - : public fortran_array_repacker_base_impl +class fortran_array_repacker_impl : public fortran_array_repacker_base_impl { public: + /* Constructor. TYPE is the type for the array slice within the parent value, as such it has stride values as required to find the elements within the original parent value. ADDRESS is the address in target @@ -350,8 +352,8 @@ public: VAL is the parent object from which we are loading the value, and DEST is the value into which we are repacking. */ explicit fortran_array_repacker_impl (struct type *type, CORE_ADDR address, - LONGEST base_offset, - struct value *val, struct value *dest) + LONGEST base_offset, struct value *val, + struct value *dest) : fortran_array_repacker_base_impl (dest), m_base_offset (base_offset), m_val (val) @@ -362,8 +364,8 @@ public: /* Extract an element of ELT_TYPE at offset (M_BASE_OFFSET + ELT_OFF) from the content buffer of M_VAL then copy this extracted value into the repacked destination value. */ - void process_element (struct type *elt_type, LONGEST elt_off, - LONGEST index, bool last_p) + void process_element (struct type *elt_type, LONGEST elt_off, LONGEST index, + bool last_p) { struct value *elt = value_from_component (m_val, elt_type, (elt_off + m_base_offset)); @@ -371,6 +373,7 @@ public: } private: + /* The offset into the content buffer of M_VAL to the start of the slice being extracted. */ LONGEST m_base_offset; @@ -379,7 +382,6 @@ private: struct value *m_val; }; - /* Evaluate FORTRAN_ASSOCIATED expressions. Both GDBARCH and LANG are extracted from the expression being evaluated. POINTER is the required first argument to the 'associated' keyword, and TARGET is the optional @@ -397,7 +399,7 @@ fortran_associated (struct gdbarch *gdbarch, const language_defn *lang, struct type *pointer_type = check_typedef (value_type (pointer)); if (TYPE_ASSOCIATED_PROP (pointer_type) == nullptr && pointer_type->code () != TYPE_CODE_PTR) - error (_("ASSOCIATED can only be applied to pointers")); + error (_ ("ASSOCIATED can only be applied to pointers")); /* Get an address from POINTER. Fortran (or at least gfortran) models array pointers as arrays with a dynamic data address, so we need to @@ -449,7 +451,7 @@ fortran_associated (struct gdbarch *gdbarch, const language_defn *lang, || (pointer_target_type->code () != TYPE_CODE_ARRAY && (pointer_target_type->length () != target_target_type->length ()))) - error (_("arguments to associated must be of same type and kind")); + error (_ ("arguments to associated must be of same type and kind")); /* If TARGET is not in memory, or the original pointer is specifically known to be not associated with anything, then the answer is obviously @@ -461,8 +463,7 @@ fortran_associated (struct gdbarch *gdbarch, const language_defn *lang, if (value_lval_const (target) != lval_memory || type_not_associated (pointer_type) || (TYPE_ASSOCIATED_PROP (pointer_type) == nullptr - && pointer_type->code () == TYPE_CODE_PTR - && pointer_addr == 0)) + && pointer_type->code () == TYPE_CODE_PTR && pointer_addr == 0)) return value_from_longest (result_type, 0); /* See the comment for POINTER_ADDR above. */ @@ -528,14 +529,14 @@ fortran_associated (struct gdbarch *gdbarch, const language_defn *lang, but we need to convert to bits (hence the * 8). */ pointer_stride = pointer_range->bounds ()->bit_stride (); if (pointer_stride == 0) - pointer_stride - = type_length_units (check_typedef - (pointer_type->target_type ())) * 8; + pointer_stride = type_length_units ( + check_typedef (pointer_type->target_type ())) + * 8; target_stride = target_range->bounds ()->bit_stride (); if (target_stride == 0) target_stride - = type_length_units (check_typedef - (target_type->target_type ())) * 8; + = type_length_units (check_typedef (target_type->target_type ())) + * 8; if (pointer_stride != target_stride) break; @@ -553,22 +554,17 @@ fortran_associated (struct gdbarch *gdbarch, const language_defn *lang, } struct value * -eval_op_f_associated (struct type *expect_type, - struct expression *exp, - enum noside noside, - enum exp_opcode opcode, +eval_op_f_associated (struct type *expect_type, struct expression *exp, + enum noside noside, enum exp_opcode opcode, struct value *arg1) { return fortran_associated (exp->gdbarch, exp->language_defn, arg1); } struct value * -eval_op_f_associated (struct type *expect_type, - struct expression *exp, - enum noside noside, - enum exp_opcode opcode, - struct value *arg1, - struct value *arg2) +eval_op_f_associated (struct type *expect_type, struct expression *exp, + enum noside noside, enum exp_opcode opcode, + struct value *arg1, struct value *arg2) { return fortran_associated (exp->gdbarch, exp->language_defn, arg1, arg2); } @@ -590,9 +586,9 @@ fortran_array_size (value *array, value *dim_val, type *result_type) /* Check that ARRAY is the correct type. */ struct type *array_type = check_typedef (value_type (array)); if (array_type->code () != TYPE_CODE_ARRAY) - error (_("SIZE can only be applied to arrays")); + error (_ ("SIZE can only be applied to arrays")); if (type_not_allocated (array_type) || type_not_associated (array_type)) - error (_("SIZE can only be used on allocated/associated arrays")); + error (_ ("SIZE can only be used on allocated/associated arrays")); int ndimensions = calc_f77_array_dims (array_type); int dim = -1; @@ -601,11 +597,11 @@ fortran_array_size (value *array, value *dim_val, type *result_type) if (dim_val != nullptr) { if (check_typedef (value_type (dim_val))->code () != TYPE_CODE_INT) - error (_("DIM argument to SIZE must be an integer")); + error (_ ("DIM argument to SIZE must be an integer")); dim = (int) value_as_long (dim_val); if (dim < 1 || dim > ndimensions) - error (_("DIM argument to SIZE must be between 1 and %d"), + error (_ ("DIM argument to SIZE must be between 1 and %d"), ndimensions); } @@ -621,7 +617,7 @@ fortran_array_size (value *array, value *dim_val, type *result_type) struct type *range = array_type->index_type (); if (!get_discrete_bounds (range, &lbound, &ubound)) - error (_("failed to find array bounds")); + error (_ ("failed to find array bounds")); LONGEST dim_size = (ubound - lbound + 1); if (result == 0) @@ -643,10 +639,8 @@ fortran_array_size (value *array, value *dim_val, type *result_type) /* See f-exp.h. */ struct value * -eval_op_f_array_size (struct type *expect_type, - struct expression *exp, - enum noside noside, - enum exp_opcode opcode, +eval_op_f_array_size (struct type *expect_type, struct expression *exp, + enum noside noside, enum exp_opcode opcode, struct value *arg1) { gdb_assert (opcode == FORTRAN_ARRAY_SIZE); @@ -658,12 +652,9 @@ eval_op_f_array_size (struct type *expect_type, /* See f-exp.h. */ struct value * -eval_op_f_array_size (struct type *expect_type, - struct expression *exp, - enum noside noside, - enum exp_opcode opcode, - struct value *arg1, - struct value *arg2) +eval_op_f_array_size (struct type *expect_type, struct expression *exp, + enum noside noside, enum exp_opcode opcode, + struct value *arg1, struct value *arg2) { gdb_assert (opcode == FORTRAN_ARRAY_SIZE); @@ -673,9 +664,10 @@ eval_op_f_array_size (struct type *expect_type, /* See f-exp.h. */ -value *eval_op_f_array_size (type *expect_type, expression *exp, noside noside, - exp_opcode opcode, value *arg1, value *arg2, - type *kind_arg) +value * +eval_op_f_array_size (type *expect_type, expression *exp, noside noside, + exp_opcode opcode, value *arg1, value *arg2, + type *kind_arg) { gdb_assert (opcode == FORTRAN_ARRAY_SIZE); gdb_assert (kind_arg->code () == TYPE_CODE_INT); @@ -703,7 +695,7 @@ fortran_array_shape (struct gdbarch *gdbarch, const language_defn *lang, Fortran specification. */ if (val_type->code () == TYPE_CODE_ARRAY && (type_not_associated (val_type) || type_not_allocated (val_type))) - error (_("The array passed to SHAPE must be allocated or associated")); + error (_ ("The array passed to SHAPE must be allocated or associated")); /* The Fortran specification allows non-array types to be passed to this function, in which case we get back an empty array. @@ -715,8 +707,7 @@ fortran_array_shape (struct gdbarch *gdbarch, const language_defn *lang, /* Allocate a result value of the correct type. */ struct type *range - = create_static_range_type (nullptr, - builtin_type (gdbarch)->builtin_int, + = create_static_range_type (nullptr, builtin_type (gdbarch)->builtin_int, 1, ndimensions); struct type *elm_type = builtin_f_type (gdbarch)->builtin_integer; struct type *result_type = create_array_type (nullptr, elm_type, range); @@ -728,14 +719,13 @@ fortran_array_shape (struct gdbarch *gdbarch, const language_defn *lang, If VAL was not an array then ndimensions will be 0, in which case we will never go around this loop. */ - for (LONGEST dst_offset = elm_len * (ndimensions - 1); - dst_offset >= 0; + for (LONGEST dst_offset = elm_len * (ndimensions - 1); dst_offset >= 0; dst_offset -= elm_len) { LONGEST lbound, ubound; if (!get_discrete_bounds (val_type->index_type (), &lbound, &ubound)) - error (_("failed to find array bounds")); + error (_ ("failed to find array bounds")); LONGEST dim_size = (ubound - lbound + 1); @@ -768,9 +758,7 @@ eval_op_f_array_shape (struct type *expect_type, struct expression *exp, struct value * eval_op_f_abs (struct type *expect_type, struct expression *exp, - enum noside noside, - enum exp_opcode opcode, - struct value *arg1) + enum noside noside, enum exp_opcode opcode, struct value *arg1) { struct type *type = value_type (arg1); switch (type->code ()) @@ -789,30 +777,27 @@ eval_op_f_abs (struct type *expect_type, struct expression *exp, return value_from_longest (type, l); } } - error (_("ABS of type %s not supported"), TYPE_SAFE_NAME (type)); + error (_ ("ABS of type %s not supported"), TYPE_SAFE_NAME (type)); } /* A helper function for BINOP_MOD. */ struct value * eval_op_f_mod (struct type *expect_type, struct expression *exp, - enum noside noside, - enum exp_opcode opcode, - struct value *arg1, struct value *arg2) + enum noside noside, enum exp_opcode opcode, struct value *arg1, + struct value *arg2) { struct type *type = value_type (arg1); if (type->code () != value_type (arg2)->code ()) - error (_("non-matching types for parameters to MOD ()")); + error (_ ("non-matching types for parameters to MOD ()")); switch (type->code ()) { case TYPE_CODE_FLT: { - double d1 - = target_float_to_host_double (value_contents (arg1).data (), - value_type (arg1)); - double d2 - = target_float_to_host_double (value_contents (arg2).data (), - value_type (arg2)); + double d1 = target_float_to_host_double (value_contents (arg1).data (), + value_type (arg1)); + double d2 = target_float_to_host_double (value_contents (arg2).data (), + value_type (arg2)); double d3 = fmod (d1, d2); return value_from_host_double (type, d3); } @@ -821,12 +806,12 @@ eval_op_f_mod (struct type *expect_type, struct expression *exp, LONGEST v1 = value_as_long (arg1); LONGEST v2 = value_as_long (arg2); if (v2 == 0) - error (_("calling MOD (N, 0) is undefined")); + error (_ ("calling MOD (N, 0) is undefined")); LONGEST v3 = v1 - (v1 / v2) * v2; return value_from_longest (value_type (arg1), v3); } } - error (_("MOD of type %s not supported"), TYPE_SAFE_NAME (type)); + error (_ ("MOD of type %s not supported"), TYPE_SAFE_NAME (type)); } /* A helper function for the different FORTRAN_CEILING overloads. Calculates @@ -837,7 +822,7 @@ static value * fortran_ceil_operation (value *arg1, type *result_type) { if (value_type (arg1)->code () != TYPE_CODE_FLT) - error (_("argument to CEILING must be of type float")); + error (_ ("argument to CEILING must be of type float")); double val = target_float_to_host_double (value_contents (arg1).data (), value_type (arg1)); val = ceil (val); @@ -848,9 +833,7 @@ fortran_ceil_operation (value *arg1, type *result_type) struct value * eval_op_f_ceil (struct type *expect_type, struct expression *exp, - enum noside noside, - enum exp_opcode opcode, - struct value *arg1) + enum noside noside, enum exp_opcode opcode, struct value *arg1) { gdb_assert (opcode == FORTRAN_CEILING); type *result_type = builtin_f_type (exp->gdbarch)->builtin_integer; @@ -876,7 +859,7 @@ static value * fortran_floor_operation (value *arg1, type *result_type) { if (value_type (arg1)->code () != TYPE_CODE_FLT) - error (_("argument to FLOOR must be of type float")); + error (_ ("argument to FLOOR must be of type float")); double val = target_float_to_host_double (value_contents (arg1).data (), value_type (arg1)); val = floor (val); @@ -887,9 +870,8 @@ fortran_floor_operation (value *arg1, type *result_type) struct value * eval_op_f_floor (struct type *expect_type, struct expression *exp, - enum noside noside, - enum exp_opcode opcode, - struct value *arg1) + enum noside noside, enum exp_opcode opcode, + struct value *arg1) { gdb_assert (opcode == FORTRAN_FLOOR); type *result_type = builtin_f_type (exp->gdbarch)->builtin_integer; @@ -911,13 +893,12 @@ eval_op_f_floor (type *expect_type, expression *exp, noside noside, struct value * eval_op_f_modulo (struct type *expect_type, struct expression *exp, - enum noside noside, - enum exp_opcode opcode, + enum noside noside, enum exp_opcode opcode, struct value *arg1, struct value *arg2) { struct type *type = value_type (arg1); if (type->code () != value_type (arg2)->code ()) - error (_("non-matching types for parameters to MODULO ()")); + error (_ ("non-matching types for parameters to MODULO ()")); /* MODULO(A, P) = A - FLOOR (A / P) * P */ switch (type->code ()) { @@ -932,19 +913,17 @@ eval_op_f_modulo (struct type *expect_type, struct expression *exp, } case TYPE_CODE_FLT: { - double a - = target_float_to_host_double (value_contents (arg1).data (), - value_type (arg1)); - double p - = target_float_to_host_double (value_contents (arg2).data (), - value_type (arg2)); + double a = target_float_to_host_double (value_contents (arg1).data (), + value_type (arg1)); + double p = target_float_to_host_double (value_contents (arg2).data (), + value_type (arg2)); double result = fmod (a, p); if (result != 0 && (a < 0.0) != (p < 0.0)) result += p; return value_from_host_double (type, result); } } - error (_("MODULO of type %s not supported"), TYPE_SAFE_NAME (type)); + error (_ ("MODULO of type %s not supported"), TYPE_SAFE_NAME (type)); } /* A helper function for FORTRAN_CMPLX. */ @@ -969,14 +948,14 @@ eval_op_f_cmplx (type *expect_type, expression *exp, noside noside, struct value * eval_op_f_cmplx (struct type *expect_type, struct expression *exp, - enum noside noside, - enum exp_opcode opcode, + enum noside noside, enum exp_opcode opcode, struct value *arg1, struct value *arg2) { if (value_type (arg1)->code () == TYPE_CODE_COMPLEX || value_type (arg2)->code () == TYPE_CODE_COMPLEX) - error (_("Types of arguments for CMPLX called with more then one argument " - "must be REAL or INTEGER")); + error ( + _ ("Types of arguments for CMPLX called with more then one argument " + "must be REAL or INTEGER")); type *result_type = builtin_f_type (exp->gdbarch)->builtin_complex; return value_literal_complex (arg1, arg2, result_type); @@ -991,8 +970,9 @@ eval_op_f_cmplx (type *expect_type, expression *exp, noside noside, gdb_assert (kind_arg->code () == TYPE_CODE_COMPLEX); if (value_type (arg1)->code () == TYPE_CODE_COMPLEX || value_type (arg2)->code () == TYPE_CODE_COMPLEX) - error (_("Types of arguments for CMPLX called with more then one argument " - "must be REAL or INTEGER")); + error ( + _ ("Types of arguments for CMPLX called with more then one argument " + "must be REAL or INTEGER")); return value_literal_complex (arg1, arg2, kind_arg); } @@ -1001,9 +981,7 @@ eval_op_f_cmplx (type *expect_type, expression *exp, noside noside, struct value * eval_op_f_kind (struct type *expect_type, struct expression *exp, - enum noside noside, - enum exp_opcode opcode, - struct value *arg1) + enum noside noside, enum exp_opcode opcode, struct value *arg1) { struct type *type = value_type (arg1); @@ -1013,7 +991,7 @@ eval_op_f_kind (struct type *expect_type, struct expression *exp, case TYPE_CODE_UNION: case TYPE_CODE_MODULE: case TYPE_CODE_FUNC: - error (_("argument to kind must be an intrinsic type")); + error (_ ("argument to kind must be an intrinsic type")); } if (!type->target_type ()) @@ -1032,9 +1010,8 @@ eval_op_f_allocated (struct type *expect_type, struct expression *exp, { struct type *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; + 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); } @@ -1042,16 +1019,12 @@ eval_op_f_allocated (struct type *expect_type, struct expression *exp, /* See f-exp.h. */ struct value * -eval_op_f_rank (struct type *expect_type, - struct expression *exp, - enum noside noside, - enum exp_opcode op, - struct value *arg1) +eval_op_f_rank (struct type *expect_type, struct expression *exp, + enum noside noside, enum exp_opcode op, struct value *arg1) { gdb_assert (op == UNOP_FORTRAN_RANK); - struct type *result_type - = builtin_f_type (exp->gdbarch)->builtin_integer; + struct type *result_type = builtin_f_type (exp->gdbarch)->builtin_integer; struct type *type = check_typedef (value_type (arg1)); if (type->code () != TYPE_CODE_ARRAY) return value_from_longest (result_type, 0); @@ -1063,8 +1036,7 @@ eval_op_f_rank (struct type *expect_type, struct value * eval_op_f_loc (struct type *expect_type, struct expression *exp, - enum noside noside, enum exp_opcode op, - struct value *arg1) + enum noside noside, enum exp_opcode op, struct value *arg1) { struct type *result_type; if (gdbarch_ptr_bit (exp->gdbarch) == 16) @@ -1088,8 +1060,7 @@ namespace expr for evaluate. */ value * -fortran_undetermined::value_subarray (value *array, - struct expression *exp, +fortran_undetermined::value_subarray (value *array, struct expression *exp, enum noside noside) { type *original_array_type = check_typedef (value_type (array)); @@ -1105,23 +1076,23 @@ fortran_undetermined::value_subarray (value *array, if (ops[0]->opcode () != OP_RANGE) { if (type_not_associated (original_array_type)) - error (_("no such vector element (vector not associated)")); + error (_ ("no such vector element (vector not associated)")); else if (type_not_allocated (original_array_type)) - error (_("no such vector element (vector not allocated)")); + error (_ ("no such vector element (vector not allocated)")); } else { if (type_not_associated (original_array_type)) - error (_("array not associated")); + error (_ ("array not associated")); else if (type_not_allocated (original_array_type)) - error (_("array not allocated")); + error (_ ("array not allocated")); } /* First check that the number of dimensions in the type we are slicing matches the number of arguments we were passed. */ int ndimensions = calc_f77_array_dims (original_array_type); if (nargs != ndimensions) - error (_("Wrong number of subscripts")); + error (_ ("Wrong number of subscripts")); /* This will be initialised below with the type of the elements held in ARRAY. */ @@ -1174,7 +1145,8 @@ fortran_undetermined::value_subarray (value *array, high (h), stride (s), index (idx) - { /* Nothing. */ } + { /* Nothing. */ + } /* The low bound for this dimension of the slice. */ LONGEST low; @@ -1225,7 +1197,7 @@ fortran_undetermined::value_subarray (value *array, stride = 1; if (stride == 0) - error (_("stride must not be 0")); + error (_ ("stride must not be 0")); /* Get information about this dimension in the original ARRAY. */ struct type *target_type = dim_type->target_type (); @@ -1245,23 +1217,22 @@ fortran_undetermined::value_subarray (value *array, debug_printf ("| | |-> Low bound: %s\n", plongest (lb)); debug_printf ("| | |-> High bound: %s\n", plongest (ub)); debug_printf ("| | |-> Bit stride: %s\n", plongest (sd)); - debug_printf ("| | |-> Byte stride: %s\n", plongest (sd / 8)); + debug_printf ("| | |-> Byte stride: %s\n", + plongest (sd / 8)); debug_printf ("| | |-> Type size: %s\n", pulongest (dim_type->length ())); debug_printf ("| | '-> Target type size: %s\n", pulongest (target_type->length ())); debug_printf ("| |-> Accessing:\n"); - debug_printf ("| | |-> Low bound: %s\n", - plongest (low)); - debug_printf ("| | |-> High bound: %s\n", - plongest (high)); + debug_printf ("| | |-> Low bound: %s\n", plongest (low)); + debug_printf ("| | |-> High bound: %s\n", plongest (high)); debug_printf ("| | '-> Element stride: %s\n", plongest (stride)); } /* Check the user hasn't asked for something invalid. */ if (high > ub || low < lb) - error (_("array subscript out of bounds")); + error (_ ("array subscript out of bounds")); /* Calculate what this dimension of the new slice array will look like. OFFSET is the byte offset from the start of the @@ -1284,10 +1255,10 @@ fortran_undetermined::value_subarray (value *array, { offset += std::abs (remainder) * target_type->length (); if (stride > 0) - error (_("incorrect stride and boundary combination")); + error (_ ("incorrect stride and boundary combination")); } else if (stride < 0) - error (_("incorrect stride and boundary combination")); + error (_ ("incorrect stride and boundary combination")); /* Is the data within this dimension contiguous? It is if the newly computed stride is the same size as a single element of @@ -1300,7 +1271,8 @@ fortran_undetermined::value_subarray (value *array, debug_printf ("| '-> Results:\n"); debug_printf ("| |-> Offset = %s\n", plongest (offset)); debug_printf ("| |-> Elements = %s\n", plongest (e_count)); - debug_printf ("| |-> Low bound = %s\n", plongest (new_low)); + debug_printf ("| |-> Low bound = %s\n", + plongest (new_low)); debug_printf ("| |-> High bound = %s\n", plongest (new_high)); debug_printf ("| |-> Byte stride = %s\n", @@ -1317,8 +1289,7 @@ fortran_undetermined::value_subarray (value *array, the new array slice will be. */ slice_element_size = std::abs (new_stride * e_count); - slice_dims.emplace_back (new_low, new_high, new_stride, - index_type); + slice_dims.emplace_back (new_low, new_high, new_stride, index_type); /* Update the total offset. */ total_offset += offset; @@ -1352,8 +1323,7 @@ fortran_undetermined::value_subarray (value *array, debug_printf ("| | '-> Target type size: %s\n", pulongest (target_type->length ())); debug_printf ("| '-> Accessing:\n"); - debug_printf ("| '-> Index: %s\n", - plongest (index)); + debug_printf ("| '-> Index: %s\n", plongest (index)); } /* If the array has actual content then check the index is in @@ -1361,17 +1331,19 @@ fortran_undetermined::value_subarray (value *array, have a known upper bound, so don't error check in that situation. */ if (index < lb - || (dim_type->index_type ()->bounds ()->high.kind () != PROP_UNDEFINED + || (dim_type->index_type ()->bounds ()->high.kind () + != PROP_UNDEFINED && index > ub) || (VALUE_LVAL (array) != lval_memory - && dim_type->index_type ()->bounds ()->high.kind () == PROP_UNDEFINED)) + && dim_type->index_type ()->bounds ()->high.kind () + == PROP_UNDEFINED)) { if (type_not_associated (dim_type)) - error (_("no such vector element (vector not associated)")); + error (_ ("no such vector element (vector not associated)")); else if (type_not_allocated (dim_type)) - error (_("no such vector element (vector not allocated)")); + error (_ ("no such vector element (vector not allocated)")); else - error (_("no such vector element")); + error (_ ("no such vector element")); } /* Calculate using the type stride, not the target type size. */ @@ -1395,9 +1367,8 @@ fortran_undetermined::value_subarray (value *array, struct type *new_range = create_range_type_with_stride ((struct type *) NULL, - d.index->target_type (), - &p_low, &p_high, 0, &p_stride, - true); + d.index->target_type (), &p_low, + &p_high, 0, &p_stride, true); array_slice_type = create_array_type (nullptr, array_slice_type, new_range); } @@ -1407,8 +1378,7 @@ fortran_undetermined::value_subarray (value *array, debug_printf ("'-> Final result:\n"); debug_printf (" |-> Type: %s\n", type_to_string (array_slice_type).c_str ()); - debug_printf (" |-> Total offset: %s\n", - plongest (total_offset)); + debug_printf (" |-> Total offset: %s\n", plongest (total_offset)); debug_printf (" |-> Base address: %s\n", core_addr_to_string (value_address (array))); debug_printf (" '-> Contiguous = %s\n", @@ -1431,9 +1401,8 @@ fortran_undetermined::value_subarray (value *array, struct type *new_range = create_range_type_with_stride ((struct type *) NULL, - d.index->target_type (), - &p_low, &p_high, 0, &p_stride, - true); + d.index->target_type (), &p_low, + &p_high, 0, &p_stride, true); repacked_array_type = create_array_type (nullptr, repacked_array_type, new_range); } @@ -1445,15 +1414,15 @@ fortran_undetermined::value_subarray (value *array, || (total_offset + array_slice_type->length () > check_typedef (value_type (array))->length ())) { - fortran_array_walker<fortran_lazy_array_repacker_impl> p - (array_slice_type, value_address (array) + total_offset, dest); + fortran_array_walker<fortran_lazy_array_repacker_impl> p ( + array_slice_type, value_address (array) + total_offset, dest); p.walk (); } else { - fortran_array_walker<fortran_array_repacker_impl> p - (array_slice_type, value_address (array) + total_offset, - total_offset, array, dest); + fortran_array_walker<fortran_array_repacker_impl> p ( + array_slice_type, value_address (array) + total_offset, + total_offset, array, dest); p.walk (); } array = dest; @@ -1472,14 +1441,14 @@ fortran_undetermined::value_subarray (value *array, array = value_at_lazy (array_slice_type, value_address (array) + total_offset); else - array = value_from_contents_and_address - (array_slice_type, value_contents (array).data () + total_offset, - value_address (array) + total_offset); + array = value_from_contents_and_address ( + array_slice_type, value_contents (array).data () + total_offset, + value_address (array) + total_offset); } else if (!value_lazy (array)) array = value_from_component (array, array_slice_type, total_offset); else - error (_("cannot subscript arrays that are not in memory")); + error (_ ("cannot subscript arrays that are not in memory")); } return array; @@ -1487,8 +1456,7 @@ fortran_undetermined::value_subarray (value *array, value * fortran_undetermined::evaluate (struct type *expect_type, - struct expression *exp, - enum noside noside) + struct expression *exp, enum noside noside) { value *callee = std::get<0> (m_storage)->evaluate (nullptr, exp, noside); if (noside == EVAL_AVOID_SIDE_EFFECTS @@ -1532,22 +1500,20 @@ fortran_undetermined::evaluate (struct type *expect_type, std::vector<value *> argvec (actual.size ()); bool is_internal_func = (code == TYPE_CODE_INTERNAL_FUNCTION); for (int tem = 0; tem < argvec.size (); tem++) - argvec[tem] = fortran_prepare_argument (exp, actual[tem].get (), - tem, is_internal_func, - value_type (callee), - noside); - return evaluate_subexp_do_call (exp, noside, callee, argvec, - nullptr, expect_type); + argvec[tem] = fortran_prepare_argument (exp, actual[tem].get (), tem, + is_internal_func, + value_type (callee), noside); + return evaluate_subexp_do_call (exp, noside, callee, argvec, nullptr, + expect_type); } default: - error (_("Cannot perform substring on this type")); + error (_ ("Cannot perform substring on this type")); } } value * -fortran_bound_1arg::evaluate (struct type *expect_type, - struct expression *exp, +fortran_bound_1arg::evaluate (struct type *expect_type, struct expression *exp, enum noside noside) { bool lbound_p = std::get<0> (m_storage) == FORTRAN_LBOUND; @@ -1557,8 +1523,7 @@ fortran_bound_1arg::evaluate (struct type *expect_type, } value * -fortran_bound_2arg::evaluate (struct type *expect_type, - struct expression *exp, +fortran_bound_2arg::evaluate (struct type *expect_type, struct expression *exp, enum noside noside) { bool lbound_p = std::get<0> (m_storage) == FORTRAN_LBOUND; @@ -1571,9 +1536,9 @@ fortran_bound_2arg::evaluate (struct type *expect_type, if (type_arg2->code () != TYPE_CODE_INT) { if (lbound_p) - error (_("LBOUND second argument should be an integer")); + error (_ ("LBOUND second argument should be an integer")); else - error (_("UBOUND second argument should be an integer")); + error (_ ("UBOUND second argument should be an integer")); } type *result_type = builtin_f_type (exp->gdbarch)->builtin_integer; @@ -1581,8 +1546,7 @@ fortran_bound_2arg::evaluate (struct type *expect_type, } value * -fortran_bound_3arg::evaluate (type *expect_type, - expression *exp, +fortran_bound_3arg::evaluate (type *expect_type, expression *exp, noside noside) { const bool lbound_p = std::get<0> (m_storage) == FORTRAN_LBOUND; @@ -1595,9 +1559,9 @@ fortran_bound_3arg::evaluate (type *expect_type, if (type_arg2->code () != TYPE_CODE_INT) { if (lbound_p) - error (_("LBOUND second argument should be an integer")); + error (_ ("LBOUND second argument should be an integer")); else - error (_("UBOUND second argument should be an integer")); + error (_ ("UBOUND second argument should be an integer")); } type *kind_arg = std::get<3> (m_storage); @@ -1668,10 +1632,7 @@ f_language::language_arch_info (struct gdbarch *gdbarch, const struct builtin_f_type *builtin = builtin_f_type (gdbarch); /* Helper function to allow shorter lines below. */ - auto add = [&] (struct type * t) - { - lai->add_primitive_type (t); - }; + auto add = [&] (struct type *t) { lai->add_primitive_type (t); }; add (builtin->builtin_character); add (builtin->builtin_logical); @@ -1710,8 +1671,8 @@ f_language::lookup_symbol_nonlocal (const char *name, /* See language.h. */ symbol_name_matcher_ftype * -f_language::get_symbol_name_matcher_inner - (const lookup_name_info &lookup_name) const +f_language::get_symbol_name_matcher_inner ( + const lookup_name_info &lookup_name) const { return cp_get_symbol_name_matcher (lookup_name); } @@ -1758,12 +1719,12 @@ build_fortran_types (struct gdbarch *gdbarch) "integer*8"); builtin_f_type->builtin_real - = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), - "real*4", gdbarch_float_format (gdbarch)); + = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), "real*4", + gdbarch_float_format (gdbarch)); builtin_f_type->builtin_real_s8 - = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch), - "real*8", gdbarch_double_format (gdbarch)); + = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch), "real*8", + gdbarch_double_format (gdbarch)); auto fmt = gdbarch_floatformat_for_type (gdbarch, "real(kind=16)", 128); if (fmt != nullptr) @@ -1771,8 +1732,8 @@ build_fortran_types (struct gdbarch *gdbarch) = arch_float_type (gdbarch, 128, "real*16", fmt); else if (gdbarch_long_double_bit (gdbarch) == 128) builtin_f_type->builtin_real_s16 - = arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch), - "real*16", gdbarch_long_double_format (gdbarch)); + = arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch), "real*16", + gdbarch_long_double_format (gdbarch)); else builtin_f_type->builtin_real_s16 = arch_type (gdbarch, TYPE_CODE_ERROR, 128, "real*16"); @@ -1813,20 +1774,22 @@ static struct cmd_list_element *set_fortran_list; static struct cmd_list_element *show_fortran_list; void _initialize_f_language (); + void _initialize_f_language () { - add_setshow_prefix_cmd - ("fortran", no_class, - _("Prefix command for changing Fortran-specific settings."), - _("Generic command for showing Fortran-specific settings."), - &set_fortran_list, &show_fortran_list, - &setlist, &showlist); + add_setshow_prefix_cmd ( + "fortran", no_class, + _ ("Prefix command for changing Fortran-specific settings."), + _ ("Generic command for showing Fortran-specific settings."), + &set_fortran_list, &show_fortran_list, &setlist, &showlist); add_setshow_boolean_cmd ("repack-array-slices", class_vars, - &repack_array_slices, _("\ -Enable or disable repacking of non-contiguous array slices."), _("\ -Show whether non-contiguous array slices are repacked."), _("\ + &repack_array_slices, _ ("\ +Enable or disable repacking of non-contiguous array slices."), + _ ("\ +Show whether non-contiguous array slices are repacked."), + _ ("\ When the user requests a slice of a Fortran array then we can either return\n\ a descriptor that describes the array in place (using the original array data\n\ in its existing location) or the original data can be repacked (copied) to a\n\ @@ -1836,19 +1799,19 @@ When the content of the array slice is contiguous within the original array\n\ then the result will never be repacked, but when the data for the new array\n\ is non-contiguous within the original array repacking will only be performed\n\ when this setting is on."), - NULL, - show_repack_array_slices, - &set_fortran_list, &show_fortran_list); + NULL, show_repack_array_slices, &set_fortran_list, + &show_fortran_list); /* Debug Fortran's array slicing logic. */ add_setshow_boolean_cmd ("fortran-array-slicing", class_maintenance, - &fortran_array_slicing_debug, _("\ -Set debugging of Fortran array slicing."), _("\ -Show debugging of Fortran array slicing."), _("\ + &fortran_array_slicing_debug, _ ("\ +Set debugging of Fortran array slicing."), + _ ("\ +Show debugging of Fortran array slicing."), + _ ("\ When on, debugging of Fortran array slicing is enabled."), - NULL, - show_fortran_array_slicing_debug, - &setdebuglist, &showdebuglist); + NULL, show_fortran_array_slicing_debug, + &setdebuglist, &showdebuglist); } /* Ensures that function argument VALUE is in the appropriate form to @@ -1879,14 +1842,16 @@ fortran_argument_convert (struct value *value, bool is_artificial) const CORE_ADDR addr = value_as_long (value_allocate_space_in_inferior (length)); write_memory (addr, value_contents (value).data (), length); - struct value *val = value_from_contents_and_address - (type, value_contents (value).data (), addr); + struct value *val + = value_from_contents_and_address (type, + value_contents (value).data (), + addr); return value_addr (val); } else return value_addr (value); /* Program variables, e.g. arrays. */ } - return value; + return value; } /* Prepare (and return) an argument value ready for an inferior function @@ -1908,8 +1873,7 @@ fortran_argument_convert (struct value *value, bool is_artificial) malloc in target memory. Infinite recursion ensues. */ static value * -fortran_prepare_argument (struct expression *exp, - expr::operation *subexp, +fortran_prepare_argument (struct expression *exp, expr::operation *subexp, int arg_num, bool is_internal_call_p, struct type *func_type, enum noside noside) { @@ -1917,8 +1881,8 @@ fortran_prepare_argument (struct expression *exp, return subexp->evaluate_with_coercion (exp, noside); bool is_artificial = ((arg_num >= func_type->num_fields ()) - ? true - : TYPE_FIELD_ARTIFICIAL (func_type, arg_num)); + ? true + : TYPE_FIELD_ARTIFICIAL (func_type, arg_num)); /* If this is an artificial argument, then either, this is an argument beyond the end of the known arguments, or possibly, there are no known @@ -1978,7 +1942,7 @@ fortran_adjust_dynamic_array_base_address_hack (struct type *type, for this dimension points to the element at the highest memory address and the stride is negative. */ struct type *tmp_type = type; - for (int i = 0 ; i < ndimensions; ++i) + for (int i = 0; i < ndimensions; ++i) { /* Grab the range for this dimension and extract the lower and upper bounds. */ |