gdb/fotran: add support for the 'shape' keyword

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.

3 files changed, 168 insertions, 0 deletions

diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 00a7133..ea1401c 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2021-03-09  Andrew Burgess  <andrew.burgess@embecosm.com>
 
+	* gdb.fortran/shape.exp: New file.
+	* gdb.fortran/shape.f90: New file.
+
+2021-03-09  Andrew Burgess  <andrew.burgess@embecosm.com>
+
 	* gdb.fortran/size.exp: New file.
 	* gdb.fortran/size.f90: New file.
 
diff --git a/gdb/testsuite/gdb.fortran/shape.exp b/gdb/testsuite/gdb.fortran/shape.exp
new file mode 100644
index 0000000..0c41b7b
--- /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 0000000..1a1b3f0
--- /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