This is the mail archive of the gdb-patches@sources.redhat.com mailing list for the GDB project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [RFA] New testcase to evaluate Fortran substring expression


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


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]