* [PATCH v2 6/6] fortran: test cases for subarray strides and slices
2016-02-26 13:11 [PATCH v2 0/6] fortran: multi-dimensional subarrays with strides christoph.t.weinmann
@ 2016-02-26 13:11 ` christoph.t.weinmann
2016-02-26 13:11 ` [PATCH v2 1/6] fortran: allow multi-dimensional subarrays christoph.t.weinmann
` (5 subsequent siblings)
6 siblings, 0 replies; 8+ messages in thread
From: christoph.t.weinmann @ 2016-02-26 13:11 UTC (permalink / raw)
To: jan.kratochvil, gdb-patches; +Cc: christoph.t.weinmann
From: Christoph Weinmann <christoph.t.weinmann@intel.com>
Add test cases for subarray creation with range, literal and
stride value permutations for one, two, and three dimensional
arrays.
2013-12-04 Christoph Weinmann <christoph.t.weinmann@intel.com>
testsuite/gdb.fortran/
* static-arrays.exp: New test.
* static-arrays.f90: New file.
Signed-off-by: Christoph Weinmann <christoph.t.weinmann@intel.com>
---
gdb/testsuite/gdb.fortran/static-arrays.exp | 421 ++++++++++++++++++++++++++++
gdb/testsuite/gdb.fortran/static-arrays.f90 | 55 ++++
2 files changed, 476 insertions(+)
create mode 100644 gdb/testsuite/gdb.fortran/static-arrays.exp
create mode 100644 gdb/testsuite/gdb.fortran/static-arrays.f90
diff --git a/gdb/testsuite/gdb.fortran/static-arrays.exp b/gdb/testsuite/gdb.fortran/static-arrays.exp
new file mode 100644
index 0000000..cc9ecc0
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/static-arrays.exp
@@ -0,0 +1,421 @@
+# Copyright 2015 Free Software Foundation, Inc.
+#
+# Contributed by Intel Corp. <christoph.t.weinmann@intel.com>
+#
+# 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/>.
+
+standard_testfile static-arrays.f90
+
+if { [prepare_for_testing $testfile.exp $testfile $srcfile {debug f90}] } {
+ return -1
+}
+
+if ![runto MAIN__] then {
+ perror "couldn't run to breakpoint MAIN__"
+ continue
+}
+
+gdb_breakpoint [gdb_get_line_number "BP1"]
+gdb_continue_to_breakpoint "BP1" ".*BP1.*"
+
+# Tests subarrays of one dimensional arrays with subrange variations
+gdb_test "print ar1" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \
+ "print ar1."
+gdb_test "print ar1\(4:7\)" "\\$\[0-9\]+ = \\(4, 5, 6, 7\\)" \
+ "print ar1\(4:7\)"
+gdb_test "print ar1\(8:\)" "\\$\[0-9\]+ = \\(8, 9\\).*" \
+ "print ar1\(8:\)"
+gdb_test "print ar1\(:3\)" "\\$\[0-9\]+ = \\(1, 2, 3\\).*" \
+ "print ar1\(:3\)"
+gdb_test "print ar1\(:\)" "\\$\[0-9\]+ = \\(1, 2, 3, 4, 5, 6, 7, 8, 9\\)" \
+ "print ar1\(:\)"
+
+# Check assignment
+gdb_test_no_output "set \$my_ary = ar1\(3:8\)"
+gdb_test "print \$my_ary" \
+ "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \
+ "Assignment of subarray to variable"
+gdb_test_no_output "set ar1\(5\) = 42"
+ gdb_test "print ar1\(3:8\)" \
+ "\\$\[0-9\]+ = \\(3, 4, 42, 6, 7, 8\\)" \
+ "print ar1\(3:8\) after assignment"
+gdb_test "print \$my_ary" \
+ "\\$\[0-9\]+ = \\(3, 4, 5, 6, 7, 8\\)" \
+ "Assignment of subarray to variable after original array changed"
+
+# Test for subarrays of one dimensional arrays with literals
+ gdb_test "print ar1\(3\)" "\\$\[0-9\]+ = 3" \
+ "print ar1\(3\)"
+
+# Tests for subranges of 2 dimensional arrays with subrange variations
+gdb_test "print ar2\(2:3, 3:4\)" \
+ "\\$\[0-9\]+ = \\(\\( 23, 33\\) \\( 24, 34\\) \\)" \
+ "print ar2\(2:3, 3:4\)."
+gdb_test "print ar2\(8:9,8:\)" \
+ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \
+ "print ar2\(8:9,8:\)"
+gdb_test "print ar2\(8:9,:2\)" \
+ "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \
+ "print ar2\(8:9,:2\)"
+
+gdb_test "print ar2\(8:,8:9\)" \
+ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \
+ "print ar2\(8:,8:9\)"
+gdb_test "print ar2\(8:,8:\)" \
+ "\\$\[0-9\]+ = \\(\\( 88, 98\\) \\( 89, 99\\) \\)" \
+ "print ar2\(8:,8:\)"
+gdb_test "print ar2\(8:,:2\)" \
+ "\\$\[0-9\]+ = \\(\\( 81, 91\\) \\( 82, 92\\) \\)" \
+ "print ar2\(8:,:2\)"
+
+gdb_test "print ar2\(:2,2:3\)" \
+ "\\$\[0-9\]+ = \\(\\( 12, 22\\) \\( 13, 23\\) \\)" \
+ "print ar2\(:2,2:3\)"
+gdb_test "print ar2\(:2,8:\)" \
+ "\\$\[0-9\]+ = \\(\\( 18, 28\\) \\( 19, 29\\) \\)" \
+ "print ar2\(:2,8:\)"
+gdb_test "print ar2\(:2,:2\)" \
+ "\\$\[0-9\]+ = \\(\\( 11, 21\\) \\( 12, 22\\) \\)" \
+ "print ar2\(:2,:2\)"
+
+# Test subranges of 2 dimensional arrays with literals and subrange variations
+gdb_test "print ar2\(7, 3:6\)" \
+ "\\$\[0-9\]+ = \\(73, 74, 75, 76\\)" \
+ "print ar2\(7, 3:6\)"
+gdb_test "print ar2\(7,8:\)" \
+ "\\$\[0-9\]+ = \\(78, 79\\)" \
+ "print ar2\(7,8:\)"
+gdb_test "print ar2\(7,:2\)" \
+ "\\$\[0-9\]+ = \\(71, 72\\)" \
+ "print ar2\(7,:2\)"
+
+gdb_test "print ar2\(7:8,4\)" \
+ "\\$\[0-9\]+ = \\(74, 84\\)" \
+ "print ar2(7:8,4\)"
+gdb_test "print ar2\(8:,4\)" \
+ "\\$\[0-9\]+ = \\(84, 94\\)" \
+ "print ar2\(8:,4\)"
+gdb_test "print ar2\(:2,4\)" \
+ "\\$\[0-9\]+ = \\(14, 24\\)" \
+ "print ar2\(:2,4\)"
+gdb_test "print ar2\(3,4\)" \
+ "\\$\[0-9\]+ = 34" \
+ "print ar2\(3,4\)"
+
+# Test subarrays of 3 dimensional arrays with literals and subrange variations
+gdb_test "print ar3\(2:4,3:4,7:8\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 237, 337, 437\\) \\( 247, 347, 447\\)\
+ \\) \\( \\( 238, 338, 438\\) \\( 248, 348, 448\\) \\) \\)" \
+ "print ar3\(2:4,3:4,7:8\)"
+gdb_test "print ar3\(2:3,4:5,8:\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 248, 348\\) \\( 258, 358\\) \\) \\(\
+ \\( 249, 349\\) \\( 259, 359\\) \\) \\)" \
+ "print ar3\(2:3,4:5,8:\)"
+gdb_test "print ar3\(2:3,4:5,:2\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 241, 341\\) \\( 251, 351\\) \\) \\(\
+ \\( 242, 342\\) \\( 252, 352\\) \\) \\)" \
+ "print ar3\(2:3,4:5,:2\)"
+
+gdb_test "print ar3\(2:3,8:,7:8\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 287, 387\\) \\( 297, 397\\) \\) \\(\
+ \\( 288, 388\\) \\( 298, 398\\) \\) \\)" \
+ "print ar3\(2:3,8:,7:8\)"
+gdb_test "print ar3\(2:3,8:,8:\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 288, 388\\) \\( 298, 398\\) \\) \\(\
+ \\( 289, 389\\) \\( 299, 399\\) \\) \\)" \
+ "print ar3\(2:3,8:,8:\)"
+gdb_test "print ar3\(2:3,8:,:2\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 281, 381\\) \\( 291, 391\\) \\) \\(\
+ \\( 282, 382\\) \\( 292, 392\\) \\) \\)" \
+ "print ar3\(2:3,8:,:2\)"
+
+gdb_test "print ar3\(2:3,:2,7:8\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 217, 317\\) \\( 227, 327\\) \\) \\(\
+ \\( 218, 318\\) \\( 228, 328\\) \\) \\)" \
+ "print ar3\(2:3,:2,7:8\)"
+gdb_test "print ar3\(2:3,:2,8:\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 218, 318\\) \\( 228, 328\\) \\) \\(\
+ \\( 219, 319\\) \\( 229, 329\\) \\) \\)" \
+ "print ar3\(2:3,:2,8:\)"
+gdb_test "print ar3\(2:3,:2,:2\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 211, 311\\) \\( 221, 321\\) \\) \\(\
+ \\( 212, 312\\) \\( 222, 322\\) \\) \\)" \
+ "print ar3\(2:3,:2,:2\)"
+
+gdb_test "print ar3\(8:,3:4,7:8\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 837, 937\\) \\( 847, 947\\) \\) \\(\
+ \\( 838, 938\\) \\( 848, 948\\) \\) \\)" \
+ "print ar3\(8:,3:4,7:8\)"
+gdb_test "print ar3\(8:,4:5,8:\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 848, 948\\) \\( 858, 958\\) \\) \\(\
+ \\( 849, 949\\) \\( 859, 959\\) \\) \\)" \
+ "print ar3\(8:,4:5,8:\)"
+gdb_test "print ar3\(8:,4:5,:2\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 841, 941\\) \\( 851, 951\\) \\) \\(\
+ \\( 842, 942\\) \\( 852, 952\\) \\) \\)" \
+ "print ar3\(8:,4:5,:2\)"
+
+gdb_test "print ar3\(8:,8:,7:8\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 887, 987\\) \\( 897, 997\\) \\) \\(\
+ \\( 888, 988\\) \\( 898, 998\\) \\) \\)" \
+ "print ar3\(8:,8:,7:8\)"
+gdb_test "print ar3\(8:,8:,8:\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 888, 988\\) \\( 898, 998\\) \\) \\(\
+ \\( 889, 989\\) \\( 899, 999\\) \\) \\)" \
+ "print ar3\(8:,8:,8:\)"
+gdb_test "print ar3\(8:,8:,:2\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 881, 981\\) \\( 891, 991\\) \\) \\(\
+ \\( 882, 982\\) \\( 892, 992\\) \\) \\)" \
+ "print ar3\(8:,8:,:2\)"
+
+gdb_test "print ar3\(8:,:2,7:8\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 817, 917\\) \\( 827, 927\\) \\) \\(\
+ \\( 818, 918\\) \\( 828, 928\\) \\) \\)" \
+ "print ar3\(8:,:2,7:8\)"
+gdb_test "print ar3\(8:,:2,8:\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 818, 918\\) \\( 828, 928\\) \\) \\(\
+ \\( 819, 919\\) \\( 829, 929\\) \\) \\)" \
+ "print ar3\(8:,:2,8:\)"
+gdb_test "print ar3\(8:,:2,:2\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 811, 911\\) \\( 821, 921\\) \\) \\(\
+ \\( 812, 912\\) \\( 822, 922\\) \\) \\)" \
+ "print ar3\(8:,:2,:2\)"
+
+
+gdb_test "print ar3\(:2,3:4,7:8\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 137, 237\\) \\( 147, 247\\) \\) \\(\
+ \\( 138, 238\\) \\( 148, 248\\) \\) \\)" \
+ "print ar3 \(:2,3:4,7:8\)."
+gdb_test "print ar3\(:2,3:4,8:\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 138, 238\\) \\( 148, 248\\) \\) \\(\
+ \\( 139, 239\\) \\( 149, 249\\) \\) \\)" \
+ "print ar3\(:2,3:4,8:\)"
+gdb_test "print ar3\(:2,3:4,:2\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 131, 231\\) \\( 141, 241\\) \\) \\(\
+ \\( 132, 232\\) \\( 142, 242\\) \\) \\)" \
+ "print ar3\(:2,3:4,:2\)"
+
+gdb_test "print ar3\(:2,8:,7:8\)" "\\$\[0-9\]+ = \\(\\( \\( 187, 287\\) \\(\
+ 197, 297\\) \\) \\( \\( 188, 288\\) \\( 198, 298\\) \\) \\)" \
+ "print ar3\(:2,8:,7:8\)"
+gdb_test "print ar3\(:2,8:,8:\)" "\\$\[0-9\]+ = \\(\\( \\( 188, 288\\) \\( 198,\
+ 298\\) \\) \\( \\( 189, 289\\) \\( 199, 299\\) \\) \\)" \
+ "print ar3\(:2,8:,8:\)"
+gdb_test "print ar3\(:2,8:,:2\)" "\\$\[0-9\]+ = \\(\\( \\( 181, 281\\) \\( 191,\
+ 291\\) \\) \\( \\( 182, 282\\) \\( 192, 292\\) \\) \\)" \
+ "print ar3\(:2,8:,:2\)"
+
+gdb_test "print ar3\(:2,:2,7:8\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 117, 217\\) \\( 127, 227\\) \\) \\(\
+ \\( 118, 218\\) \\( 128, 228\\) \\) \\)" \
+ "print ar3\(:2,:2,7:8\)"
+gdb_test "print ar3\(:2,:2,8:\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 118, 218\\) \\( 128, 228\\) \\) \\(\
+ \\( 119, 219\\) \\( 129, 229\\) \\) \\)" \
+ "print ar3\(:2,:2,8:\)"
+gdb_test "print ar3\(:2,:2,:2\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 111, 211\\) \\( 121, 221\\) \\) \\(\
+ \\( 112, 212\\) \\( 122, 222\\) \\) \\)" \
+ "print ar3\(:2,:2,:2\)"
+
+#Tests for subarrays of 3 dimensional arrays with literals and subranges
+gdb_test "print ar3\(3,3:4,7:8\)" \
+ "\\$\[0-9\]+ = \\(\\( 337, 347\\) \\( 338, 348\\) \\)" \
+ "print ar3\(3,3:4,7:8\)"
+gdb_test "print ar3\(3,4:5,8:\)" \
+ "\\$\[0-9\]+ = \\(\\( 348, 358\\) \\( 349, 359\\) \\)" \
+ "print ar3\(3,4:5,8:\)"
+gdb_test "print ar3\(3,4:5,:2\)" \
+ "\\$\[0-9\]+ = \\(\\( 341, 351\\) \\( 342, 352\\) \\)" \
+ "print ar3\(3,4:5,:2\)"
+gdb_test "print ar3\(3,4:5,3\)" \
+ "\\$\[0-9\]+ = \\(343, 353\\)" \
+ "print ar3\(3,4:5,3\)"
+
+gdb_test "print ar3\(2,8:,7:8\)" \
+ "\\$\[0-9\]+ = \\(\\( 287, 297\\) \\( 288, 298\\) \\)" \
+ "print ar3\(2,8:,7:8\)"
+gdb_test "print ar3\(2,8:,8:\)" \
+ "\\$\[0-9\]+ = \\(\\( 288, 298\\) \\( 289, 299\\) \\)" \
+ "print ar3\(2,8:,8:\)"
+gdb_test "print ar3\(2,8:,:2\)"\
+ "\\$\[0-9\]+ = \\(\\( 281, 291\\) \\( 282, 292\\) \\)" \
+ "print ar3\(2,8:,:2\)"
+gdb_test "print ar3\(2,8:,3\)" \
+ "\\$\[0-9\]+ = \\(283, 293\\)" \
+ "print ar3\(2,8:,3\)"
+
+gdb_test "print ar3\(2,:2,7:8\)" \
+ "\\$\[0-9\]+ = \\(\\( 217, 227\\) \\( 218, 228\\) \\)" \
+ "print ar3\(2,:2,7:8\)"
+gdb_test "print ar3\(2,:2,8:\)" \
+ "\\$\[0-9\]+ = \\(\\( 218, 228\\) \\( 219, 229\\) \\)" \
+ "print ar3\(2,:2,8:\)"
+gdb_test "print ar3\(2,:2,:2\)" \
+ "\\$\[0-9\]+ = \\(\\( 211, 221\\) \\( 212, 222\\) \\)" \
+ "print ar3\(2,:2,:2\)"
+gdb_test "print ar3\(2,:2,3\)" \
+ "\\$\[0-9\]+ = \\(213, 223\\)" \
+ "print ar3\(2,:2,3\)"
+
+gdb_test "print ar3\(3,4,7:8\)" \
+ "\\$\[0-9\]+ = \\(347, 348\\)" \
+ "print ar3\(3,4,7:8\)"
+gdb_test "print ar3\(3,4,8:\)" \
+ "\\$\[0-9\]+ = \\(348, 349\\)" \
+i "print ar3\(3,4,8:\)"
+gdb_test "print ar3\(3,4,:2\)" \
+ "\\$\[0-9\]+ = \\(341, 342\\)" \
+ "print ar3\(3,4,:2\)"
+gdb_test "print ar3\(5,6,7\)" \
+ "\\$\[0-9\]+ = 567" \
+ "print ar3\(5,6,7\)"
+
+gdb_test "print ar3\(3:4,6,7:8\)" \
+ "\\$\[0-9\]+ = \\(\\( 367, 467\\) \\( 368, 468\\) \\)" \
+ "print ar3\(3:4,6,7:8\)"
+gdb_test "print ar3\(3:4,6,8:\)" \
+ "\\$\[0-9\]+ = \\(\\( 368, 468\\) \\( 369, 469\\) \\)" \
+ "print ar3\(3:4,6,8:\)"
+gdb_test "print ar3\(3:4,6,:2\)" \
+ "\\$\[0-9\]+ = \\(\\( 361, 461\\) \\( 362, 462\\) \\)" \
+ "print ar3\(3:4,6,:2\)"
+gdb_test "print ar3\(3:4,6,5\)" \
+ "\\$\[0-9\]+ = \\(365, 465\\)" \
+ "print ar3\(3:4,6,5\)"
+
+gdb_test "print ar3\(8:,6,7:8\)" \
+ "\\$\[0-9\]+ = \\(\\( 867, 967\\) \\( 868, 968\\) \\)" \
+ "print ar3\(8:,6,7:8\)"
+gdb_test "print ar3\(8:,6,8:\)" \
+ "\\$\[0-9\]+ = \\(\\( 868, 968\\) \\( 869, 969\\) \\)" \
+ "print ar3\(8:,6,8:\)"
+gdb_test "print ar3\(8:,6,:2\)" \
+ "\\$\[0-9\]+ = \\(\\( 861, 961\\) \\( 862, 962\\) \\)" \
+ "print ar3\(8:,6,:2\)"
+gdb_test "print ar3\(8:,6,5\)" \
+ "\\$\[0-9\]+ = \\(865, 965\\)" \
+ "print ar3\(8:,6,5\)"
+
+gdb_test "print ar3\(:2,6,7:8\)" \
+ "\\$\[0-9\]+ = \\(\\( 167, 267\\) \\( 168, 268\\) \\)" \
+ "print ar3\(:2,6,7:8\)"
+gdb_test "print ar3\(:2,6,8:\)" \
+ "\\$\[0-9\]+ = \\(\\( 168, 268\\) \\( 169, 269\\) \\)" \
+ "print ar3\(:2,6,8:\)"
+gdb_test "print ar3\(:2,6,:2\)" \
+ "\\$\[0-9\]+ = \\(\\( 161, 261\\) \\( 162, 262\\) \\)" \
+ "print ar3\(:2,6,:2\)"
+gdb_test "print ar3\(:2,6,5\)" \
+ "\\$\[0-9\]+ = \\(165, 265\\)" \
+ "print ar3\(:2,6,5\)"
+
+gdb_test "print ar3\(3:4,5:6,4\)" \
+ "\\$\[0-9\]+ = \\(\\( 354, 454\\) \\( 364, 464\\) \\)" \
+ "print ar2\(3:4,5:6,4\)"
+gdb_test "print ar3\(8:,5:6,4\)" \
+ "\\$\[0-9\]+ = \\(\\( 854, 954\\) \\( 864, 964\\) \\)" \
+ "print ar2\(8:,5:6,4\)"
+gdb_test "print ar3\(:2,5:6,4\)" \
+ "\\$\[0-9\]+ = \\(\\( 154, 254\\) \\( 164, 264\\) \\)" \
+ "print ar2\(:2,5:6,4\)"
+
+# Stride > 1
+gdb_test "print ar1\(2:6:2\)" \
+ "\\$\[0-9\]+ = \\(2, 4, 6\\)" \
+ "print ar1\(2:6:2\)"
+gdb_test "print ar2\(2:6:2,3:4\)" \
+ "\\$\[0-9\]+ = \\(\\( 23, 43, 63\\) \\( 24, 44, 64\\) \\)" \
+ "print ar2\(2:6:2,3:4\)"
+gdb_test "print ar2\(2:6:2,3\)" \
+ "\\$\[0-9\]+ = \\(23, 43, 63\\)" \
+ "print ar2\(2:6:2,3\)"
+gdb_test "print ar3\(2:6:2,3:5:2,4:7:3\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 234, 434, 634\\) \\( 254, 454, 654\\)\
+ \\) \\( \\( 237, 437, 637\\) \\( 257, 457, 657\\) \\) \\)" \
+ "print ar3\(2:6:2,3:5:2,4:7:3\)"
+gdb_test "print ar3\(2:6:2,5,4:7:3\)" \
+ "\\$\[0-9\]+ = \\(\\( 254, 454, 654\\) \\( 257, 457, 657\\)\
+ \\)" \
+ "print ar3\(2:6:2,5,4:7:3\)"
+
+# Stride < 0
+gdb_test "print ar1\(8:2:-2\)" \
+ "\\$\[0-9\]+ = \\(8, 6, 4, 2\\)" \
+ "print ar1\(8:2:-2\)"
+gdb_test "print ar2\(8:2:-2,3:4\)" \
+ "\\$\[0-9\]+ = \\(\\( 83, 63, 43, 23\\) \\( 84, 64, 44, 24\\)\
+ \\)" \
+ "print ar2\(8:2:-2,3:4\)"
+gdb_test "print ar2\(2:6:2,3\)" \
+ "\\$\[0-9\]+ = \\(23, 43, 63\\)" \
+ "print ar2\(2:6:2,3\)"
+gdb_test "print ar3\(2:3,7:3:-4,4:7:3\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 274, 374\\) \\( 234, 334\\) \\) \\(\
+ \\( 277, 377\\) \\( 237, 337\\) \\) \\)" \
+ "print ar3\(2:3,7:3:-4,4:7:3\)"
+gdb_test "print ar3\(2:6:2,5,7:4:-3\)" \
+ "\\$\[0-9\]+ = \\(\\( 257, 457, 657\\) \\( 254, 454, 654\\)\
+ \\)" \
+ "print ar3\(2:6:2,5,7:4:-3\)"
+
+# Tests with negative and mixed indices
+gdb_test "p ar4\(2:4, -2:1, -15:-14\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 261, 361, 461\\) \\( 271, 371, 471\\)\
+ \\( 281, 381, 481\\) \\( 291, 391, 491\\) \\) \\( \\( 262,\
+ 362, 462\\) \\( 272, 372, 472\\) \\( 282, 382, 482\\) \\( 292,\
+ 392, 492\\) \\) \\)" \
+ "print ar4(2:4, -2:1, -15:-14)"
+
+gdb_test "p ar4\(7,-6:2:3,-7\)" \
+ "\\$\[0-9\]+ = \\(729, 759, 789\\)" \
+ "print ar4(7,-6:2:3,-7)"
+
+gdb_test "p ar4\(9:2:-2, -6:2:3, -6:-15:-3\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 930, 730, 530, 330\\) \\( 960, 760,\
+ 560, 360\\) \\( 990, 790, 590, 390\\) \\) \\( \\( 927, 727,\
+ 527, 327\\) \\( 957, 757, 557, 357\\) \\( 987, 787, 587,\
+ 387\\) \\) \\( \\( 924, 724, 524, 324\\) \\( 954, 754, 554,\
+ 354\\) \\( 984, 784, 584, 384\\) \\) \\( \\( 921, 721, 521,\
+ 321\\) \\( 951, 751, 551, 351\\) \\( 981, 781, 581, 381\\) \\)\
+ \\)" \
+ "print ar4(9:2:-2, -6:2:3, -6:-15:-3)"
+
+gdb_test "p ar4\(:,:,:\)" \
+ "\\$\[0-9\]+ = \\(\\( \\( 111, 211, 311, 411, 511, 611, 711,\
+ 811, .*" \
+ "print ar4(:,:,:)"
+
+# Provoke error messages for bad user input
+gdb_test "print ar1\(0:4\)" \
+ "provided bound\\(s\\) outside array bound\\(s\\)" \
+ "print ar1\(0:4\)"
+gdb_test "print ar1\(8:12\)" \
+ "provided bound\\(s\\) outside array bound\\(s\\)" \
+ "print ar1\(8:12\)"
+gdb_test "print ar1\(8:2:\)" \
+ "A syntax error in expression, near `\\)'." \
+ "print ar1\(8:2:\)"
+gdb_test "print ar1\(8:2:2\)" \
+ "Wrong value provided for stride and boundaries" \
+ "print ar1\(8:2:2\)"
+gdb_test "print ar1\(2:8:-2\)" \
+ "Wrong value provided for stride and boundaries" \
+ "print ar1\(2:8:-2\)"
+gdb_test "print ar1\(2:7:0\)" \
+ "Stride must not be 0" \
+ "print ar1\(2:7:0\)"
+gdb_test "print ar1\(3:7\) = 42" \
+ "Invalid cast." \
+ "Assignment of value to subarray"
diff --git a/gdb/testsuite/gdb.fortran/static-arrays.f90 b/gdb/testsuite/gdb.fortran/static-arrays.f90
new file mode 100644
index 0000000..f22fcbe
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/static-arrays.f90
@@ -0,0 +1,55 @@
+! Copyright 2015 Free Software Foundation, Inc.
+!
+! Contributed by Intel Corp. <christoph.t.weinmann@intel.com>
+!
+! 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/>.
+
+subroutine sub
+ integer, dimension(9) :: ar1
+ integer, dimension(9,9) :: ar2
+ integer, dimension(9,9,9) :: ar3
+ integer, dimension(10,-7:3, -15:-5) :: ar4
+ integer :: i,j,k
+
+ ar1 = 1
+ ar2 = 1
+ ar3 = 1
+ ar4 = 4
+
+ ! Resulting array ar3 looks like ((( 111, 112, 113, 114,...)))
+ do i = 1, 9, 1
+ ar1(i) = i
+ do j = 1, 9, 1
+ ar2(i,j) = i*10 + j
+ do k = 1, 9, 1
+ ar3(i,j,k) = i*100 + j*10 + k
+ end do
+ end do
+ end do
+
+ do i = 1, 10, 1
+ do j = -7, 3, 1
+ do k = -15, -5, 1
+ ar4(i,j,k) = i*100 + (j+8)*10 + (k+16)
+ end do
+ end do
+ end do
+
+ ar1(1) = 11 !BP1
+ return
+end
+
+program testprog
+ call sub
+end
--
2.5.0
^ permalink raw reply [flat|nested] 8+ messages in thread* [PATCH v2 1/6] fortran: allow multi-dimensional subarrays
2016-02-26 13:11 [PATCH v2 0/6] fortran: multi-dimensional subarrays with strides christoph.t.weinmann
2016-02-26 13:11 ` [PATCH v2 6/6] fortran: test cases for subarray strides and slices christoph.t.weinmann
@ 2016-02-26 13:11 ` christoph.t.weinmann
2016-02-26 13:11 ` [PATCH v2 5/6] fortran: calculate subarray with stride values christoph.t.weinmann
` (4 subsequent siblings)
6 siblings, 0 replies; 8+ messages in thread
From: christoph.t.weinmann @ 2016-02-26 13:11 UTC (permalink / raw)
To: jan.kratochvil, gdb-patches; +Cc: christoph.t.weinmann
From: Christoph Weinmann <christoph.t.weinmann@intel.com>
Add an argument count for subrange expressions in Fortran.
Based on the counted value calculate a new array with the
elements specified by the user. First parse the user input,
secondly copy the desired array values into the return
array, thirdly re-create the necessary ranges and bounds.
1| program prog
2| integer :: ary(10,5) = (/ (i,i=1,10) (j, j=1,5) /)
3| end program prog
(gdb) print ary(2:4,1:3)
old> Syntax error in expression near ':3'
new> $3 = ( ( 21, 31, 41) ( 22, 32, 42) ( 23, 33, 43) )
2013-11-25 Christoph Weinmann <christoph.t.weinmann@intel.com>
* eval.c (multi_f77_subscript): Remove function.
* eval.c (evaluate_subrange_expr): When evaluating
an array or string expression, call
value_f90_subarray.
* eval.c (value_f90_subarray): Add argument parsing
and compute result array based on user input.
* f-exp.y: Increment argument counter for every subrange
expression entered by the user.
* valops.c (value_slice): Call value_slice_1 with
additional default argument.
* valops.c (value_slice_1): Add functionality to
copy and return result values based on input.
* value.h: Add function definition.
Signed-off-by: Christoph Weinmann <christoph.t.weinmann@intel.com>
---
gdb/eval.c | 309 ++++++++++++++++++++++++++++++++++++++++++++++-------------
gdb/f-exp.y | 2 +
gdb/valops.c | 157 ++++++++++++++++++++++++------
gdb/value.h | 2 +
4 files changed, 375 insertions(+), 95 deletions(-)
diff --git a/gdb/eval.c b/gdb/eval.c
index 78ad946..c9f325f 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -399,29 +399,253 @@ init_array_element (struct value *array, struct value *element,
return index;
}
+/* Evaluates any operation on Fortran arrays or strings with at least
+ one user provided parameter. Expects the input ARRAY to be either
+ an array, or a string. Evaluates EXP by incrementing POS, and
+ writes the content from the elt stack into a local struct. NARGS
+ specifies number of literal or range arguments the user provided.
+ NARGS must be the same number as ARRAY has dimensions. */
+
static struct value *
-value_f90_subarray (struct value *array,
- struct expression *exp, int *pos, enum noside noside)
+value_f90_subarray (struct value *array, struct expression *exp,
+ int *pos, int nargs, enum noside noside)
{
- int pc = (*pos) + 1;
+ int i, dim_count = 0;
LONGEST low_bound, high_bound;
struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array)));
- enum f90_range_type range_type
- = (enum f90_range_type) longest_to_int (exp->elts[pc].longconst);
-
- *pos += 3;
+ struct value *new_array = array;
+ struct type *array_type = check_typedef (value_type (new_array));
+ struct type *temp_type;
+
+ /* Local struct to hold user data for Fortran subarray dimensions. */
+ struct subscript_store
+ {
+ /* For every dimension, we are either working on a range or an index
+ expression, so we store this info separately for later. */
+ enum
+ {
+ SUBSCRIPT_RANGE, /* e.g. "(lowbound:highbound)" */
+ SUBSCRIPT_INDEX /* e.g. "(literal)" */
+ } kind;
+
+ /* We also store either the lower and upper bound info, or the index
+ number. Before evaluation of the input values, we do not know if we are
+ actually working on a range of ranges, or an index in a range. So as a
+ first step we store all input in a union. The array calculation itself
+ deals with this later on. */
+ union
+ {
+ struct subscript_range
+ {
+ enum f90_range_type f90_range_type;
+ LONGEST low, high;
+ }
+ range;
+ LONGEST number;
+ };
+ } *subscript_array;
+
+ /* Check if the number of arguments provided by the user matches
+ the number of dimension of the array. A string has only one
+ dimension. */
+ if (nargs != calc_f77_array_dims (value_type (new_array)))
+ error (_("Wrong number of subscripts"));
+
+ subscript_array = alloca (sizeof (*subscript_array) * nargs);
+
+ /* Parse the user input into the SUBSCRIPT_ARRAY to store it. We need
+ to evaluate it first, as the input is from left-to-right. The
+ array is stored from right-to-left. So we have to use the user
+ input in reverse order. Later on, we need the input information to
+ re-calculate the output array. For multi-dimensional arrays, we
+ can be dealing with any possible combination of ranges and indices
+ for every dimension. */
+ for (i = 0; i < nargs; i++)
+ {
+ struct subscript_store *index = &subscript_array[i];
- if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
- low_bound = TYPE_LOW_BOUND (range);
- else
- low_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ /* The user input is a range, with or without lower and upper bound.
+ E.g.: "p arry(2:5)", "p arry( :5)", "p arry( : )", etc. */
+ if (exp->elts[*pos].opcode == OP_F90_RANGE)
+ {
+ int pc = (*pos) + 1;
+ struct subscript_range *range;
+
+ index->kind = SUBSCRIPT_RANGE;
+ range = &index->range;
+
+ *pos += 3;
+ range->f90_range_type = longest_to_int (exp->elts[pc].longconst);
+
+ /* If a lower bound was provided by the user, the bit has been
+ set and we can assign the value from the elt stack. Same for
+ upper bound. */
+ if ((range->f90_range_type == HIGH_BOUND_DEFAULT)
+ || range->f90_range_type == NONE_BOUND_DEFAULT)
+ range->low = value_as_long (evaluate_subexp (NULL_TYPE, exp,
+ pos, noside));
+ if ((range->f90_range_type == LOW_BOUND_DEFAULT)
+ || range->f90_range_type == NONE_BOUND_DEFAULT)
+ range->high = value_as_long (evaluate_subexp (NULL_TYPE, exp,
+ pos, noside));
+ }
+ /* User input is an index. E.g.: "p arry(5)". */
+ else
+ {
+ struct value *val;
- if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT)
- high_bound = TYPE_HIGH_BOUND (range);
- else
- high_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ index->kind = SUBSCRIPT_INDEX;
+
+ /* Evaluate each subscript; it must be a legal integer in F77. This
+ ensures the validity of the provided index. */
+ val = evaluate_subexp_with_coercion (exp, pos, noside);
+ index->number = value_as_long (val);
+ }
+
+ }
+
+ /* Traverse the array from right to left and evaluate each corresponding
+ user input. VALUE_SUBSCRIPT is called for every index, until a range
+ expression is evaluated. After a range expression has been evaluated,
+ every subsequent expression is also treated as a range. */
+ for (i = nargs - 1; i >= 0; i--)
+ {
+ struct subscript_store *index = &subscript_array[i];
+ struct type *index_type = TYPE_INDEX_TYPE (array_type);
+
+ switch (index->kind)
+ {
+ case SUBSCRIPT_RANGE:
+ {
+
+ /* When we hit the first range specified by the user, we must
+ treat any subsequent user entry as a range. We simply
+ increment DIM_COUNT which tells us how many times we are
+ calling VALUE_SLICE_1. */
+ struct subscript_range *range = &index->range;
+
+ /* If no lower bound was provided by the user, we take the
+ default boundary. Same for the high bound. */
+ if ((range->f90_range_type == LOW_BOUND_DEFAULT)
+ || (range->f90_range_type == BOTH_BOUND_DEFAULT))
+ range->low = TYPE_LOW_BOUND (index_type);
+
+ if ((range->f90_range_type == HIGH_BOUND_DEFAULT)
+ || (range->f90_range_type == BOTH_BOUND_DEFAULT))
+ range->high = TYPE_HIGH_BOUND (index_type);
+
+ /* Both user provided low and high bound have to be inside the
+ array bounds. Throw an error if not. */
+ if (range->low < TYPE_LOW_BOUND (index_type)
+ || range->low > TYPE_HIGH_BOUND (index_type)
+ || range->high < TYPE_LOW_BOUND (index_type)
+ || range->high > TYPE_HIGH_BOUND (index_type))
+ error (_("provided bound(s) outside array bound(s)"));
+
+ /* DIM_COUNT counts every user argument that is treated as a range.
+ This is necessary for expressions like 'print array(7, 8:9).
+ Here the first argument is a literal, but must be treated as a
+ range argument to allow the correct output representation. */
+ dim_count++;
+
+ new_array
+ = value_slice_1 (new_array,
+ longest_to_int (range->low),
+ longest_to_int (range->high - range->low + 1),
+ dim_count);
+ }
+ break;
+
+ case SUBSCRIPT_INDEX:
+ {
+ /* DIM_COUNT only stays '0' when no range argument was processed
+ before, starting from the last dimension. This way we can
+ reduce the number of dimensions from the result array.
+ However, if a range has been processed before an index, we
+ treat the index like a range with equal low- and high bounds
+ to get the value offset right. */
+ if (dim_count == 0)
+ new_array
+ = value_subscripted_rvalue (new_array, index->number,
+ f77_get_lowerbound (value_type
+ (new_array)));
+ else
+ {
+ /* Check for valid index input. */
+ if (index->number < TYPE_LOW_BOUND (index_type)
+ || index->number > TYPE_HIGH_BOUND (index_type))
+ error (_("error no such vector element"));
+
+ dim_count++;
+ new_array = value_slice_1 (new_array,
+ longest_to_int (index->number),
+ 1, /* length is '1' element */
+ dim_count);
+ }
+
+ }
+ break;
+ }
+ }
+
+ /* With DIM_COUNT > 1 we currently have a one dimensional array, but expect
+ an array of arrays, depending on how many ranges have been provided by
+ the user. So we need to rebuild the array dimensions for printing it
+ correctly.
+ Starting from right to left in the user input, after we hit the first
+ range argument every subsequent argument is also treated as a range.
+ E.g.:
+ "p ary(3, 7, 2:15)" in Fortran has only 1 dimension, but we calculated 3
+ ranges.
+ "p ary(3, 7:12, 4)" in Fortran has only 1 dimension, but we calculated 2
+ ranges.
+ "p ary(2:4, 5, 7)" in Fortran has only 1 dimension, and we calculated 1
+ range. */
+ if (dim_count > 1)
+ {
+ struct value *v = NULL;
- return value_slice (array, low_bound, high_bound - low_bound + 1);
+ temp_type = TYPE_TARGET_TYPE (value_type (new_array));
+
+ /* Every SUBSCRIPT_RANGE in the user input signifies an actual range in
+ the output array. So we traverse the SUBSCRIPT_ARRAY again, looking
+ for a range entry. When we find one, we use the range info to create
+ an additional range_type to set the correct bounds and dimensions for
+ the output array. */
+ for (i = 0; i < nargs; i++)
+ {
+ struct subscript_store *index = &subscript_array[i];
+
+ if (index->kind == SUBSCRIPT_RANGE)
+ {
+ struct type *range_type, *interim_array_type;
+
+ range_type
+ = create_static_range_type (NULL,
+ temp_type,
+ 1,
+ index->range.high - index->range.low + 1);
+
+ interim_array_type = create_array_type (NULL,
+ temp_type,
+ range_type);
+
+ /* For some reason the type code of the contents is missing, so
+ reset it from the original array. */
+ TYPE_CODE (interim_array_type)
+ = TYPE_CODE (value_type (new_array));
+
+ v = allocate_value (interim_array_type);
+
+ temp_type = value_type (v);
+ }
+
+ }
+ value_contents_copy (v, 0, new_array, 0, TYPE_LENGTH (temp_type));
+ return v;
+ }
+
+ return new_array;
}
@@ -1810,14 +2034,11 @@ evaluate_subexp_standard (struct type *expect_type,
switch (code)
{
case TYPE_CODE_ARRAY:
- if (exp->elts[*pos].opcode == OP_F90_RANGE)
- return value_f90_subarray (arg1, exp, pos, noside);
- else
- goto multi_f77_subscript;
+ return value_f90_subarray (arg1, exp, pos, nargs, noside);
case TYPE_CODE_STRING:
if (exp->elts[*pos].opcode == OP_F90_RANGE)
- return value_f90_subarray (arg1, exp, pos, noside);
+ return value_f90_subarray (arg1, exp, pos, 1, noside);
else
{
arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
@@ -2222,49 +2443,6 @@ evaluate_subexp_standard (struct type *expect_type,
}
return (arg1);
- multi_f77_subscript:
- {
- LONGEST subscript_array[MAX_FORTRAN_DIMS];
- int ndimensions = 1, i;
- struct value *array = arg1;
-
- if (nargs > MAX_FORTRAN_DIMS)
- error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS);
-
- ndimensions = calc_f77_array_dims (type);
-
- if (nargs != ndimensions)
- error (_("Wrong number of subscripts"));
-
- gdb_assert (nargs > 0);
-
- /* Now that we know we have a legal array subscript expression
- let us actually find out where this element exists in the array. */
-
- /* Take array indices left to right. */
- for (i = 0; i < nargs; i++)
- {
- /* Evaluate each subscript; it must be a legal integer in F77. */
- arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
-
- /* Fill in the subscript array. */
-
- subscript_array[i] = value_as_long (arg2);
- }
-
- /* Internal type of array is arranged right to left. */
- for (i = nargs; i > 0; i--)
- {
- struct type *array_type = check_typedef (value_type (array));
- LONGEST index = subscript_array[i - 1];
-
- array = value_subscripted_rvalue (array, index,
- f77_get_lowerbound (array_type));
- }
-
- return array;
- }
-
case BINOP_LOGICAL_AND:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
@@ -3121,6 +3299,9 @@ calc_f77_array_dims (struct type *array_type)
int ndimen = 1;
struct type *tmp_type;
+ if (TYPE_CODE (array_type) == TYPE_CODE_STRING)
+ return 1;
+
if ((TYPE_CODE (array_type) != TYPE_CODE_ARRAY))
error (_("Can't get dimensions for a non-array type"));
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 4faac32..9343abb 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -308,6 +308,8 @@ arglist : subrange
arglist : arglist ',' exp %prec ABOVE_COMMA
{ arglist_len++; }
+ | arglist ',' subrange %prec ABOVE_COMMA
+ { arglist_len++; }
;
/* There are four sorts of subrange types in F90. */
diff --git a/gdb/valops.c b/gdb/valops.c
index 5a244a9..09ea877 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -3759,56 +3759,151 @@ value_of_this_silent (const struct language_defn *lang)
struct value *
value_slice (struct value *array, int lowbound, int length)
{
+ /* Pass unaltered arguments to VALUE_SLICE_1, plus a CALL_COUNT of '1' as we
+ are only considering the highest dimension, or we are working on a one
+ dimensional array. So we call VALUE_SLICE_1 exactly once. */
+ return value_slice_1 (array, lowbound, length, 1);
+}
+
+/* CALL_COUNT is used to determine if we are calling the function once, e.g.
+ we are working on the current dimension of ARRAY, or if we are calling
+ the function repeatedly. In the later case we need to take elements
+ from the TARGET_TYPE of ARRAY.
+ With a CALL_COUNT greater than 1 we calculate the offsets for every element
+ that should be in the result array. Then we fetch the contents and then
+ copy them into the result array. The result array will have one dimension
+ less than the input array, so later on we need to recreate the indices and
+ ranges in the calling function. */
+
+struct value *
+value_slice_1 (struct value *array, int lowbound, int length, int call_count)
+{
struct type *slice_range_type, *slice_type, *range_type;
- LONGEST lowerbound, upperbound;
- struct value *slice;
- struct type *array_type;
+ struct type *array_type = check_typedef (value_type (array));
+ struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
+ unsigned int elt_size, elt_offs;
+ LONGEST elt_stride, ary_high_bound, ary_low_bound;
+ struct value *v;
+ int slice_range_size, i = 0, row_count = 1, elem_count = 1;
- array_type = check_typedef (value_type (array));
+ /* Check for legacy code if we are actually dealing with an array or
+ string. */
if (TYPE_CODE (array_type) != TYPE_CODE_ARRAY
&& TYPE_CODE (array_type) != TYPE_CODE_STRING)
error (_("cannot take slice of non-array"));
- range_type = TYPE_INDEX_TYPE (array_type);
- if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
- error (_("slice from bad array or bitstring"));
+ ary_low_bound = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (array_type));
+ ary_high_bound = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (array_type));
+
+ /* When we are working on a multi-dimensional array, we need to get the
+ attributes of the underlying type. */
+ if (call_count > 1)
+ {
+ elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type));
+ row_count = TYPE_LENGTH (array_type)
+ / TYPE_LENGTH (TYPE_TARGET_TYPE (array_type));
+ }
+
+ elem_count = length;
+ elt_size = TYPE_LENGTH (elt_type);
+ elt_offs = longest_to_int (lowbound - ary_low_bound);
+ elt_stride = TYPE_LENGTH (TYPE_INDEX_TYPE (array_type));
+
+ elt_offs *= elt_size;
+
+ /* Check for valid user input. In case of Fortran this was already done
+ in the calling function. */
+ if (call_count == 1
+ && (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
+ && elt_offs >= TYPE_LENGTH (array_type)))
+ error (_("no such vector element"));
- if (lowbound < lowerbound || length < 0
- || lowbound + length - 1 > upperbound)
- error (_("slice out of range"));
+ /* CALL_COUNT is 1 when we are dealing either with the highest dimension
+ of the array, or a one dimensional array. Set RANGE_TYPE accordingly.
+ In both cases we calculate how many rows/elements will be in the output
+ array by setting slice_range_size. */
+ if (call_count == 1)
+ {
+ range_type = TYPE_INDEX_TYPE (array_type);
+ slice_range_size = elem_count;
+
+ /* Check if the array bounds are valid. */
+ if (get_discrete_bounds (range_type, &ary_low_bound, &ary_high_bound) < 0)
+ error (_("slice from bad array or bitstring"));
+ }
+ /* When CALL_COUNT is greater than 1, we are dealing with an array of arrays.
+ So we need to get the type below the current one and set the RANGE_TYPE
+ accordingly. */
+ else
+ {
+ range_type = TYPE_INDEX_TYPE (TYPE_TARGET_TYPE (array_type));
+ slice_range_size = (ary_low_bound + row_count - 1) * (elem_count);
+ ary_low_bound = TYPE_LOW_BOUND (range_type);
+ }
/* FIXME-type-allocation: need a way to free this type when we are
- done with it. */
- slice_range_type = create_static_range_type ((struct type *) NULL,
- TYPE_TARGET_TYPE (range_type),
- lowbound,
- lowbound + length - 1);
+ done with it. */
+ slice_range_type = create_static_range_type (NULL, TYPE_TARGET_TYPE (range_type),
+ ary_low_bound, slice_range_size);
{
- struct type *element_type = TYPE_TARGET_TYPE (array_type);
- LONGEST offset
- = (lowbound - lowerbound) * TYPE_LENGTH (check_typedef (element_type));
+ struct type *element_type;
+
+ /* When CALL_COUNT equals 1 we can use the legacy code for subarrays. */
+ if (call_count == 1)
+ {
+ element_type = TYPE_TARGET_TYPE (array_type);
- slice_type = create_array_type ((struct type *) NULL,
- element_type,
- slice_range_type);
- TYPE_CODE (slice_type) = TYPE_CODE (array_type);
+ slice_type = create_array_type (NULL, element_type, slice_range_type);
+
+ TYPE_CODE (slice_type) = TYPE_CODE (array_type);
+
+ if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
+ v = allocate_value_lazy (slice_type);
+ else
+ {
+ v = allocate_value (slice_type);
+ value_contents_copy (v,
+ value_embedded_offset (v),
+ array,
+ value_embedded_offset (array) + elt_offs,
+ elt_size * longest_to_int (length));
+ }
- if (VALUE_LVAL (array) == lval_memory && value_lazy (array))
- slice = allocate_value_lazy (slice_type);
+ }
+ /* When CALL_COUNT is larger than 1 we are working on a range of ranges.
+ So we copy the relevant elements into the new array we return. */
else
{
- slice = allocate_value (slice_type);
- value_contents_copy (slice, 0, array, offset,
- type_length_units (slice_type));
+ LONGEST dst_offset = 0;
+ LONGEST src_row_length = TYPE_LENGTH (TYPE_TARGET_TYPE (array_type));
+
+ element_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (array_type));
+ slice_type = create_array_type (NULL, element_type, slice_range_type);
+
+ TYPE_CODE (slice_type) = TYPE_CODE (TYPE_TARGET_TYPE (array_type));
+
+ v = allocate_value (slice_type);
+ for (i = 0; i < longest_to_int (row_count); i++)
+ {
+ /* Fetches the contents of ARRAY and copies them into V. */
+ value_contents_copy (v,
+ dst_offset,
+ array,
+ elt_offs,
+ elt_size * elem_count);
+ elt_offs += src_row_length;
+ dst_offset += elt_size * elem_count;
+ }
}
- set_value_component_location (slice, array);
- VALUE_FRAME_ID (slice) = VALUE_FRAME_ID (array);
- set_value_offset (slice, value_offset (array) + offset);
+ set_value_component_location (v, array);
+ VALUE_REGNUM (v) = VALUE_REGNUM (array);
+ VALUE_FRAME_ID (v) = VALUE_FRAME_ID (array);
+ set_value_offset (v, value_offset (array) + elt_offs);
}
- return slice;
+ return v;
}
/* Create a value for a FORTRAN complex number. Currently most of the
diff --git a/gdb/value.h b/gdb/value.h
index 2eac5ef..3400460 100644
--- a/gdb/value.h
+++ b/gdb/value.h
@@ -1056,6 +1056,8 @@ extern struct value *varying_to_slice (struct value *);
extern struct value *value_slice (struct value *, int, int);
+extern struct value *value_slice_1 (struct value *, int, int, int);
+
extern struct value *value_literal_complex (struct value *, struct value *,
struct type *);
--
2.5.0
^ permalink raw reply [flat|nested] 8+ messages in thread* [PATCH v2 5/6] fortran: calculate subarray with stride values.
2016-02-26 13:11 [PATCH v2 0/6] fortran: multi-dimensional subarrays with strides christoph.t.weinmann
2016-02-26 13:11 ` [PATCH v2 6/6] fortran: test cases for subarray strides and slices christoph.t.weinmann
2016-02-26 13:11 ` [PATCH v2 1/6] fortran: allow multi-dimensional subarrays christoph.t.weinmann
@ 2016-02-26 13:11 ` christoph.t.weinmann
2016-02-26 13:11 ` [PATCH v2 3/6] fortran: change subrange enum to bit field christoph.t.weinmann
` (3 subsequent siblings)
6 siblings, 0 replies; 8+ messages in thread
From: christoph.t.weinmann @ 2016-02-26 13:11 UTC (permalink / raw)
To: jan.kratochvil, gdb-patches; +Cc: christoph.t.weinmann
From: Christoph Weinmann <christoph.t.weinmann@intel.com>
Calculate elements of a subarray using a provided stride value
The stride value can be a positive or negative integer, but may
not be zero. If no stride is provided, use the default value
1 to print all elements inside the range.
1| program prog
2| integer :: ary(10) = (/ (i, i=1, 10) /)
3| end program prog
(gdb) print ary(1:10:2)
$3 = (1, 3, 5, 7, 9)
2013-11-27 Christoph Weinmann <christoph.t.weinmann>
* eval.c (value_f90_subarray): Add range size calculation
for stride based ranges, and evaluation of user stride
parameters. Add check for matching user input to array
bounds.
* valops.c (value_slice): Add call parameter with default
stride value for calling value_slice_1.
* valops.c (value_slice_1): Add function parameter for
stride length in the return subarray. Calculate array
elements based on stride value.
* value.h: Add stride parameter to declaration of
value_slice_1.
Signed-off-by: Christoph Weinmann <christoph.t.weinmann@intel.com>
---
gdb/eval.c | 111 ++++++++++++++++++++++++++++++++++++++++++++++-------------
gdb/valops.c | 87 +++++++++++++++++++++++++++++++++-------------
gdb/value.h | 2 +-
3 files changed, 152 insertions(+), 48 deletions(-)
diff --git a/gdb/eval.c b/gdb/eval.c
index 308ada3..d01b579 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -437,8 +437,8 @@ value_f90_subarray (struct value *array, struct expression *exp,
{
struct subscript_range
{
- enum f90_range_type f90_range_type;
- LONGEST low, high, stride;
+ enum f90_range_type f90_range_type;
+ LONGEST low, high, stride;
}
range;
LONGEST number;
@@ -475,7 +475,7 @@ value_f90_subarray (struct value *array, struct expression *exp,
range = &index->range;
*pos += 3;
- range->f90_range_type = longest_to_int (exp->elts[pc].longconst);
+ range->f90_range_type = exp->elts[pc].longconst;
/* If a lower bound was provided by the user, the bit has been
set and we can assign the value from the elt stack. Same for
@@ -484,6 +484,7 @@ value_f90_subarray (struct value *array, struct expression *exp,
== SUBARRAY_LOW_BOUND)
range->low = value_as_long (evaluate_subexp (NULL_TYPE, exp,
pos, noside));
+
if ((range->f90_range_type & SUBARRAY_HIGH_BOUND)
== SUBARRAY_HIGH_BOUND)
range->high = value_as_long (evaluate_subexp (NULL_TYPE, exp,
@@ -496,6 +497,10 @@ value_f90_subarray (struct value *array, struct expression *exp,
/* Assign the default stride value '1'. */
else
range->stride = 1;
+
+ /* Check the provided stride value is illegal, aka '0'. */
+ if (range->stride == 0)
+ error (_("Stride must not be 0"));
}
/* User input is an index. E.g.: "p arry(5)". */
else
@@ -512,10 +517,8 @@ value_f90_subarray (struct value *array, struct expression *exp,
}
- /* Traverse the array from right to left and evaluate each corresponding
- user input. VALUE_SUBSCRIPT is called for every index, until a range
- expression is evaluated. After a range expression has been evaluated,
- every subsequent expression is also treated as a range. */
+ /* Traverse the array from right to left and set the high and low bounds
+ for later use. */
for (i = nargs - 1; i >= 0; i--)
{
struct subscript_store *index = &subscript_array[i];
@@ -548,6 +551,48 @@ value_f90_subarray (struct value *array, struct expression *exp,
|| range->high > TYPE_HIGH_BOUND (index_type))
error (_("provided bound(s) outside array bound(s)"));
+ /* For a negative stride the lower boundary must be larger than the
+ upper boundary.
+ For a positive stride the lower boundary must be smaller than the
+ upper boundary. */
+ if ((range->stride < 0 && range->low < range->high)
+ || (range->stride > 0 && range->low > range->high))
+ error (_("Wrong value provided for stride and boundaries"));
+
+ }
+ break;
+
+ case SUBSCRIPT_INDEX:
+ break;
+
+ }
+
+ array_type = TYPE_TARGET_TYPE (array_type);
+ }
+
+ /* Reset ARRAY_TYPE before slicing.*/
+ array_type = check_typedef (value_type (new_array));
+
+ /* Traverse the array from right to left and evaluate each corresponding
+ user input. VALUE_SUBSCRIPT is called for every index, until a range
+ expression is evaluated. After a range expression has been evaluated,
+ every subsequent expression is also treated as a range. */
+ for (i = nargs - 1; i >= 0; i--)
+ {
+ struct subscript_store *index = &subscript_array[i];
+ struct type *index_type = TYPE_INDEX_TYPE (array_type);
+
+ switch (index->kind)
+ {
+ case SUBSCRIPT_RANGE:
+ {
+
+ /* When we hit the first range specified by the user, we must
+ treat any subsequent user entry as a range. We simply
+ increment DIM_COUNT which tells us how many times we are
+ calling VALUE_SLICE_1. */
+ struct subscript_range *range = &index->range;
+
/* DIM_COUNT counts every user argument that is treated as a range.
This is necessary for expressions like 'print array(7, 8:9).
Here the first argument is a literal, but must be treated as a
@@ -555,10 +600,9 @@ value_f90_subarray (struct value *array, struct expression *exp,
dim_count++;
new_array
- = value_slice_1 (new_array,
- longest_to_int (range->low),
- longest_to_int (range->high - range->low + 1),
- dim_count);
+ = value_slice_1 (new_array, range->low,
+ range->high - range->low + 1,
+ range->stride, dim_count);
}
break;
@@ -572,27 +616,38 @@ value_f90_subarray (struct value *array, struct expression *exp,
to get the value offset right. */
if (dim_count == 0)
new_array
- = value_subscripted_rvalue (new_array, index->number,
+ = value_subscripted_rvalue (new_array, index->number,
f77_get_lowerbound (value_type
(new_array)));
else
{
- /* Check for valid index input. */
+ dim_count++;
+
+ /* We might end up here, because we have to treat the provided
+ index like a range. But now VALUE_SUBSCRIPTED_RVALUE
+ cannot do the range checks for us. So we have to make sure
+ ourselves that the user provided index is inside the
+ array bounds. Throw an error if not. */
if (index->number < TYPE_LOW_BOUND (index_type)
- || index->number > TYPE_HIGH_BOUND (index_type))
- error (_("error no such vector element"));
+ && index->number < TYPE_HIGH_BOUND (index_type))
+ error (_("provided bound(s) outside array bound(s)"));
+
+ if (index->number > TYPE_LOW_BOUND (index_type)
+ && index->number > TYPE_HIGH_BOUND (index_type))
+ error (_("provided bound(s) outside array bound(s)"));
- dim_count++;
new_array = value_slice_1 (new_array,
- longest_to_int (index->number),
- 1, /* length is '1' element */
+ index->number,
+ 1, /* COUNT is '1' element */
+ 1, /* STRIDE set to '1' */
dim_count);
}
}
break;
}
- }
+ array_type = TYPE_TARGET_TYPE (array_type);
+ }
/* With DIM_COUNT > 1 we currently have a one dimensional array, but expect
an array of arrays, depending on how many ranges have been provided by
@@ -617,7 +672,9 @@ value_f90_subarray (struct value *array, struct expression *exp,
the output array. So we traverse the SUBSCRIPT_ARRAY again, looking
for a range entry. When we find one, we use the range info to create
an additional range_type to set the correct bounds and dimensions for
- the output array. */
+ the output array. In addition, we may have a stride value that is not
+ '1', forcing us to adjust the number of elements in a range, according
+ to the stride value. */
for (i = 0; i < nargs; i++)
{
struct subscript_store *index = &subscript_array[i];
@@ -625,12 +682,20 @@ value_f90_subarray (struct value *array, struct expression *exp,
if (index->kind == SUBSCRIPT_RANGE)
{
struct type *range_type, *interim_array_type;
+ int new_length;
+
+ /* The length of a sub-dimension with all elements between the
+ bounds plus the start element itself. It may be modified by
+ a user provided stride value. */
+ new_length = index->range.high - index->range.low;
+
+ new_length /= index->range.stride;
range_type
= create_static_range_type (NULL,
- temp_type,
- 1,
- index->range.high - index->range.low + 1);
+ temp_type,
+ index->range.low,
+ index->range.low + new_length);
interim_array_type = create_array_type (NULL,
temp_type,
diff --git a/gdb/valops.c b/gdb/valops.c
index 09ea877..83c8462 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -3759,10 +3759,13 @@ value_of_this_silent (const struct language_defn *lang)
struct value *
value_slice (struct value *array, int lowbound, int length)
{
- /* Pass unaltered arguments to VALUE_SLICE_1, plus a CALL_COUNT of '1' as we
- are only considering the highest dimension, or we are working on a one
- dimensional array. So we call VALUE_SLICE_1 exactly once. */
- return value_slice_1 (array, lowbound, length, 1);
+ /* Pass unaltered arguments to VALUE_SLICE_1, plus a default stride
+ value of '1', which returns every element between LOWBOUND and
+ (LOWBOUND + LENGTH). We also provide a default CALL_COUNT of '1'
+ as we are only considering the highest dimension, or we are
+ working on a one dimensional array. So we call VALUE_SLICE_1
+ exactly once. */
+ return value_slice_1 (array, lowbound, length, 1, 1);
}
/* CALL_COUNT is used to determine if we are calling the function once, e.g.
@@ -3776,7 +3779,8 @@ value_slice (struct value *array, int lowbound, int length)
ranges in the calling function. */
struct value *
-value_slice_1 (struct value *array, int lowbound, int length, int call_count)
+value_slice_1 (struct value *array, int lowbound, int length,
+ int stride_length, int call_count)
{
struct type *slice_range_type, *slice_type, *range_type;
struct type *array_type = check_typedef (value_type (array));
@@ -3799,14 +3803,24 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count)
attributes of the underlying type. */
if (call_count > 1)
{
+ ary_low_bound = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (elt_type));
+ ary_high_bound = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (elt_type));
elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type));
row_count = TYPE_LENGTH (array_type)
/ TYPE_LENGTH (TYPE_TARGET_TYPE (array_type));
}
- elem_count = length;
+ /* With a stride of '1', the number of elements per result row is equal to
+ the LENGTH of the subarray. With non-default stride values, we skip
+ elements, but have to add the start element to the total number of
+ elements per row. */
+ if (stride_length == 1)
+ elem_count = length;
+ else
+ elem_count = ((length - 1) / stride_length) + 1;
+
elt_size = TYPE_LENGTH (elt_type);
- elt_offs = longest_to_int (lowbound - ary_low_bound);
+ elt_offs = lowbound - ary_low_bound;
elt_stride = TYPE_LENGTH (TYPE_INDEX_TYPE (array_type));
elt_offs *= elt_size;
@@ -3825,7 +3839,7 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count)
if (call_count == 1)
{
range_type = TYPE_INDEX_TYPE (array_type);
- slice_range_size = elem_count;
+ slice_range_size = ary_low_bound + elem_count - 1;
/* Check if the array bounds are valid. */
if (get_discrete_bounds (range_type, &ary_low_bound, &ary_high_bound) < 0)
@@ -3837,7 +3851,7 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count)
else
{
range_type = TYPE_INDEX_TYPE (TYPE_TARGET_TYPE (array_type));
- slice_range_size = (ary_low_bound + row_count - 1) * (elem_count);
+ slice_range_size = ary_low_bound + (row_count * elem_count) - 1;
ary_low_bound = TYPE_LOW_BOUND (range_type);
}
@@ -3849,8 +3863,9 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count)
{
struct type *element_type;
- /* When CALL_COUNT equals 1 we can use the legacy code for subarrays. */
- if (call_count == 1)
+ /* When both CALL_COUNT and STRIDE_LENGTH equal 1, we can use the legacy
+ code for subarrays. */
+ if (call_count == 1 && stride_length == 1)
{
element_type = TYPE_TARGET_TYPE (array_type);
@@ -3871,29 +3886,53 @@ value_slice_1 (struct value *array, int lowbound, int length, int call_count)
}
}
- /* When CALL_COUNT is larger than 1 we are working on a range of ranges.
- So we copy the relevant elements into the new array we return. */
+ /* With a CALL_COUNT or STRIDE_LENGTH are greater than 1 we are working
+ on a range of ranges. So we copy the relevant elements into the
+ new array we return. */
else
{
+ int j, offs_store = elt_offs;
LONGEST dst_offset = 0;
LONGEST src_row_length = TYPE_LENGTH (TYPE_TARGET_TYPE (array_type));
- element_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (array_type));
+ if (call_count == 1)
+ {
+ /* When CALL_COUNT is equal to 1 we are working on the current range
+ and use these elements directly. */
+ element_type = TYPE_TARGET_TYPE (array_type);
+ }
+ else
+ {
+ /* Working on an array of arrays, the type of the elements is the type
+ of the subarrays' type. */
+ element_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (array_type));
+ }
+
slice_type = create_array_type (NULL, element_type, slice_range_type);
- TYPE_CODE (slice_type) = TYPE_CODE (TYPE_TARGET_TYPE (array_type));
+ /* If we have a one dimensional array, we copy its TYPE_CODE. For a
+ multi dimensional array we copy the embedded type's TYPE_CODE. */
+ if (call_count == 1)
+ TYPE_CODE (slice_type) = TYPE_CODE (array_type);
+ else
+ TYPE_CODE (slice_type) = TYPE_CODE (TYPE_TARGET_TYPE (array_type));
v = allocate_value (slice_type);
- for (i = 0; i < longest_to_int (row_count); i++)
+
+ /* Iterate through the rows of the outer array and set the new offset
+ for each row. */
+ for (i = 0; i < row_count; i++)
{
- /* Fetches the contents of ARRAY and copies them into V. */
- value_contents_copy (v,
- dst_offset,
- array,
- elt_offs,
- elt_size * elem_count);
- elt_offs += src_row_length;
- dst_offset += elt_size * elem_count;
+ elt_offs = offs_store + i * src_row_length;
+
+ /* Iterate through the elements in each row to copy only those. */
+ for (j = 1; j <= elem_count; j++)
+ {
+ /* Fetches the contents of ARRAY and copies them into V. */
+ value_contents_copy (v, dst_offset, array, elt_offs, elt_size);
+ elt_offs += elt_size * stride_length;
+ dst_offset += elt_size;
+ }
}
}
diff --git a/gdb/value.h b/gdb/value.h
index 3400460..c18ef2e 100644
--- a/gdb/value.h
+++ b/gdb/value.h
@@ -1056,7 +1056,7 @@ extern struct value *varying_to_slice (struct value *);
extern struct value *value_slice (struct value *, int, int);
-extern struct value *value_slice_1 (struct value *, int, int, int);
+extern struct value *value_slice_1 (struct value *, int, int, int, int);
extern struct value *value_literal_complex (struct value *, struct value *,
struct type *);
--
2.5.0
^ permalink raw reply [flat|nested] 8+ messages in thread