This is the mail archive of the
gdb-patches@sources.redhat.com
mailing list for the GDB project.
Re: [RFA] New testcase to evaluate Fortran substring expression
Daniel,
I made some modification to the original patch. The changes include:
- Don't include "arglist : arglist, subrange". Because I don't figure
out how to evaluate multi-dimension array section yet.
- Only add a new operator: OP_F90_RANGE and get the range type wrapped by
this operator.
- Change the name of new testcase from substring to subarray. Because
g77 will handle string variable as character array instead. (gfortran did
this too) Added four tests for substring evaluation in gdb.fortran/exprs.exp,
the reason is that g77 and gfortran still treat string constant as string.
Please help review this too. Thanks a lot!
P.S: I had tested this on FC4. All passed. And no regression on fortran
related test. (Didn't test other part of the testsuite.)
2005-07-15 Wu Zhou <woodzltc@cn.ibm.com>
* expression.h (enum exp_opcode): Add a new operator for F90
subrange.
* f-exp.y (yyparse): Add support for parsing F90 subrange and
change substring parsing to subrange parsing.
* parse.c (operator_length_standard): Set the operator length
and args number for OP_F90_RANGE.
* eval.c (evaluate_subexp_standard): Add code to evaluate F90
sub-array.
(value_f90_subarray): New function to evaluate f90 subarray.
Index: expression.h
===================================================================
RCS file: /cvs/src/src/gdb/expression.h,v
retrieving revision 1.15
diff -c -p -r1.15 expression.h
*** expression.h 8 Jun 2005 06:28:28 -0000 1.15
--- expression.h 15 Jul 2005 10:01:38 -0000
*************** enum exp_opcode
*** 324,329 ****
--- 324,332 ----
/* An Objective C Foundation Class NSString constant */
OP_OBJC_NSSTRING,
+ /* A F90 array range operator. (for "exp:exp", "exp:", ":exp" and ":") */
+ OP_F90_RANGE,
+
/* First extension operator. Individual language modules define
extra operators they need as constants with values
OP_LANGUAGE_SPECIFIC0 + k, for k >= 0, using a separate
Index: f-exp.y
===================================================================
RCS file: /cvs/src/src/gdb/f-exp.y,v
retrieving revision 1.17
diff -c -p -r1.17 f-exp.y
*** f-exp.y 6 Jul 2005 06:52:25 -0000 1.17
--- f-exp.y 15 Jul 2005 10:01:39 -0000
*************** arglist : exp
*** 283,300 ****
{ arglist_len = 1; }
;
! arglist : substring
! { arglist_len = 2;}
;
arglist : arglist ',' exp %prec ABOVE_COMMA
{ arglist_len++; }
;
! substring: exp ':' exp %prec ABOVE_COMMA
! { }
;
complexnum: exp ',' exp
{ }
--- 283,319 ----
{ arglist_len = 1; }
;
! arglist : subrange
! { arglist_len = 1; }
;
arglist : arglist ',' exp %prec ABOVE_COMMA
{ arglist_len++; }
;
! subrange: exp ':' exp %prec ABOVE_COMMA
! { write_exp_elt_opcode (OP_F90_RANGE);
! write_exp_elt_longcst (2);
! write_exp_elt_opcode (OP_F90_RANGE); }
;
+ subrange: exp ':' %prec ABOVE_COMMA
+ { write_exp_elt_opcode (OP_F90_RANGE);
+ write_exp_elt_longcst (1);
+ write_exp_elt_opcode (OP_F90_RANGE); }
+ ;
+
+ subrange: ':' exp %prec ABOVE_COMMA
+ { write_exp_elt_opcode (OP_F90_RANGE);
+ write_exp_elt_longcst (-1);
+ write_exp_elt_opcode (OP_F90_RANGE); }
+ ;
+
+ subrange: ':' %prec ABOVE_COMMA
+ { write_exp_elt_opcode (OP_F90_RANGE);
+ write_exp_elt_longcst (0);
+ write_exp_elt_opcode (OP_F90_RANGE); }
+ ;
complexnum: exp ',' exp
{ }
Index: parse.c
===================================================================
RCS file: /cvs/src/src/gdb/parse.c,v
retrieving revision 1.49
diff -c -p -r1.49 parse.c
*** parse.c 29 Apr 2005 00:04:06 -0000 1.49
--- parse.c 15 Jul 2005 10:01:40 -0000
*************** operator_length_standard (struct express
*** 957,962 ****
--- 957,967 ----
oplen = 2;
break;
+ case OP_F90_RANGE:
+ oplen = 3;
+ args = abs (longest_to_int (expr->elts[endpos - 2].longconst));
+ break;
+
default:
args = 1 + (i < (int) BINOP_END);
}
Index: eval.c
===================================================================
RCS file: /cvs/src/src/gdb/eval.c,v
retrieving revision 1.58
diff -c -p -r1.58 eval.c
*** eval.c 6 Jul 2005 06:52:25 -0000 1.58
--- eval.c 15 Jul 2005 10:01:42 -0000
*************** init_array_element (struct value *array,
*** 378,383 ****
--- 378,405 ----
}
struct value *
+ value_f90_subarray (struct value *array, struct expression *exp, int *pos, enum noside noside)
+ {
+ int pc = (*pos) + 1;
+ int nargs = longest_to_int (exp->elts[pc].longconst);
+ LONGEST lower_bound, upper_bound;
+ struct type *range_type = check_typedef (TYPE_INDEX_TYPE (value_type (array)));
+
+ *pos += 3;
+ if (nargs == 0 || nargs == -1)
+ lower_bound = TYPE_LOW_BOUND (range_type);
+ else
+ lower_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+
+ if (nargs == 0 || nargs == 1)
+ upper_bound = TYPE_HIGH_BOUND (range_type);
+ else
+ upper_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+
+ return value_slice (array, lower_bound, upper_bound - lower_bound + 1);
+ }
+
+ struct value *
evaluate_subexp_standard (struct type *expect_type,
struct expression *exp, int *pos,
enum noside noside)
*************** evaluate_subexp_standard (struct type *e
*** 1267,1276 ****
switch (code)
{
case TYPE_CODE_ARRAY:
! goto multi_f77_subscript;
case TYPE_CODE_STRING:
! goto op_f77_substr;
case TYPE_CODE_PTR:
case TYPE_CODE_FUNC:
--- 1289,1307 ----
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;
case TYPE_CODE_STRING:
! if (exp->elts[*pos].opcode == OP_F90_RANGE)
! return value_f90_subarray (arg1, exp, pos, noside);
! else
! {
! arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
! return value_subscript (arg1, arg2);
! }
case TYPE_CODE_PTR:
case TYPE_CODE_FUNC:
Here is the patch for exprs.exp:
==================================
Index: gdb.fortran/exprs.exp
===================================================================
RCS file: /cvs/src/src/gdb/testsuite/gdb.fortran/exprs.exp,v
retrieving revision 1.4
diff -c -p -r1.4 exprs.exp
*** gdb.fortran/exprs.exp 6 Jul 2005 06:11:54 -0000 1.4
--- gdb.fortran/exprs.exp 15 Jul 2005 10:05:15 -0000
*************** proc test_character_literals_accepted {}
*** 59,64 ****
--- 59,71 ----
# Test various character values.
gdb_test "p 'a'" " = 'a'"
+
+ # Test various substring expression.
+ gdb_test "p 'abcdefg'(2:4)" " = 'bcd'"
+ gdb_test "p 'abcdefg'(:3)" " = 'abc'"
+ gdb_test "p 'abcdefg'(5:)" " = 'efg'"
+ gdb_test "p 'abcdefg'(:)" " = 'abcdefg'"
+
}
proc test_integer_literals_rejected {} {
*************** proc test_arithmetic_expressions {} {
*** 248,255 ****
gdb_test "p 6.0 / 3" " = 2" "real divided by int"
gdb_test "p 6.0 / 3.0" " = 2" "real divided by real"
- # Test modulo with various operands
-
# Test exponentiation with various operands
gdb_test "p 2 ** 3" " = 8" "int powered by int"
--- 255,260 ----
Here is the renamed subarray testcase:
========================================
*** /dev/null 2005-06-19 07:34:09.109204120 +0800
--- gdb.fortran/subarray.f 2005-07-14 13:40:35.000000000 +0800
***************
*** 0 ****
--- 1,36 ----
+ c Copyright 2005 Free Software Foundation, Inc.
+
+ c This program is free software; you can redistribute it and/or modify
+ c it under the terms of the GNU General Public License as published by
+ c the Free Software Foundation; either version 2 of the License, or
+ c (at your option) any later version.
+ c
+ c This program is distributed in the hope that it will be useful,
+ c but WITHOUT ANY WARRANTY; without even the implied warranty of
+ c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ c GNU General Public License for more details.
+ c
+ c You should have received a copy of the GNU General Public License
+ c along with this program; if not, write to the Free Software
+ c Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ c Ihis file is the Fortran source file for subarray.exp. It was written
+ c by Wu Zhou. (woodzltc@cn.ibm.com)
+
+ PROGRAM subarray
+
+ character *7 str
+ integer array(7)
+
+ c Initialize character array "str" and integer array "array".
+ str = 'abcdefg'
+ do i = 1, 7
+ array(i) = i
+ end do
+
+ write (*, *) str(2:4)
+ write (*, *) str(:3)
+ write (*, *) str(5:)
+ write (*, *) str(:)
+
+ END PROGRAM
*** /dev/null 2005-06-19 07:34:09.109204120 +0800
--- gdb.fortran/subarray.exp 2005-07-14 13:43:58.000000000 +0800
***************
*** 0 ****
--- 1,66 ----
+ # Copyright 2005 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 2 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, write to the Free Software
+ # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ # This file was written by Wu Zhou. (woodzltc@cn.ibm.com)
+
+ # This file is part of the gdb testsuite. It contains tests for evaluating
+ # Fortran subarray expression
+
+ if $tracelevel then {
+ strace $tracelevel
+ }
+
+ set testfile "subarray"
+ set srcfile ${testfile}.f
+ set binfile ${objdir}/${subdir}/${testfile}
+
+ if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug f77 quiet}] != "" } {
+ untested "Couldn't compile ${srcfile}"
+ return -1
+ }
+
+ gdb_exit
+ gdb_start
+ gdb_reinitialize_dir $srcdir/$subdir
+ gdb_load ${binfile}
+
+ if ![runto MAIN__] then {
+ perror "couldn't run to breakpoint sub_"
+ continue
+ }
+
+ # Try to set breakpoint at the last write statement.
+
+ set bp_location [gdb_get_line_number "str(:)"]
+ gdb_test "break $bp_location" \
+ "Breakpoint.*at.* file .*$srcfile, line $bp_location\\." \
+ "breakpoint at the last write statement"
+ gdb_test "continue" \
+ "Continuing\\..*Breakpoint.*" \
+ "continue to breakpoint"
+
+ # Test four different kinds of subarray expression evaluation.
+
+ gdb_test "print str(2:4)" ".*1 = \\(98 'b', 99 'c', 100 'd'\\).*" "print str(2:4)"
+ gdb_test "print str(:3)" ".*2 = \\(97 'a', 98 'b', 99 'c'\\).*" "print str(:3)"
+ gdb_test "print str(5:)" ".*3 = \\(101 'e', 102 'f', 103 'g'\\).*" "print str(5:)"
+ gdb_test "print str(:)" ".*4 = \\(97 'a', 98 'b', 99 'c', 100 'd', 101 'e', 102 'f', 103 'g'\\).*" "print str(:)"
+
+ gdb_test "print array(2:4)" ".*5 = \\(2, 3, 4\\).*" "print array(2:4)"
+ gdb_test "print array(:3)" ".*6 = \\(1, 2, 3\\).*" "print array(:3)"
+ gdb_test "print array(5:)" ".*7 = \\(5, 6, 7\\).*" "print array(5:)"
+ gdb_test "print array(:)" ".*8 = \\(1, 2, 3, 4, 5, 6, 7\\).*" "print array(:)"
+
Regards
- Wu Zhou