* [PATCH 0/2] Fortran RANK and SIZE keywords
@ 2021-02-25 20:43 Andrew Burgess
2021-02-25 20:43 ` [PATCH 1/2] gdb/fortran: add support for RANK keyword Andrew Burgess
` (2 more replies)
0 siblings, 3 replies; 11+ messages in thread
From: Andrew Burgess @ 2021-02-25 20:43 UTC (permalink / raw)
To: gdb-patches
Adds support for two more Fortran keywords, RANK and SIZE.
---
Andrew Burgess (2):
gdb/fortran: add support for RANK keyword
gdb/fortran: add support for 'SIZE' keyword
gdb/ChangeLog | 21 +++++
gdb/f-exp.y | 2 +
gdb/f-lang.c | 123 +++++++++++++++++++++++++++++
gdb/std-operator.def | 2 +
gdb/testsuite/ChangeLog | 10 +++
gdb/testsuite/gdb.fortran/rank.exp | 79 ++++++++++++++++++
gdb/testsuite/gdb.fortran/rank.f90 | 57 +++++++++++++
gdb/testsuite/gdb.fortran/size.exp | 89 +++++++++++++++++++++
gdb/testsuite/gdb.fortran/size.f90 | 120 ++++++++++++++++++++++++++++
9 files changed, 503 insertions(+)
create mode 100644 gdb/testsuite/gdb.fortran/rank.exp
create mode 100644 gdb/testsuite/gdb.fortran/rank.f90
create mode 100644 gdb/testsuite/gdb.fortran/size.exp
create mode 100644 gdb/testsuite/gdb.fortran/size.f90
--
2.25.4
^ permalink raw reply [flat|nested] 11+ messages in thread
* [PATCH 1/2] gdb/fortran: add support for RANK keyword
2021-02-25 20:43 [PATCH 0/2] Fortran RANK and SIZE keywords Andrew Burgess
@ 2021-02-25 20:43 ` Andrew Burgess
2021-03-03 20:26 ` Tom Tromey
2021-02-25 20:43 ` [PATCH 2/2] gdb/fortran: add support for 'SIZE' keyword Andrew Burgess
2021-03-08 16:38 ` [PATCHv2 0/3] Fortran RANK, SIZE, and SHAPE keywords Andrew Burgess
2 siblings, 1 reply; 11+ messages in thread
From: Andrew Burgess @ 2021-02-25 20:43 UTC (permalink / raw)
To: gdb-patches
gfortran supports the RANK keyword, see:
https://gcc.gnu.org/onlinedocs/gfortran/RANK.html#RANK
this commit adds support for this keyword to GDB's Fortran expression
parser.
gdb/ChangeLog:
* f-exp.y (f77_keywords): Add "rank" keyword.
* f-lang.c (evaluate_subexp_f): Handle UNOP_FORTRAN_RANK.
(operator_length_f): Likewise.
(print_subexp_f): Likewise.
(dump_subexp_body_f): Likewise.
(operator_check_f): Likewise.
* std-operator.def (UNOP_FORTRAN_RANK): New operator.
gdb/testsuite/ChangeLog:
* gdb.fortran/rank.exp: New file.
* gdb.fortran/rank.f90: New file.
---
gdb/ChangeLog | 10 ++++
gdb/f-exp.y | 1 +
gdb/f-lang.c | 22 +++++++++
gdb/std-operator.def | 1 +
gdb/testsuite/ChangeLog | 5 ++
gdb/testsuite/gdb.fortran/rank.exp | 79 ++++++++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/rank.f90 | 57 +++++++++++++++++++++
7 files changed, 175 insertions(+)
create mode 100644 gdb/testsuite/gdb.fortran/rank.exp
create mode 100644 gdb/testsuite/gdb.fortran/rank.f90
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index f5360c10ef6..f5b6b0f1e5c 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -1049,6 +1049,7 @@ static const struct token f77_keywords[] =
{ "ubound", UNOP_OR_BINOP_INTRINSIC, FORTRAN_UBOUND, false },
{ "allocated", UNOP_INTRINSIC, UNOP_FORTRAN_ALLOCATED, false },
{ "associated", UNOP_OR_BINOP_INTRINSIC, FORTRAN_ASSOCIATED, false },
+ { "rank", UNOP_INTRINSIC, UNOP_FORTRAN_RANK, false },
};
/* Implementation of a dynamically expandable buffer for processing input
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 01de51837f6..97ea6341743 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -1095,6 +1095,21 @@ evaluate_subexp_f (struct type *expect_type, struct expression *exp,
return value_from_longest (result_type, result_value);
}
+ case UNOP_FORTRAN_RANK:
+ {
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ struct type *result_type
+ = builtin_f_type (exp->gdbarch)->builtin_integer;
+ type = check_typedef (value_type (arg1));
+ if (type->code () != TYPE_CODE_ARRAY)
+ return value_from_longest (result_type, 0);
+
+ LONGEST ndim = calc_f77_array_dims (type);
+ return value_from_longest (result_type, ndim);
+ }
+
case BINOP_FORTRAN_MODULO:
{
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
@@ -1323,6 +1338,7 @@ operator_length_f (const struct expression *exp, int pc, int *oplenp,
case UNOP_FORTRAN_FLOOR:
case UNOP_FORTRAN_CEILING:
case UNOP_FORTRAN_ALLOCATED:
+ case UNOP_FORTRAN_RANK:
oplen = 1;
args = 1;
break;
@@ -1434,6 +1450,10 @@ print_subexp_f (struct expression *exp, int *pos,
print_unop_subexp_f (exp, pos, stream, prec, "ALLOCATED");
return;
+ case UNOP_FORTRAN_RANK:
+ print_unop_subexp_f (exp, pos, stream, prec, "RANK");
+ return;
+
case BINOP_FORTRAN_CMPLX:
print_binop_subexp_f (exp, pos, stream, prec, "CMPLX");
return;
@@ -1479,6 +1499,7 @@ dump_subexp_body_f (struct expression *exp,
case UNOP_FORTRAN_FLOOR:
case UNOP_FORTRAN_CEILING:
case UNOP_FORTRAN_ALLOCATED:
+ case UNOP_FORTRAN_RANK:
case BINOP_FORTRAN_CMPLX:
case BINOP_FORTRAN_MODULO:
operator_length_f (exp, (elt + 1), &oplen, &nargs);
@@ -1517,6 +1538,7 @@ operator_check_f (struct expression *exp, int pos,
case UNOP_FORTRAN_FLOOR:
case UNOP_FORTRAN_CEILING:
case UNOP_FORTRAN_ALLOCATED:
+ case UNOP_FORTRAN_RANK:
case BINOP_FORTRAN_CMPLX:
case BINOP_FORTRAN_MODULO:
case FORTRAN_ASSOCIATED:
diff --git a/gdb/std-operator.def b/gdb/std-operator.def
index 99b5d90381a..1df90ebc24c 100644
--- a/gdb/std-operator.def
+++ b/gdb/std-operator.def
@@ -439,6 +439,7 @@ OP (UNOP_FORTRAN_KIND)
OP (UNOP_FORTRAN_FLOOR)
OP (UNOP_FORTRAN_CEILING)
OP (UNOP_FORTRAN_ALLOCATED)
+OP (UNOP_FORTRAN_RANK)
/* Two operand builtins. */
OP (BINOP_FORTRAN_CMPLX)
diff --git a/gdb/testsuite/gdb.fortran/rank.exp b/gdb/testsuite/gdb.fortran/rank.exp
new file mode 100644
index 00000000000..86af7111f47
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/rank.exp
@@ -0,0 +1,79 @@
+# Copyright 2021 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/> .
+
+# Testing GDB's implementation of RANK keyword.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+gdb_breakpoint [gdb_get_line_number "Test Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+# We place a limit on the number of tests that can be run, just in
+# case something goes wrong, and GDB gets stuck in an loop here.
+set found_final_breakpoint false
+set test_count 0
+while { $test_count < 500 } {
+ with_test_prefix "test $test_count" {
+ incr test_count
+
+ gdb_test_multiple "continue" "continue" {
+ -re -wrap "! Test Breakpoint" {
+ # We can run a test from here.
+ }
+ -re "! Final Breakpoint" {
+ # We're done with the tests.
+ set found_final_breakpoint true
+ }
+ }
+
+ if ($found_final_breakpoint) {
+ break
+ }
+
+ # First grab the expected answer.
+ set answer [get_valueof "" "answer" "**unknown**"]
+
+ # Now move up a frame and figure out a command for us to run
+ # as a test.
+ set command ""
+ gdb_test_multiple "up" "up" {
+ -re -wrap "\r\n\[0-9\]+\[ \t\]+call test_rank \\((\[^\r\n\]+)\\)" {
+ set command $expect_out(1,string)
+ }
+ }
+
+ gdb_assert { ![string equal $command ""] } "found a command to run"
+
+ gdb_test "p $command" " = $answer"
+ }
+}
+
+# Ensure we reached the final breakpoint. If more tests have been added
+# to the test script, and this starts failing, then the safety 'while'
+# loop above might need to be increased.
+gdb_assert {$found_final_breakpoint} "ran all compiled in tests"
diff --git a/gdb/testsuite/gdb.fortran/rank.f90 b/gdb/testsuite/gdb.fortran/rank.f90
new file mode 100644
index 00000000000..66de2bb9ed7
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/rank.f90
@@ -0,0 +1,57 @@
+! Copyright 2021 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+!
+! Start of test program.
+!
+program test
+
+ ! Things to ask questions about.
+ integer, target :: array_1d (8:10) = 0
+ integer, target :: array_2d (1:3, 4:7) = 0
+ integer :: other_1d (4:5, -3:-1, 99:101) = 0
+ integer, pointer :: array_1d_p (:) => null ()
+ integer, pointer :: array_2d_p (:,:) => null ()
+
+ integer :: an_integer = 0
+ real :: a_real = 0.0
+
+ ! The start of the tests.
+ call test_rank (rank (array_1d))
+ call test_rank (rank (array_2d))
+ call test_rank (rank (other_1d))
+ call test_rank (rank (array_1d_p))
+ call test_rank (rank (array_2d_p))
+
+ array_1d_p => array_1d
+ array_2d_p => array_2d
+
+ call test_rank (rank (array_1d_p))
+ call test_rank (rank (array_2d_p))
+
+ call test_rank (rank (an_integer))
+ call test_rank (rank (a_real))
+
+ print *, "" ! Final Breakpoint
+
+contains
+
+ subroutine test_rank (answer)
+ integer :: answer
+
+ print *,answer ! Test Breakpoint
+ end subroutine test_rank
+
+end program test
--
2.25.4
^ permalink raw reply [flat|nested] 11+ messages in thread
* [PATCH 2/2] gdb/fortran: add support for 'SIZE' keyword
2021-02-25 20:43 [PATCH 0/2] Fortran RANK and SIZE keywords Andrew Burgess
2021-02-25 20:43 ` [PATCH 1/2] gdb/fortran: add support for RANK keyword Andrew Burgess
@ 2021-02-25 20:43 ` Andrew Burgess
2021-03-03 20:29 ` Tom Tromey
2021-03-08 16:38 ` [PATCHv2 0/3] Fortran RANK, SIZE, and SHAPE keywords Andrew Burgess
2 siblings, 1 reply; 11+ messages in thread
From: Andrew Burgess @ 2021-02-25 20:43 UTC (permalink / raw)
To: gdb-patches
Add support for the 'SIZE' keyword to the Fortran expression parser.
This returns the number of elements either in an entire array (passing
a single argument to SIZE), or in a particular dimension of an
array (passing two arguments to SIZE).
At this point I have not added support for the optional third argument
to SIZE, which controls the exact integer type of the result.
gdb/ChangeLog:
* f-exp.y (f77_keywords): Add "size" keyword.
* f-lang.c (fortran_array_size): New function.
(evaluate_subexp_f): Handle FORTRAN_ARRAY_SIZE.
(operator_length_f): Likewise.
(print_subexp_f): Likewise.
(dump_subexp_body_f): Likewise.
(operator_check_f): Likewise.
* std-operator.def (FORTRAN_ARRAY_SIZE): New operator.
gdb/testsuite/ChangeLog:
* gdb.fortran/size.exp: New file.
* gdb.fortran/size.f90: New file.
---
gdb/ChangeLog | 11 +++
gdb/f-exp.y | 1 +
gdb/f-lang.c | 101 ++++++++++++++++++++++++
gdb/std-operator.def | 1 +
gdb/testsuite/ChangeLog | 5 ++
gdb/testsuite/gdb.fortran/size.exp | 89 +++++++++++++++++++++
gdb/testsuite/gdb.fortran/size.f90 | 120 +++++++++++++++++++++++++++++
7 files changed, 328 insertions(+)
create mode 100644 gdb/testsuite/gdb.fortran/size.exp
create mode 100644 gdb/testsuite/gdb.fortran/size.f90
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index f5b6b0f1e5c..d58fed13ff4 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -1050,6 +1050,7 @@ static const struct token f77_keywords[] =
{ "allocated", UNOP_INTRINSIC, UNOP_FORTRAN_ALLOCATED, false },
{ "associated", UNOP_OR_BINOP_INTRINSIC, FORTRAN_ASSOCIATED, false },
{ "rank", UNOP_INTRINSIC, UNOP_FORTRAN_RANK, false },
+ { "size", UNOP_OR_BINOP_INTRINSIC, FORTRAN_ARRAY_SIZE, false },
};
/* Implementation of a dynamically expandable buffer for processing input
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 97ea6341743..315d2c0c306 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -973,6 +973,75 @@ fortran_associated (struct gdbarch *gdbarch, const language_defn *lang,
return value_from_longest (result_type, is_associated ? 1 : 0);
}
+/* Implement FORTRAN_ARRAY_SIZE expression, this corresponds to the 'SIZE'
+ keyword. Both GDBARCH and LANG are extracted from the expression being
+ evaluated. ARRAY is the value that should be an array, though this will
+ not have been checked before calling this function. DIM is optional, if
+ present then it should be an integer identifying a dimension of the
+ array to ask about. As with ARRAY the validity of DIM is not checked
+ before calling this function.
+
+ Return either the total number of elements in ARRAY (when DIM is
+ nullptr), or the number of elements in dimension DIM. */
+
+static struct value *
+fortran_array_size (struct gdbarch *gdbarch, const language_defn *lang,
+ struct value *array, struct value *dim_val = nullptr)
+{
+ /* 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"));
+ if (type_not_allocated (array_type) || type_not_associated (array_type))
+ error (_("SIZE can only be used on allocated/associated arrays"));
+
+ int ndimensions = calc_f77_array_dims (array_type);
+ int dim = -1;
+ LONGEST result = 0;
+
+ if (dim_val != nullptr)
+ {
+ if (check_typedef (value_type (dim_val))->code () != TYPE_CODE_INT)
+ 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"),
+ ndimensions);
+ }
+
+ /* Now walk over all the dimensions of the array totalling up the
+ elements in each dimension. */
+ for (int i = ndimensions - 1; i >= 0; --i)
+ {
+ /* If this is the requested dimension then we're done. Grab the
+ bounds and return. */
+ if (i == dim - 1 || dim == -1)
+ {
+ LONGEST lbound, ubound;
+ struct type *range = array_type->index_type ();
+
+ if (!get_discrete_bounds (range, &lbound, &ubound))
+ error (_("failed to find array bounds"));
+
+ LONGEST dim_size = (ubound - lbound + 1);
+ if (result == 0)
+ result = dim_size;
+ else
+ result *= dim_size;
+
+ if (dim != -1)
+ break;
+ }
+
+ /* Peel off another dimension of the array. */
+ array_type = TYPE_TARGET_TYPE (array_type);
+ }
+
+ struct type *result_type
+ = builtin_f_type (gdbarch)->builtin_integer;
+ return value_from_longest (result_type, result);
+}
/* Special expression evaluation cases for Fortran. */
@@ -1215,6 +1284,31 @@ evaluate_subexp_f (struct type *expect_type, struct expression *exp,
}
break;
+ case FORTRAN_ARRAY_SIZE:
+ {
+ int nargs = longest_to_int (exp->elts[pc + 1].longconst);
+ (*pos) += 2;
+
+ /* This assertion should be enforced by the expression parser. */
+ gdb_assert (nargs == 1 || nargs == 2);
+
+ arg1 = evaluate_subexp (nullptr, exp, pos, noside);
+
+ if (nargs == 1)
+ {
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ return fortran_array_size (exp->gdbarch, exp->language_defn,
+ arg1);
+ }
+
+ arg2 = evaluate_subexp (nullptr, exp, pos, noside);
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ return fortran_array_size (exp->gdbarch, exp->language_defn,
+ arg1, arg2);
+ }
+
case BINOP_FORTRAN_CMPLX:
arg1 = evaluate_subexp (nullptr, exp, pos, noside);
arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
@@ -1349,6 +1443,7 @@ operator_length_f (const struct expression *exp, int pc, int *oplenp,
args = 2;
break;
+ case FORTRAN_ARRAY_SIZE:
case FORTRAN_ASSOCIATED:
case FORTRAN_LBOUND:
case FORTRAN_UBOUND:
@@ -1466,6 +1561,10 @@ print_subexp_f (struct expression *exp, int *pos,
print_unop_or_binop_subexp_f (exp, pos, stream, prec, "ASSOCIATED");
return;
+ case FORTRAN_ARRAY_SIZE:
+ print_unop_or_binop_subexp_f (exp, pos, stream, prec, "SIZE");
+ return;
+
case FORTRAN_LBOUND:
print_unop_or_binop_subexp_f (exp, pos, stream, prec, "LBOUND");
return;
@@ -1505,6 +1604,7 @@ dump_subexp_body_f (struct expression *exp,
operator_length_f (exp, (elt + 1), &oplen, &nargs);
break;
+ case FORTRAN_ARRAY_SIZE:
case FORTRAN_ASSOCIATED:
case FORTRAN_LBOUND:
case FORTRAN_UBOUND:
@@ -1542,6 +1642,7 @@ operator_check_f (struct expression *exp, int pos,
case BINOP_FORTRAN_CMPLX:
case BINOP_FORTRAN_MODULO:
case FORTRAN_ASSOCIATED:
+ case FORTRAN_ARRAY_SIZE:
case FORTRAN_LBOUND:
case FORTRAN_UBOUND:
/* Any references to objfiles are held in the arguments to this
diff --git a/gdb/std-operator.def b/gdb/std-operator.def
index 1df90ebc24c..615cb3f97b2 100644
--- a/gdb/std-operator.def
+++ b/gdb/std-operator.def
@@ -449,3 +449,4 @@ OP (BINOP_FORTRAN_MODULO)
OP (FORTRAN_LBOUND)
OP (FORTRAN_UBOUND)
OP (FORTRAN_ASSOCIATED)
+OP (FORTRAN_ARRAY_SIZE)
\ No newline at end of file
diff --git a/gdb/testsuite/gdb.fortran/size.exp b/gdb/testsuite/gdb.fortran/size.exp
new file mode 100644
index 00000000000..20a9b2795b0
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/size.exp
@@ -0,0 +1,89 @@
+# Copyright 2021 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/> .
+
+# Testing GDB's implementation of SIZE keyword.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+gdb_breakpoint [gdb_get_line_number "Test Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+# We place a limit on the number of tests that can be run, just in
+# case something goes wrong, and GDB gets stuck in an loop here.
+set found_final_breakpoint false
+set test_count 0
+while { $test_count < 500 } {
+ with_test_prefix "test $test_count" {
+ incr test_count
+
+ gdb_test_multiple "continue" "continue" {
+ -re -wrap "! Test Breakpoint" {
+ # We can run a test from here.
+ }
+ -re -wrap "! Final Breakpoint" {
+ # We're done with the tests.
+ set found_final_breakpoint true
+ }
+ }
+
+ if ($found_final_breakpoint) {
+ break
+ }
+
+ # First grab the expected answer.
+ set answer [get_valueof "" "answer" "**unknown**"]
+
+ # Now move up a frame and figure out a command for us to run
+ # as a test.
+ set command ""
+ gdb_test_multiple "up" "up" {
+ -re -wrap "\r\n\[0-9\]+\[ \t\]+call test_size \\((\[^\r\n\]+)\\)" {
+ set command $expect_out(1,string)
+ }
+ }
+
+ gdb_assert { ![string equal $command ""] } "found a command to run"
+
+ gdb_test "p $command" " = $answer"
+ }
+}
+
+# Ensure we reached the final breakpoint. If more tests have been added
+# to the test script, and this starts failing, then the safety 'while'
+# loop above might need to be increased.
+gdb_assert {$found_final_breakpoint} "ran all compiled in tests"
+
+foreach var {array_1d_p array_2d_p allocatable_array_1d \
+ allocatable_array_2d} {
+ gdb_test "p size ($var)" \
+ "SIZE can only be used on allocated/associated arrays"
+}
+
+foreach var {an_integer a_real} {
+ gdb_test "p size ($var)" "SIZE can only be applied to arrays"
+}
diff --git a/gdb/testsuite/gdb.fortran/size.f90 b/gdb/testsuite/gdb.fortran/size.f90
new file mode 100644
index 00000000000..a0e59889c4f
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/size.f90
@@ -0,0 +1,120 @@
+! Copyright 2021 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+!
+! Start of test program.
+!
+program test
+
+ ! Things to perform tests on.
+ integer, target :: array_1d (1:10) = 0
+ integer, target :: array_2d (1:4, 1:3) = 0
+ integer :: an_integer = 0
+ real :: a_real = 0.0
+ integer, pointer :: array_1d_p (:) => null ()
+ integer, pointer :: array_2d_p (:,:) => null ()
+ integer, allocatable :: allocatable_array_1d (:)
+ integer, allocatable :: allocatable_array_2d (:,:)
+
+ ! Loop counters.
+ integer :: s1, s2
+
+ call test_size (size (array_2d (1:4:1, 1:3:1), 1))
+
+ ! The start of the tests.
+ call test_size (size (array_1d))
+ call test_size (size (array_1d, 1))
+ do s1=1, SIZE (array_1d, 1), 1
+ call test_size (size (array_1d (1:10:s1)))
+ call test_size (size (array_1d (1:10:s1), 1))
+ call test_size (size (array_1d (10:1:-s1)))
+ call test_size (size (array_1d (10:1:-s1), 1))
+ end do
+
+ do s2=1, SIZE (array_2d, 2), 1
+ do s1=1, SIZE (array_2d, 1), 1
+ call test_size (size (array_2d (1:4:s1, 1:3:s2)))
+ call test_size (size (array_2d (4:1:-s1, 1:3:s2)))
+ call test_size (size (array_2d (1:4:s1, 3:1:-s2)))
+ call test_size (size (array_2d (4:1:-s1, 3:1:-s2)))
+
+ call test_size (size (array_2d (1:4:s1, 1:3:s2), 1))
+ call test_size (size (array_2d (4:1:-s1, 1:3:s2), 1))
+ call test_size (size (array_2d (1:4:s1, 3:1:-s2), 1))
+ call test_size (size (array_2d (4:1:-s1, 3:1:-s2), 1))
+
+ call test_size (size (array_2d (1:4:s1, 1:3:s2), 2))
+ call test_size (size (array_2d (4:1:-s1, 1:3:s2), 2))
+ call test_size (size (array_2d (1:4:s1, 3:1:-s2), 2))
+ call test_size (size (array_2d (4:1:-s1, 3:1:-s2), 2))
+ end do
+ end do
+
+ allocate (allocatable_array_1d (-10:-5))
+ call test_size (size (allocatable_array_1d))
+ do s1=1, SIZE (allocatable_array_1d, 1), 1
+ call test_size (size (allocatable_array_1d (-10:-5:s1)))
+ call test_size (size (allocatable_array_1d (-5:-10:-s1)))
+
+ call test_size (size (allocatable_array_1d (-10:-5:s1), 1))
+ call test_size (size (allocatable_array_1d (-5:-10:-s1), 1))
+ end do
+
+ allocate (allocatable_array_2d (-3:3, 8:12))
+ do s2=1, SIZE (allocatable_array_2d, 2), 1
+ do s1=1, SIZE (allocatable_array_2d, 1), 1
+ call test_size (size (allocatable_array_2d (-3:3:s1, 8:12:s2)))
+ call test_size (size (allocatable_array_2d (3:-3:-s1, 8:12:s2)))
+ call test_size (size (allocatable_array_2d (-3:3:s1, 12:8:-s2)))
+ call test_size (size (allocatable_array_2d (3:-3:-s1, 12:8:-s2)))
+
+ call test_size (size (allocatable_array_2d (-3:3:s1, 8:12:s2), 1))
+ call test_size (size (allocatable_array_2d (3:-3:-s1, 8:12:s2), 2))
+ call test_size (size (allocatable_array_2d (-3:3:s1, 12:8:-s2), 1))
+ call test_size (size (allocatable_array_2d (3:-3:-s1, 12:8:-s2), 2))
+ end do
+ end do
+
+ array_1d_p => array_1d
+ call test_size (size (array_1d_p))
+ call test_size (size (array_1d_p, 1))
+
+ array_2d_p => array_2d
+ call test_size (size (array_2d_p))
+ call test_size (size (array_2d_p, 1))
+ call test_size (size (array_2d_p, 2))
+
+ deallocate (allocatable_array_1d)
+ deallocate (allocatable_array_2d)
+ array_1d_p => null ()
+ array_2d_p => null ()
+
+ print *, "" ! Final Breakpoint
+ print *, an_integer
+ print *, a_real
+ print *, associated (array_1d_p)
+ print *, associated (array_2d_p)
+ print *, allocated (allocatable_array_1d)
+ print *, allocated (allocatable_array_2d)
+
+contains
+
+ subroutine test_size (answer)
+ integer :: answer
+
+ print *,answer ! Test Breakpoint
+ end subroutine test_size
+
+end program test
--
2.25.4
^ permalink raw reply [flat|nested] 11+ messages in thread
* Re: [PATCH 1/2] gdb/fortran: add support for RANK keyword
2021-02-25 20:43 ` [PATCH 1/2] gdb/fortran: add support for RANK keyword Andrew Burgess
@ 2021-03-03 20:26 ` Tom Tromey
0 siblings, 0 replies; 11+ messages in thread
From: Tom Tromey @ 2021-03-03 20:26 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches
>>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
Andrew> gdb/ChangeLog:
Andrew> * f-exp.y (f77_keywords): Add "rank" keyword.
Andrew> * f-lang.c (evaluate_subexp_f): Handle UNOP_FORTRAN_RANK.
Andrew> (operator_length_f): Likewise.
Andrew> (print_subexp_f): Likewise.
Andrew> (dump_subexp_body_f): Likewise.
Andrew> (operator_check_f): Likewise.
Andrew> * std-operator.def (UNOP_FORTRAN_RANK): New operator.
Looks good.
Tom
^ permalink raw reply [flat|nested] 11+ messages in thread
* Re: [PATCH 2/2] gdb/fortran: add support for 'SIZE' keyword
2021-02-25 20:43 ` [PATCH 2/2] gdb/fortran: add support for 'SIZE' keyword Andrew Burgess
@ 2021-03-03 20:29 ` Tom Tromey
2021-03-04 10:24 ` Andrew Burgess
0 siblings, 1 reply; 11+ messages in thread
From: Tom Tromey @ 2021-03-03 20:29 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches
>>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
Andrew> Add support for the 'SIZE' keyword to the Fortran expression parser.
Andrew> This returns the number of elements either in an entire array (passing
Andrew> a single argument to SIZE), or in a particular dimension of an
Andrew> array (passing two arguments to SIZE).
Andrew> At this point I have not added support for the optional third argument
Andrew> to SIZE, which controls the exact integer type of the result.
Andrew> gdb/ChangeLog:
Andrew> * f-exp.y (f77_keywords): Add "size" keyword.
Andrew> * f-lang.c (fortran_array_size): New function.
Andrew> (evaluate_subexp_f): Handle FORTRAN_ARRAY_SIZE.
Andrew> (operator_length_f): Likewise.
Andrew> (print_subexp_f): Likewise.
Andrew> (dump_subexp_body_f): Likewise.
Andrew> (operator_check_f): Likewise.
Andrew> * std-operator.def (FORTRAN_ARRAY_SIZE): New operator.
Looks good, thank you.
Tom
^ permalink raw reply [flat|nested] 11+ messages in thread
* Re: [PATCH 2/2] gdb/fortran: add support for 'SIZE' keyword
2021-03-03 20:29 ` Tom Tromey
@ 2021-03-04 10:24 ` Andrew Burgess
0 siblings, 0 replies; 11+ messages in thread
From: Andrew Burgess @ 2021-03-04 10:24 UTC (permalink / raw)
To: Tom Tromey; +Cc: gdb-patches
* Tom Tromey <tom@tromey.com> [2021-03-03 13:29:37 -0700]:
> >>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
>
> Andrew> Add support for the 'SIZE' keyword to the Fortran expression parser.
> Andrew> This returns the number of elements either in an entire array (passing
> Andrew> a single argument to SIZE), or in a particular dimension of an
> Andrew> array (passing two arguments to SIZE).
>
> Andrew> At this point I have not added support for the optional third argument
> Andrew> to SIZE, which controls the exact integer type of the result.
>
> Andrew> gdb/ChangeLog:
>
> Andrew> * f-exp.y (f77_keywords): Add "size" keyword.
> Andrew> * f-lang.c (fortran_array_size): New function.
> Andrew> (evaluate_subexp_f): Handle FORTRAN_ARRAY_SIZE.
> Andrew> (operator_length_f): Likewise.
> Andrew> (print_subexp_f): Likewise.
> Andrew> (dump_subexp_body_f): Likewise.
> Andrew> (operator_check_f): Likewise.
> Andrew> * std-operator.def (FORTRAN_ARRAY_SIZE): New operator.
>
> Looks good, thank you.
Thanks for looking at this. I don't plan to push until next Tuesday.
Just in case anything changes in this area ;-)
Andrew
^ permalink raw reply [flat|nested] 11+ messages in thread
* [PATCHv2 0/3] Fortran RANK, SIZE, and SHAPE keywords
2021-02-25 20:43 [PATCH 0/2] Fortran RANK and SIZE keywords Andrew Burgess
2021-02-25 20:43 ` [PATCH 1/2] gdb/fortran: add support for RANK keyword Andrew Burgess
2021-02-25 20:43 ` [PATCH 2/2] gdb/fortran: add support for 'SIZE' keyword Andrew Burgess
@ 2021-03-08 16:38 ` Andrew Burgess
2021-03-08 16:38 ` [PATCHv2 1/3] gdb/fortran: add support for RANK keyword Andrew Burgess
` (3 more replies)
2 siblings, 4 replies; 11+ messages in thread
From: Andrew Burgess @ 2021-03-08 16:38 UTC (permalink / raw)
To: gdb-patches
Rebase of the RANK and SIZE patches after the big expression change.
I've added an extra patch to handle the SHAPE keyword.
Thanks,
Andrew
---
Andrew Burgess (3):
gdb/fortran: add support for RANK keyword
gdb/fortran: add support for 'SIZE' keyword
gdb/fotran: add support for the 'shape' keyword
gdb/ChangeLog | 34 +++++
gdb/f-exp.h | 53 ++++++++
gdb/f-exp.y | 16 +++
gdb/f-lang.c | 198 ++++++++++++++++++++++++++++
gdb/std-operator.def | 3 +
gdb/testsuite/ChangeLog | 15 +++
gdb/testsuite/gdb.fortran/rank.exp | 79 +++++++++++
gdb/testsuite/gdb.fortran/rank.f90 | 57 ++++++++
gdb/testsuite/gdb.fortran/shape.exp | 86 ++++++++++++
gdb/testsuite/gdb.fortran/shape.f90 | 77 +++++++++++
gdb/testsuite/gdb.fortran/size.exp | 89 +++++++++++++
gdb/testsuite/gdb.fortran/size.f90 | 118 +++++++++++++++++
12 files changed, 825 insertions(+)
create mode 100644 gdb/testsuite/gdb.fortran/rank.exp
create mode 100644 gdb/testsuite/gdb.fortran/rank.f90
create mode 100644 gdb/testsuite/gdb.fortran/shape.exp
create mode 100644 gdb/testsuite/gdb.fortran/shape.f90
create mode 100644 gdb/testsuite/gdb.fortran/size.exp
create mode 100644 gdb/testsuite/gdb.fortran/size.f90
--
2.25.4
^ permalink raw reply [flat|nested] 11+ messages in thread
* [PATCHv2 1/3] gdb/fortran: add support for RANK keyword
2021-03-08 16:38 ` [PATCHv2 0/3] Fortran RANK, SIZE, and SHAPE keywords Andrew Burgess
@ 2021-03-08 16:38 ` Andrew Burgess
2021-03-08 16:38 ` [PATCHv2 2/3] gdb/fortran: add support for 'SIZE' keyword Andrew Burgess
` (2 subsequent siblings)
3 siblings, 0 replies; 11+ messages in thread
From: Andrew Burgess @ 2021-03-08 16:38 UTC (permalink / raw)
To: gdb-patches
gfortran supports the RANK keyword, see:
https://gcc.gnu.org/onlinedocs/gfortran/RANK.html#RANK
this commit adds support for this keyword to GDB's Fortran expression
parser.
gdb/ChangeLog:
* f-exp.h (eval_op_f_rank): Declare.
(expr::fortran_rank_operation): New typedef.
* f-exp.y (exp): Handle UNOP_FORTRAN_RANK after parsing an
UNOP_INTRINSIC.
(f77_keywords): Add "rank" keyword.
* f-lang.c (eval_op_f_rank): New function.
* std-operator.def (UNOP_FORTRAN_RANK): New operator.
gdb/testsuite/ChangeLog:
* gdb.fortran/rank.exp: New file.
* gdb.fortran/rank.f90: New file.
---
gdb/ChangeLog | 10 ++++
gdb/f-exp.h | 13 +++++
gdb/f-exp.y | 4 ++
gdb/f-lang.c | 20 ++++++++
gdb/std-operator.def | 1 +
gdb/testsuite/ChangeLog | 5 ++
gdb/testsuite/gdb.fortran/rank.exp | 79 ++++++++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/rank.f90 | 57 +++++++++++++++++++++
8 files changed, 189 insertions(+)
create mode 100644 gdb/testsuite/gdb.fortran/rank.exp
create mode 100644 gdb/testsuite/gdb.fortran/rank.f90
diff --git a/gdb/f-exp.h b/gdb/f-exp.h
index 81cf3412ee2..f23c426b34b 100644
--- a/gdb/f-exp.h
+++ b/gdb/f-exp.h
@@ -74,6 +74,17 @@ extern struct value * eval_op_f_allocated (struct type *expect_type,
enum exp_opcode op,
struct value *arg1);
+/* Implement the evaluation of UNOP_FORTRAN_RANK. EXPECTED_TYPE, EXP, and
+ NOSIDE are as for expression::evaluate (see expression.h). OP will
+ always be UNOP_FORTRAN_RANK, and ARG1 is the argument being passed to
+ the expression. */
+
+extern struct value *eval_op_f_rank (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside,
+ enum exp_opcode op,
+ struct value *arg1);
+
namespace expr
{
@@ -94,6 +105,8 @@ using fortran_associated_1arg = unop_operation<FORTRAN_ASSOCIATED,
eval_op_f_associated>;
using fortran_associated_2arg = binop_operation<FORTRAN_ASSOCIATED,
eval_op_f_associated>;
+using fortran_rank_operation = unop_operation<UNOP_FORTRAN_RANK,
+ eval_op_f_rank>;
/* The Fortran "complex" operation. */
class fortran_cmplx_operation
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index c33b5079158..02e35c83b05 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -320,6 +320,9 @@ exp : UNOP_INTRINSIC '(' exp ')'
case UNOP_FORTRAN_ALLOCATED:
pstate->wrap<fortran_allocated_operation> ();
break;
+ case UNOP_FORTRAN_RANK:
+ pstate->wrap<fortran_rank_operation> ();
+ break;
default:
gdb_assert_not_reached ("unhandled intrinsic");
}
@@ -1139,6 +1142,7 @@ static const struct token f77_keywords[] =
{ "ubound", UNOP_OR_BINOP_INTRINSIC, FORTRAN_UBOUND, false },
{ "allocated", UNOP_INTRINSIC, UNOP_FORTRAN_ALLOCATED, false },
{ "associated", UNOP_OR_BINOP_INTRINSIC, FORTRAN_ASSOCIATED, false },
+ { "rank", UNOP_INTRINSIC, UNOP_FORTRAN_RANK, false },
};
/* Implementation of a dynamically expandable buffer for processing input
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 1b66ae34159..d30b13d8b6d 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -773,6 +773,26 @@ eval_op_f_allocated (struct type *expect_type, struct expression *exp,
return value_from_longest (result_type, result_value);
}
+/* 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)
+{
+ gdb_assert (op == UNOP_FORTRAN_RANK);
+
+ 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);
+ LONGEST ndim = calc_f77_array_dims (type);
+ return value_from_longest (result_type, ndim);
+}
+
namespace expr
{
diff --git a/gdb/std-operator.def b/gdb/std-operator.def
index b0c6beb4628..158bd244765 100644
--- a/gdb/std-operator.def
+++ b/gdb/std-operator.def
@@ -378,6 +378,7 @@ OP (UNOP_FORTRAN_KIND)
OP (UNOP_FORTRAN_FLOOR)
OP (UNOP_FORTRAN_CEILING)
OP (UNOP_FORTRAN_ALLOCATED)
+OP (UNOP_FORTRAN_RANK)
/* Two operand builtins. */
OP (BINOP_FORTRAN_CMPLX)
diff --git a/gdb/testsuite/gdb.fortran/rank.exp b/gdb/testsuite/gdb.fortran/rank.exp
new file mode 100644
index 00000000000..86af7111f47
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/rank.exp
@@ -0,0 +1,79 @@
+# Copyright 2021 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/> .
+
+# Testing GDB's implementation of RANK keyword.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+gdb_breakpoint [gdb_get_line_number "Test Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+# We place a limit on the number of tests that can be run, just in
+# case something goes wrong, and GDB gets stuck in an loop here.
+set found_final_breakpoint false
+set test_count 0
+while { $test_count < 500 } {
+ with_test_prefix "test $test_count" {
+ incr test_count
+
+ gdb_test_multiple "continue" "continue" {
+ -re -wrap "! Test Breakpoint" {
+ # We can run a test from here.
+ }
+ -re "! Final Breakpoint" {
+ # We're done with the tests.
+ set found_final_breakpoint true
+ }
+ }
+
+ if ($found_final_breakpoint) {
+ break
+ }
+
+ # First grab the expected answer.
+ set answer [get_valueof "" "answer" "**unknown**"]
+
+ # Now move up a frame and figure out a command for us to run
+ # as a test.
+ set command ""
+ gdb_test_multiple "up" "up" {
+ -re -wrap "\r\n\[0-9\]+\[ \t\]+call test_rank \\((\[^\r\n\]+)\\)" {
+ set command $expect_out(1,string)
+ }
+ }
+
+ gdb_assert { ![string equal $command ""] } "found a command to run"
+
+ gdb_test "p $command" " = $answer"
+ }
+}
+
+# Ensure we reached the final breakpoint. If more tests have been added
+# to the test script, and this starts failing, then the safety 'while'
+# loop above might need to be increased.
+gdb_assert {$found_final_breakpoint} "ran all compiled in tests"
diff --git a/gdb/testsuite/gdb.fortran/rank.f90 b/gdb/testsuite/gdb.fortran/rank.f90
new file mode 100644
index 00000000000..66de2bb9ed7
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/rank.f90
@@ -0,0 +1,57 @@
+! Copyright 2021 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+!
+! Start of test program.
+!
+program test
+
+ ! Things to ask questions about.
+ integer, target :: array_1d (8:10) = 0
+ integer, target :: array_2d (1:3, 4:7) = 0
+ integer :: other_1d (4:5, -3:-1, 99:101) = 0
+ integer, pointer :: array_1d_p (:) => null ()
+ integer, pointer :: array_2d_p (:,:) => null ()
+
+ integer :: an_integer = 0
+ real :: a_real = 0.0
+
+ ! The start of the tests.
+ call test_rank (rank (array_1d))
+ call test_rank (rank (array_2d))
+ call test_rank (rank (other_1d))
+ call test_rank (rank (array_1d_p))
+ call test_rank (rank (array_2d_p))
+
+ array_1d_p => array_1d
+ array_2d_p => array_2d
+
+ call test_rank (rank (array_1d_p))
+ call test_rank (rank (array_2d_p))
+
+ call test_rank (rank (an_integer))
+ call test_rank (rank (a_real))
+
+ print *, "" ! Final Breakpoint
+
+contains
+
+ subroutine test_rank (answer)
+ integer :: answer
+
+ print *,answer ! Test Breakpoint
+ end subroutine test_rank
+
+end program test
--
2.25.4
^ permalink raw reply [flat|nested] 11+ messages in thread
* [PATCHv2 2/3] gdb/fortran: add support for 'SIZE' keyword
2021-03-08 16:38 ` [PATCHv2 0/3] Fortran RANK, SIZE, and SHAPE keywords Andrew Burgess
2021-03-08 16:38 ` [PATCHv2 1/3] gdb/fortran: add support for RANK keyword Andrew Burgess
@ 2021-03-08 16:38 ` Andrew Burgess
2021-03-08 16:38 ` [PATCHv2 3/3] gdb/fotran: add support for the 'shape' keyword Andrew Burgess
2021-03-08 18:55 ` [PATCHv2 0/3] Fortran RANK, SIZE, and SHAPE keywords Tom Tromey
3 siblings, 0 replies; 11+ messages in thread
From: Andrew Burgess @ 2021-03-08 16:38 UTC (permalink / raw)
To: gdb-patches
Add support for the 'SIZE' keyword to the Fortran expression parser.
This returns the number of elements either in an entire array (passing
a single argument to SIZE), or in a particular dimension of an
array (passing two arguments to SIZE).
At this point I have not added support for the optional third argument
to SIZE, which controls the exact integer type of the result.
gdb/ChangeLog:
* f-exp.y (eval_op_f_array_size): Declare 1 and 2 argument forms
of this function.
(expr::fortran_array_size_1arg): New type.
(expr::fortran_array_size_2arg): Likewise.
* f-exp.y (exp): Handle FORTRAN_ARRAY_SIZE after parsing
UNOP_OR_BINOP_INTRINSIC.
(f77_keywords): Add "size" keyword.
* f-lang.c (fortran_array_size): New function.
(eval_op_f_array_size): New function, has a 1 arg and 2 arg form.
* std-operator.def (FORTRAN_ARRAY_SIZE): New operator.
gdb/testsuite/ChangeLog:
* gdb.fortran/size.exp: New file.
* gdb.fortran/size.f90: New file.
---
gdb/ChangeLog | 13 ++++
gdb/f-exp.h | 28 +++++++
gdb/f-exp.y | 8 ++
gdb/f-lang.c | 97 ++++++++++++++++++++++++
gdb/std-operator.def | 1 +
gdb/testsuite/ChangeLog | 5 ++
gdb/testsuite/gdb.fortran/size.exp | 89 ++++++++++++++++++++++
gdb/testsuite/gdb.fortran/size.f90 | 118 +++++++++++++++++++++++++++++
8 files changed, 359 insertions(+)
create mode 100644 gdb/testsuite/gdb.fortran/size.exp
create mode 100644 gdb/testsuite/gdb.fortran/size.f90
diff --git a/gdb/f-exp.h b/gdb/f-exp.h
index f23c426b34b..fc46c123c6a 100644
--- a/gdb/f-exp.h
+++ b/gdb/f-exp.h
@@ -85,6 +85,30 @@ extern struct value *eval_op_f_rank (struct type *expect_type,
enum exp_opcode op,
struct value *arg1);
+/* Implement expression evaluation for Fortran's SIZE keyword. For
+ EXPECT_TYPE, EXP, and NOSIDE see expression::evaluate (in
+ expression.h). OP will always for FORTRAN_ARRAY_SIZE. ARG1 is the
+ value passed to SIZE if it is only passed a single argument. For the
+ two argument form see the overload of this function below. */
+
+extern struct value *eval_op_f_array_size (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside,
+ enum exp_opcode opcode,
+ struct value *arg1);
+
+/* An overload of EVAL_OP_F_ARRAY_SIZE above, this version takes two
+ arguments, representing the two values passed to Fortran's SIZE
+ keyword. */
+
+extern 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);
+
+
namespace expr
{
@@ -107,6 +131,10 @@ using fortran_associated_2arg = binop_operation<FORTRAN_ASSOCIATED,
eval_op_f_associated>;
using fortran_rank_operation = unop_operation<UNOP_FORTRAN_RANK,
eval_op_f_rank>;
+using fortran_array_size_1arg = unop_operation<FORTRAN_ARRAY_SIZE,
+ eval_op_f_array_size>;
+using fortran_array_size_2arg = binop_operation<FORTRAN_ARRAY_SIZE,
+ eval_op_f_array_size>;
/* The Fortran "complex" operation. */
class fortran_cmplx_operation
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 02e35c83b05..ed6bd5935af 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -260,6 +260,13 @@ exp : UNOP_OR_BINOP_INTRINSIC '('
else
pstate->wrap2<fortran_associated_2arg> ();
}
+ if ($1 == FORTRAN_ARRAY_SIZE)
+ {
+ if (n == 1)
+ pstate->wrap<fortran_array_size_1arg> ();
+ else
+ pstate->wrap2<fortran_array_size_2arg> ();
+ }
else
{
std::vector<operation_up> args
@@ -1143,6 +1150,7 @@ static const struct token f77_keywords[] =
{ "allocated", UNOP_INTRINSIC, UNOP_FORTRAN_ALLOCATED, false },
{ "associated", UNOP_OR_BINOP_INTRINSIC, FORTRAN_ASSOCIATED, false },
{ "rank", UNOP_INTRINSIC, UNOP_FORTRAN_RANK, false },
+ { "size", UNOP_OR_BINOP_INTRINSIC, FORTRAN_ARRAY_SIZE, false },
};
/* Implementation of a dynamically expandable buffer for processing input
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index d30b13d8b6d..a33aef31d4f 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -578,6 +578,103 @@ eval_op_f_associated (struct type *expect_type,
return fortran_associated (exp->gdbarch, exp->language_defn, arg1, arg2);
}
+/* Implement FORTRAN_ARRAY_SIZE expression, this corresponds to the 'SIZE'
+ keyword. Both GDBARCH and LANG are extracted from the expression being
+ evaluated. ARRAY is the value that should be an array, though this will
+ not have been checked before calling this function. DIM is optional, if
+ present then it should be an integer identifying a dimension of the
+ array to ask about. As with ARRAY the validity of DIM is not checked
+ before calling this function.
+
+ Return either the total number of elements in ARRAY (when DIM is
+ nullptr), or the number of elements in dimension DIM. */
+
+static struct value *
+fortran_array_size (struct gdbarch *gdbarch, const language_defn *lang,
+ struct value *array, struct value *dim_val = nullptr)
+{
+ /* 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"));
+ if (type_not_allocated (array_type) || type_not_associated (array_type))
+ error (_("SIZE can only be used on allocated/associated arrays"));
+
+ int ndimensions = calc_f77_array_dims (array_type);
+ int dim = -1;
+ LONGEST result = 0;
+
+ if (dim_val != nullptr)
+ {
+ if (check_typedef (value_type (dim_val))->code () != TYPE_CODE_INT)
+ 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"),
+ ndimensions);
+ }
+
+ /* Now walk over all the dimensions of the array totalling up the
+ elements in each dimension. */
+ for (int i = ndimensions - 1; i >= 0; --i)
+ {
+ /* If this is the requested dimension then we're done. Grab the
+ bounds and return. */
+ if (i == dim - 1 || dim == -1)
+ {
+ LONGEST lbound, ubound;
+ struct type *range = array_type->index_type ();
+
+ if (!get_discrete_bounds (range, &lbound, &ubound))
+ error (_("failed to find array bounds"));
+
+ LONGEST dim_size = (ubound - lbound + 1);
+ if (result == 0)
+ result = dim_size;
+ else
+ result *= dim_size;
+
+ if (dim != -1)
+ break;
+ }
+
+ /* Peel off another dimension of the array. */
+ array_type = TYPE_TARGET_TYPE (array_type);
+ }
+
+ struct type *result_type
+ = builtin_f_type (gdbarch)->builtin_integer;
+ return value_from_longest (result_type, result);
+}
+
+/* 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)
+{
+ gdb_assert (opcode == FORTRAN_ARRAY_SIZE);
+ return fortran_array_size (exp->gdbarch, exp->language_defn, arg1);
+}
+
+/* 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)
+{
+ gdb_assert (opcode == FORTRAN_ARRAY_SIZE);
+ return fortran_array_size (exp->gdbarch, exp->language_defn, arg1, arg2);
+}
+
/* A helper function for UNOP_ABS. */
struct value *
diff --git a/gdb/std-operator.def b/gdb/std-operator.def
index 158bd244765..b67247f7e18 100644
--- a/gdb/std-operator.def
+++ b/gdb/std-operator.def
@@ -388,3 +388,4 @@ OP (BINOP_FORTRAN_MODULO)
OP (FORTRAN_LBOUND)
OP (FORTRAN_UBOUND)
OP (FORTRAN_ASSOCIATED)
+OP (FORTRAN_ARRAY_SIZE)
\ No newline at end of file
diff --git a/gdb/testsuite/gdb.fortran/size.exp b/gdb/testsuite/gdb.fortran/size.exp
new file mode 100644
index 00000000000..20a9b2795b0
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/size.exp
@@ -0,0 +1,89 @@
+# Copyright 2021 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/> .
+
+# Testing GDB's implementation of SIZE keyword.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+gdb_breakpoint [gdb_get_line_number "Test Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+# We place a limit on the number of tests that can be run, just in
+# case something goes wrong, and GDB gets stuck in an loop here.
+set found_final_breakpoint false
+set test_count 0
+while { $test_count < 500 } {
+ with_test_prefix "test $test_count" {
+ incr test_count
+
+ gdb_test_multiple "continue" "continue" {
+ -re -wrap "! Test Breakpoint" {
+ # We can run a test from here.
+ }
+ -re -wrap "! Final Breakpoint" {
+ # We're done with the tests.
+ set found_final_breakpoint true
+ }
+ }
+
+ if ($found_final_breakpoint) {
+ break
+ }
+
+ # First grab the expected answer.
+ set answer [get_valueof "" "answer" "**unknown**"]
+
+ # Now move up a frame and figure out a command for us to run
+ # as a test.
+ set command ""
+ gdb_test_multiple "up" "up" {
+ -re -wrap "\r\n\[0-9\]+\[ \t\]+call test_size \\((\[^\r\n\]+)\\)" {
+ set command $expect_out(1,string)
+ }
+ }
+
+ gdb_assert { ![string equal $command ""] } "found a command to run"
+
+ gdb_test "p $command" " = $answer"
+ }
+}
+
+# Ensure we reached the final breakpoint. If more tests have been added
+# to the test script, and this starts failing, then the safety 'while'
+# loop above might need to be increased.
+gdb_assert {$found_final_breakpoint} "ran all compiled in tests"
+
+foreach var {array_1d_p array_2d_p allocatable_array_1d \
+ allocatable_array_2d} {
+ gdb_test "p size ($var)" \
+ "SIZE can only be used on allocated/associated arrays"
+}
+
+foreach var {an_integer a_real} {
+ gdb_test "p size ($var)" "SIZE can only be applied to arrays"
+}
diff --git a/gdb/testsuite/gdb.fortran/size.f90 b/gdb/testsuite/gdb.fortran/size.f90
new file mode 100644
index 00000000000..4b556a73b06
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/size.f90
@@ -0,0 +1,118 @@
+! Copyright 2021 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+!
+! Start of test program.
+!
+program test
+
+ ! Things to perform tests on.
+ integer, target :: array_1d (1:10) = 0
+ integer, target :: array_2d (1:4, 1:3) = 0
+ integer :: an_integer = 0
+ real :: a_real = 0.0
+ integer, pointer :: array_1d_p (:) => null ()
+ integer, pointer :: array_2d_p (:,:) => null ()
+ integer, allocatable :: allocatable_array_1d (:)
+ integer, allocatable :: allocatable_array_2d (:,:)
+
+ ! Loop counters.
+ integer :: s1, s2
+
+ ! The start of the tests.
+ call test_size (size (array_1d))
+ call test_size (size (array_1d, 1))
+ do s1=1, SIZE (array_1d, 1), 1
+ call test_size (size (array_1d (1:10:s1)))
+ call test_size (size (array_1d (1:10:s1), 1))
+ call test_size (size (array_1d (10:1:-s1)))
+ call test_size (size (array_1d (10:1:-s1), 1))
+ end do
+
+ do s2=1, SIZE (array_2d, 2), 1
+ do s1=1, SIZE (array_2d, 1), 1
+ call test_size (size (array_2d (1:4:s1, 1:3:s2)))
+ call test_size (size (array_2d (4:1:-s1, 1:3:s2)))
+ call test_size (size (array_2d (1:4:s1, 3:1:-s2)))
+ call test_size (size (array_2d (4:1:-s1, 3:1:-s2)))
+
+ call test_size (size (array_2d (1:4:s1, 1:3:s2), 1))
+ call test_size (size (array_2d (4:1:-s1, 1:3:s2), 1))
+ call test_size (size (array_2d (1:4:s1, 3:1:-s2), 1))
+ call test_size (size (array_2d (4:1:-s1, 3:1:-s2), 1))
+
+ call test_size (size (array_2d (1:4:s1, 1:3:s2), 2))
+ call test_size (size (array_2d (4:1:-s1, 1:3:s2), 2))
+ call test_size (size (array_2d (1:4:s1, 3:1:-s2), 2))
+ call test_size (size (array_2d (4:1:-s1, 3:1:-s2), 2))
+ end do
+ end do
+
+ allocate (allocatable_array_1d (-10:-5))
+ call test_size (size (allocatable_array_1d))
+ do s1=1, SIZE (allocatable_array_1d, 1), 1
+ call test_size (size (allocatable_array_1d (-10:-5:s1)))
+ call test_size (size (allocatable_array_1d (-5:-10:-s1)))
+
+ call test_size (size (allocatable_array_1d (-10:-5:s1), 1))
+ call test_size (size (allocatable_array_1d (-5:-10:-s1), 1))
+ end do
+
+ allocate (allocatable_array_2d (-3:3, 8:12))
+ do s2=1, SIZE (allocatable_array_2d, 2), 1
+ do s1=1, SIZE (allocatable_array_2d, 1), 1
+ call test_size (size (allocatable_array_2d (-3:3:s1, 8:12:s2)))
+ call test_size (size (allocatable_array_2d (3:-3:-s1, 8:12:s2)))
+ call test_size (size (allocatable_array_2d (-3:3:s1, 12:8:-s2)))
+ call test_size (size (allocatable_array_2d (3:-3:-s1, 12:8:-s2)))
+
+ call test_size (size (allocatable_array_2d (-3:3:s1, 8:12:s2), 1))
+ call test_size (size (allocatable_array_2d (3:-3:-s1, 8:12:s2), 2))
+ call test_size (size (allocatable_array_2d (-3:3:s1, 12:8:-s2), 1))
+ call test_size (size (allocatable_array_2d (3:-3:-s1, 12:8:-s2), 2))
+ end do
+ end do
+
+ array_1d_p => array_1d
+ call test_size (size (array_1d_p))
+ call test_size (size (array_1d_p, 1))
+
+ array_2d_p => array_2d
+ call test_size (size (array_2d_p))
+ call test_size (size (array_2d_p, 1))
+ call test_size (size (array_2d_p, 2))
+
+ deallocate (allocatable_array_1d)
+ deallocate (allocatable_array_2d)
+ array_1d_p => null ()
+ array_2d_p => null ()
+
+ print *, "" ! Final Breakpoint
+ print *, an_integer
+ print *, a_real
+ print *, associated (array_1d_p)
+ print *, associated (array_2d_p)
+ print *, allocated (allocatable_array_1d)
+ print *, allocated (allocatable_array_2d)
+
+contains
+
+ subroutine test_size (answer)
+ integer :: answer
+
+ print *,answer ! Test Breakpoint
+ end subroutine test_size
+
+end program test
--
2.25.4
^ permalink raw reply [flat|nested] 11+ messages in thread
* [PATCHv2 3/3] gdb/fotran: add support for the 'shape' keyword
2021-03-08 16:38 ` [PATCHv2 0/3] Fortran RANK, SIZE, and SHAPE keywords Andrew Burgess
2021-03-08 16:38 ` [PATCHv2 1/3] gdb/fortran: add support for RANK keyword Andrew Burgess
2021-03-08 16:38 ` [PATCHv2 2/3] gdb/fortran: add support for 'SIZE' keyword Andrew Burgess
@ 2021-03-08 16:38 ` Andrew Burgess
2021-03-08 18:55 ` [PATCHv2 0/3] Fortran RANK, SIZE, and SHAPE keywords Tom Tromey
3 siblings, 0 replies; 11+ messages in thread
From: Andrew Burgess @ 2021-03-08 16:38 UTC (permalink / raw)
To: gdb-patches
Add support for the SHAPE keyword to GDB's Fortran expression parser.
gdb/ChangeLog:
* f-exp.h (eval_op_f_array_shape): Declare.
(fortran_array_shape_operation): New type.
* f-exp.y (exp): Handle UNOP_FORTRAN_SHAPE after parsing
UNOP_INTRINSIC.
(f77_keywords): Add "shape" keyword.
* f-lang.c (fortran_array_shape): New function.
(eval_op_f_array_shape): New function.
* std-operator.def (UNOP_FORTRAN_SHAPE): New operator.
gdb/testsuite/ChangeLog:
* gdb.fortran/shape.exp: New file.
* gdb.fortran/shape.f90: New file.
---
gdb/ChangeLog | 11 ++++
gdb/f-exp.h | 12 ++++
gdb/f-exp.y | 4 ++
gdb/f-lang.c | 81 +++++++++++++++++++++++++++
gdb/std-operator.def | 1 +
gdb/testsuite/ChangeLog | 5 ++
gdb/testsuite/gdb.fortran/shape.exp | 86 +++++++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/shape.f90 | 77 ++++++++++++++++++++++++++
8 files changed, 277 insertions(+)
create mode 100644 gdb/testsuite/gdb.fortran/shape.exp
create mode 100644 gdb/testsuite/gdb.fortran/shape.f90
diff --git a/gdb/f-exp.h b/gdb/f-exp.h
index fc46c123c6a..11f19af979f 100644
--- a/gdb/f-exp.h
+++ b/gdb/f-exp.h
@@ -108,6 +108,16 @@ extern struct value *eval_op_f_array_size (struct type *expect_type,
struct value *arg1,
struct value *arg2);
+/* Implement the evaluation of Fortran's SHAPE keyword. EXPECTED_TYPE,
+ EXP, and NOSIDE are as for expression::evaluate (see expression.h). OP
+ will always be UNOP_FORTRAN_SHAPE, and ARG1 is the argument being passed
+ to the expression. */
+
+extern struct value *eval_op_f_array_shape (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside,
+ enum exp_opcode op,
+ struct value *arg1);
namespace expr
{
@@ -135,6 +145,8 @@ using fortran_array_size_1arg = unop_operation<FORTRAN_ARRAY_SIZE,
eval_op_f_array_size>;
using fortran_array_size_2arg = binop_operation<FORTRAN_ARRAY_SIZE,
eval_op_f_array_size>;
+using fortran_array_shape_operation = unop_operation<UNOP_FORTRAN_SHAPE,
+ eval_op_f_array_shape>;
/* The Fortran "complex" operation. */
class fortran_cmplx_operation
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index ed6bd5935af..240393edd48 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -330,6 +330,9 @@ exp : UNOP_INTRINSIC '(' exp ')'
case UNOP_FORTRAN_RANK:
pstate->wrap<fortran_rank_operation> ();
break;
+ case UNOP_FORTRAN_SHAPE:
+ pstate->wrap<fortran_array_shape_operation> ();
+ break;
default:
gdb_assert_not_reached ("unhandled intrinsic");
}
@@ -1151,6 +1154,7 @@ static const struct token f77_keywords[] =
{ "associated", UNOP_OR_BINOP_INTRINSIC, FORTRAN_ASSOCIATED, false },
{ "rank", UNOP_INTRINSIC, UNOP_FORTRAN_RANK, false },
{ "size", UNOP_OR_BINOP_INTRINSIC, FORTRAN_ARRAY_SIZE, false },
+ { "shape", UNOP_INTRINSIC, UNOP_FORTRAN_SHAPE, false },
};
/* Implementation of a dynamically expandable buffer for processing input
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index a33aef31d4f..d79c458c5e0 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -675,6 +675,87 @@ eval_op_f_array_size (struct type *expect_type,
return fortran_array_size (exp->gdbarch, exp->language_defn, arg1, arg2);
}
+/* Implement UNOP_FORTRAN_SHAPE expression. Both GDBARCH and LANG are
+ extracted from the expression being evaluated. VAL is the value on
+ which 'shape' was used, this can be any type.
+
+ Return an array of integers. If VAL is not an array then the returned
+ array should have zero elements. If VAL is an array then the returned
+ array should have one element per dimension, with the element
+ containing the extent of that dimension from VAL. */
+
+static struct value *
+fortran_array_shape (struct gdbarch *gdbarch, const language_defn *lang,
+ struct value *val)
+{
+ struct type *val_type = check_typedef (value_type (val));
+
+ /* If we are passed an array that is either not allocated, or not
+ associated, then this is explicitly not allowed according to the
+ 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"));
+
+ /* The Fortran specification allows non-array types to be passed to this
+ function, in which case we get back an empty array.
+
+ Calculate the number of dimensions for the resulting array. */
+ int ndimensions = 0;
+ if (val_type->code () == TYPE_CODE_ARRAY)
+ ndimensions = calc_f77_array_dims (val_type);
+
+ /* Allocate a result value of the correct type. */
+ struct type *range
+ = 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);
+ struct value *result = allocate_value (result_type);
+ LONGEST elm_len = TYPE_LENGTH (elm_type);
+
+ /* 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.
+
+ 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;
+ dst_offset -= elm_len)
+ {
+ LONGEST lbound, ubound;
+
+ if (!get_discrete_bounds (val_type->index_type (), &lbound, &ubound))
+ error (_("failed to find array bounds"));
+
+ LONGEST dim_size = (ubound - lbound + 1);
+
+ /* And copy the value into the result value. */
+ struct value *v = value_from_longest (elm_type, dim_size);
+ gdb_assert (dst_offset + TYPE_LENGTH (value_type (v))
+ <= TYPE_LENGTH (value_type (result)));
+ gdb_assert (TYPE_LENGTH (value_type (v)) == elm_len);
+ value_contents_copy (result, dst_offset, v, 0, elm_len);
+
+ /* Peel another dimension of the array. */
+ val_type = TYPE_TARGET_TYPE (val_type);
+ }
+
+ return result;
+}
+
+/* See f-exp.h. */
+
+struct value *
+eval_op_f_array_shape (struct type *expect_type, struct expression *exp,
+ enum noside noside, enum exp_opcode opcode,
+ struct value *arg1)
+{
+ gdb_assert (opcode == UNOP_FORTRAN_SHAPE);
+ return fortran_array_shape (exp->gdbarch, exp->language_defn, arg1);
+}
+
/* A helper function for UNOP_ABS. */
struct value *
diff --git a/gdb/std-operator.def b/gdb/std-operator.def
index b67247f7e18..1b8581f319e 100644
--- a/gdb/std-operator.def
+++ b/gdb/std-operator.def
@@ -379,6 +379,7 @@ OP (UNOP_FORTRAN_FLOOR)
OP (UNOP_FORTRAN_CEILING)
OP (UNOP_FORTRAN_ALLOCATED)
OP (UNOP_FORTRAN_RANK)
+OP (UNOP_FORTRAN_SHAPE)
/* Two operand builtins. */
OP (BINOP_FORTRAN_CMPLX)
diff --git a/gdb/testsuite/gdb.fortran/shape.exp b/gdb/testsuite/gdb.fortran/shape.exp
new file mode 100644
index 00000000000..0c41b7b2326
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/shape.exp
@@ -0,0 +1,86 @@
+# Copyright 2021 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/> .
+
+# Testing GDB's implementation of SHAPE keyword.
+
+if {[skip_fortran_tests]} { return -1 }
+
+standard_testfile ".f90"
+load_lib fortran.exp
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \
+ {debug f90}]} {
+ return -1
+}
+
+if ![fortran_runto_main] {
+ untested "could not run to main"
+ return -1
+}
+
+gdb_breakpoint [gdb_get_line_number "Test Breakpoint"]
+gdb_breakpoint [gdb_get_line_number "Final Breakpoint"]
+
+# We place a limit on the number of tests that can be run, just in
+# case something goes wrong, and GDB gets stuck in an loop here.
+set found_final_breakpoint false
+set test_count 0
+while { $test_count < 500 } {
+ with_test_prefix "test $test_count" {
+ incr test_count
+
+ gdb_test_multiple "continue" "continue" {
+ -re -wrap "! Test Breakpoint" {
+ # We can run a test from here.
+ }
+ -re -wrap "! Final Breakpoint" {
+ # We're done with the tests.
+ set found_final_breakpoint true
+ }
+ }
+
+ if ($found_final_breakpoint) {
+ break
+ }
+
+ # First grab the expected answer.
+ set answer [get_valueof "" "answer" "**unknown**"]
+
+ # Now move up a frame and figure out a command for us to run
+ # as a test.
+ set command ""
+ gdb_test_multiple "up" "up" {
+ -re -wrap "\r\n\[0-9\]+\[ \t\]+call test_shape \\((\[^\r\n\]+)\\)" {
+ set command $expect_out(1,string)
+ }
+ }
+
+ gdb_assert { ![string equal $command ""] } "found a command to run"
+
+ set answer [string_to_regexp $answer]
+ gdb_test "p $command" " = $answer"
+ }
+}
+
+# Ensure we reached the final breakpoint. If more tests have been added
+# to the test script, and this starts failing, then the safety 'while'
+# loop above might need to be increased.
+gdb_assert {$found_final_breakpoint} "ran all compiled in tests"
+
+foreach var {array_1d_p array_2d_p allocatable_array_1d \
+ allocatable_array_2d} {
+ gdb_test "p shape ($var)" \
+ "The array passed to SHAPE must be allocated or associated"
+}
diff --git a/gdb/testsuite/gdb.fortran/shape.f90 b/gdb/testsuite/gdb.fortran/shape.f90
new file mode 100644
index 00000000000..1a1b3f06505
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/shape.f90
@@ -0,0 +1,77 @@
+! Copyright 2021 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+!
+! Start of test program.
+!
+program test
+
+ ! Things to perform tests on.
+ integer, target :: array_1d (1:10) = 0
+ integer, target :: array_2d (1:4, 1:3) = 0
+ integer :: an_integer = 0
+ real :: a_real = 0.0
+ integer, pointer :: array_1d_p (:) => null ()
+ integer, pointer :: array_2d_p (:,:) => null ()
+ integer, allocatable :: allocatable_array_1d (:)
+ integer, allocatable :: allocatable_array_2d (:,:)
+
+ call test_shape (shape (array_1d))
+ call test_shape (shape (array_2d))
+ call test_shape (shape (an_integer))
+ call test_shape (shape (a_real))
+
+ call test_shape (shape (array_1d (1:10:2)))
+ call test_shape (shape (array_1d (1:10:3)))
+
+ call test_shape (shape (array_2d (4:1:-1, 3:1:-1)))
+ call test_shape (shape (array_2d (4:1:-1, 1:3:2)))
+
+ allocate (allocatable_array_1d (-10:-5))
+ allocate (allocatable_array_2d (-3:3, 8:12))
+
+ call test_shape (shape (allocatable_array_1d))
+ call test_shape (shape (allocatable_array_2d))
+
+ call test_shape (shape (allocatable_array_2d (-2, 10:12)))
+
+ array_1d_p => array_1d
+ array_2d_p => array_2d
+
+ call test_shape (shape (array_1d_p))
+ call test_shape (shape (array_2d_p))
+
+ deallocate (allocatable_array_1d)
+ deallocate (allocatable_array_2d)
+ array_1d_p => null ()
+ array_2d_p => null ()
+
+ print *, "" ! Final Breakpoint
+ print *, an_integer
+ print *, a_real
+ print *, associated (array_1d_p)
+ print *, associated (array_2d_p)
+ print *, allocated (allocatable_array_1d)
+ print *, allocated (allocatable_array_2d)
+
+contains
+
+ subroutine test_shape (answer)
+ integer, dimension (:) :: answer
+
+ print *,answer ! Test Breakpoint
+ end subroutine test_shape
+
+end program test
--
2.25.4
^ permalink raw reply [flat|nested] 11+ messages in thread
* Re: [PATCHv2 0/3] Fortran RANK, SIZE, and SHAPE keywords
2021-03-08 16:38 ` [PATCHv2 0/3] Fortran RANK, SIZE, and SHAPE keywords Andrew Burgess
` (2 preceding siblings ...)
2021-03-08 16:38 ` [PATCHv2 3/3] gdb/fotran: add support for the 'shape' keyword Andrew Burgess
@ 2021-03-08 18:55 ` Tom Tromey
3 siblings, 0 replies; 11+ messages in thread
From: Tom Tromey @ 2021-03-08 18:55 UTC (permalink / raw)
To: Andrew Burgess; +Cc: gdb-patches
>>>>> "Andrew" == Andrew Burgess <andrew.burgess@embecosm.com> writes:
Andrew> Rebase of the RANK and SIZE patches after the big expression change.
Andrew> I've added an extra patch to handle the SHAPE keyword.
Thank you. I looked through these and they all look good to me.
Tom
^ permalink raw reply [flat|nested] 11+ messages in thread
end of thread, other threads:[~2021-03-08 18:55 UTC | newest]
Thread overview: 11+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-02-25 20:43 [PATCH 0/2] Fortran RANK and SIZE keywords Andrew Burgess
2021-02-25 20:43 ` [PATCH 1/2] gdb/fortran: add support for RANK keyword Andrew Burgess
2021-03-03 20:26 ` Tom Tromey
2021-02-25 20:43 ` [PATCH 2/2] gdb/fortran: add support for 'SIZE' keyword Andrew Burgess
2021-03-03 20:29 ` Tom Tromey
2021-03-04 10:24 ` Andrew Burgess
2021-03-08 16:38 ` [PATCHv2 0/3] Fortran RANK, SIZE, and SHAPE keywords Andrew Burgess
2021-03-08 16:38 ` [PATCHv2 1/3] gdb/fortran: add support for RANK keyword Andrew Burgess
2021-03-08 16:38 ` [PATCHv2 2/3] gdb/fortran: add support for 'SIZE' keyword Andrew Burgess
2021-03-08 16:38 ` [PATCHv2 3/3] gdb/fotran: add support for the 'shape' keyword Andrew Burgess
2021-03-08 18:55 ` [PATCHv2 0/3] Fortran RANK, SIZE, and SHAPE keywords Tom Tromey
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).