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
- From: Wu Zhou <woodzltc at cn dot ibm dot com>
- To: Daniel Jacobowitz <drow at false dot org>
- Cc: gdb-patches at sources dot redhat dot com
- Date: Tue, 2 Aug 2005 17:55:46 +0800 (CST)
- Subject: Re: [RFA] New testcase to evaluate Fortran substring expression
- References: <Pine.LNX.4.63.0506221044490.11343@wks190384wss.cn.ibm.com><20050703185733.GI13811@nevyn.them.org> <Pine.LNX.4.63.0507080037480.25810@wks190384wss.cn.ibm.com><20050714234612.GA21620@nevyn.them.org> <Pine.LNX.4.63.0507141043090.7735@wks190384wss.cn.ibm.com><Pine.LNX.4.63.0507151821280.21784@wks190384wss.cn.ibm.com><20050801021253.GH30901@nevyn.them.org> <Pine.LNX.4.63.0507291616040.17779@localhost.localdomain><20050802031051.GC29761@nevyn.them.org>
On Mon, 1 Aug 2005, Daniel Jacobowitz wrote:
> Could you try again to fix your clock, please? These dates can't be
> right... by the time I sent this you ought to be well on to Monday.
Yes. You are right. Really sorry for the trouble. Hope it is okay this
time.
[snip]
> What's so unpleasant about:
>
> switch (range_type)
> {
> case LOW_BOUND_DEFAULT:
> case HIGH_BOUND_DEFAULT:
> num_args = 1;
> break;
> case BOTH_BOUND_DEFAULT:
> num_args = 0;
> break;
> case NONE_BOUND_DEFAULT:
> num_args = 2;
> break;
> }
>
> The fundamental difference is that this is self-documenting at the
> point of use. You don't need to look anything up to understand what it
> means.
OK. I buy your deal. Good readablity rules here. Appended is a new
patch for this. Please review it. Thanks a lot!
The changes include:
- Add a new enumeration type named f90_range_type.
- Set the number of arguments of f90 subrange dependent on the range_type.
- Fix the long lines in eval.c.
- Remove the label "op_f77_substring" in eval.c, it is obsoleted by my patch.
- Fix a typo in subarray.exp.
Had tested it on FC4. Same result as the original patch: fix the relevant
problem and no regression.
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 2 Aug 2005 09:52:00 -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-lang.h
===================================================================
RCS file: /cvs/src/src/gdb/f-lang.h,v
retrieving revision 1.5
diff -c -p -r1.5 f-lang.h
*** f-lang.h 9 May 2005 21:20:30 -0000 1.5
--- f-lang.h 2 Aug 2005 09:52:01 -0000
*************** extern int f_val_print (struct type *, c
*** 36,41 ****
--- 36,54 ----
/* Language-specific data structures */
+ /* In F90 subrange expression, either bound could be empty, indicating that
+ its value is by default that of the corresponding bound of the array or
+ string. So we have four sorts of subrange in F90. This enumeration type
+ is to identify this. */
+
+ enum f90_range_type
+ {
+ BOTH_BOUND_DEFAULT, /* "(:)" */
+ LOW_BOUND_DEFAULT, /* "(:high)" */
+ HIGH_BOUND_DEFAULT, /* "(low:)" */
+ NONE_BOUND_DEFAULT /* "(low:high)" */
+ };
+
struct common_entry
{
struct symbol *symbol; /* The symbol node corresponding
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 2 Aug 2005 09:52:03 -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,321 ----
{ arglist_len = 1; }
;
! arglist : subrange
! { arglist_len = 1; }
;
arglist : arglist ',' exp %prec ABOVE_COMMA
{ arglist_len++; }
;
! /* There are four sorts of subrange types in F90. */
!
! subrange: exp ':' exp %prec ABOVE_COMMA
! { write_exp_elt_opcode (OP_F90_RANGE);
! write_exp_elt_longcst (NONE_BOUND_DEFAULT);
! write_exp_elt_opcode (OP_F90_RANGE); }
! ;
!
! subrange: exp ':' %prec ABOVE_COMMA
! { write_exp_elt_opcode (OP_F90_RANGE);
! write_exp_elt_longcst (HIGH_BOUND_DEFAULT);
! write_exp_elt_opcode (OP_F90_RANGE); }
;
+ subrange: ':' exp %prec ABOVE_COMMA
+ { write_exp_elt_opcode (OP_F90_RANGE);
+ write_exp_elt_longcst (LOW_BOUND_DEFAULT);
+ write_exp_elt_opcode (OP_F90_RANGE); }
+ ;
+
+ subrange: ':' %prec ABOVE_COMMA
+ { write_exp_elt_opcode (OP_F90_RANGE);
+ write_exp_elt_longcst (BOTH_BOUND_DEFAULT);
+ 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 2 Aug 2005 09:52:04 -0000
***************
*** 43,48 ****
--- 43,49 ----
#include "value.h"
#include "command.h"
#include "language.h"
+ #include "f-lang.h"
#include "parser-defs.h"
#include "gdbcmd.h"
#include "symfile.h" /* for overlay functions */
*************** operator_length_standard (struct express
*** 837,842 ****
--- 838,844 ----
{
int oplen = 1;
int args = 0;
+ enum f90_range_type range_type;
int i;
if (endpos < 1)
*************** operator_length_standard (struct express
*** 957,962 ****
--- 959,984 ----
oplen = 2;
break;
+ case OP_F90_RANGE:
+ oplen = 3;
+
+ range_type = longest_to_int (expr->elts[endpos - 2].longconst);
+ switch (range_type)
+ {
+ case LOW_BOUND_DEFAULT:
+ case HIGH_BOUND_DEFAULT:
+ args = 1;
+ break;
+ case BOTH_BOUND_DEFAULT:
+ args = 0;
+ break;
+ case NONE_BOUND_DEFAULT:
+ args = 2;
+ break;
+ }
+
+ 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 2 Aug 2005 09:52:07 -0000
*************** init_array_element (struct value *array,
*** 378,383 ****
--- 378,407 ----
}
struct value *
+ value_f90_subarray (struct value *array,
+ struct expression *exp, int *pos, enum noside noside)
+ {
+ int pc = (*pos) + 1;
+ LONGEST low_bound, high_bound;
+ struct type *range = check_typedef (TYPE_INDEX_TYPE (value_type (array)));
+ enum f90_range_type range_type = longest_to_int (exp->elts[pc].longconst);
+
+ *pos += 3;
+
+ 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));
+
+ 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));
+
+ return value_slice (array, low_bound, high_bound - low_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:
--- 1291,1309 ----
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:
*************** evaluate_subexp_standard (struct type *e
*** 1289,1315 ****
error (_("Cannot perform substring on this type"));
}
- op_f77_substr:
- /* We have a substring operation on our hands here,
- let us get the string we will be dealing with */
-
- /* Now evaluate the 'from' and 'to' */
-
- arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
-
- if (nargs < 2)
- return value_subscript (arg1, arg2);
-
- arg3 = evaluate_subexp_with_coercion (exp, pos, noside);
-
- if (noside == EVAL_SKIP)
- goto nosideret;
-
- tem2 = value_as_long (arg2);
- tem3 = value_as_long (arg3);
-
- return value_slice (arg1, tem2, tem3 - tem2 + 1);
-
case OP_COMPLEX:
/* We have a complex number, There should be 2 floating
point numbers that compose it */
--- 1322,1327 ----
*** /dev/null Thu Jul 28 02:28:02 2005
--- gdb.fortran/subarray.f Thu Jul 14 13:40:35 2005
***************
*** 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 Thu Jul 28 02:28:02 2005
--- gdb.fortran/subarray.exp Sat Jul 30 06:04:47 2005
***************
*** 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 MAIN__"
+ 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(:)"
+
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 2 Aug 2005 09:54:35 -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 ----
Regards
- Wu Zhou