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

[Wu Zhou <woodzltc at cn dot ibm dot com>]

On Sun, 3 Jul 2005, Daniel Jacobowitz wrote:

> On Wed, Jun 22, 2005 at 10:53:35AM +0800, Wu Zhou wrote:
> > Eli/Daniel and all,
> > 
> > Here is my new testcase to evaluate Fortran substring expression.  The 
> > intention is to test whehter current GDB could correctly handle substring 
> > expression evaluation of Fortran.  I tested it against g77-3.2.3 and 
> > gfortran-4.0.0.  The last four tests failed for both configuration. 
> > 
> > I am also thinking of fixing these errors.  It is easy to fix str(exp:exp) 
> > and str(:), but I am not sure how to fix str(:exp) and str(exp:) yet. Any 
> > hints/tips on this?  TIA.
> 
> Let's hold this thought, OK?  I would rather add the tests when you
> have a patch to fix them.  Alternatively PRs could be filed and the new
> tests KFAILd, but I don't think that adds much value.
> 
> What's the problem with parsing (:exp)?  An exp can't be empty, and a
> colon can't appear at the start of an exp.  I don't think (exp:) will
> be any harder but my yacc is rusty.
 
The original thought of mine is to not add any new operators.  The problem 
of this idea is how to transfer the lowerbound (or upperbound or both) of 
the prefixed array expression?  Any ideas on this?  

Now I coded a patch (attached below) to add four new operators for F90 
subrange: OP_F90_RANGE_NORMAL, OP_F90_RANGE_DFT_END, OP_F90_RANGE_DFT_START
and OP_F90_RANGE_DFT_ALL.  The code of evaluating sub-array is also added 
and the code of substring evaluation is updated to use the former 
(sub-array evaluation).  Would you please comment on this patch? 

It is not complete, I am also thinking of enabling GDB to evaluate 
multi-dimension sub-array.  But not sure which is the easiest way.  And
if possible I'd also like to replace the usage of some gotos with some 
function.  So this patch is just the first step.  Thanks in advance 
for reviewing it.

OK.  Here goes the patch:

2005-07-09  Wu Zhou  <woodzltc@cn.ibm.com>

	* 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 new F90 subrange operators.
	* expression.h (enum exp_opcode): Add four operators for F90
	subrange.
	* eval.c (evaluate_subexp_standard): Add code to evaluate F90
	sub-array.

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	9 Jul 2005 02:25:18 -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,318 ----
  			{ arglist_len = 1; }
  	;
  
! arglist :      subrange
!                         { }
  	;
     
! arglist	:	arglist ',' arglist %prec ABOVE_COMMA
  			{ arglist_len++; }
  	;
  
! subrange:	exp ':' exp	%prec ABOVE_COMMA
! 			{ arglist_len = 1;
! 			  write_exp_elt_opcode (OP_F90_RANGE_NORMAL); }
  	;
  
+ subrange:	exp ':'	%prec ABOVE_COMMA
+ 			{ arglist_len = 1;
+ 			  write_exp_elt_opcode (OP_F90_RANGE_DFT_END); }
+ 	;
+ 
+ subrange:	':' exp	%prec ABOVE_COMMA
+ 			{ arglist_len = 1;
+ 			  write_exp_elt_opcode (OP_F90_RANGE_DFT_START); }
+ 	;
+ 
+ subrange:	':'	%prec ABOVE_COMMA
+ 			{ arglist_len = 1;
+ 			  write_exp_elt_opcode (OP_F90_RANGE_DFT_ALL); }
+ /*
+ 			  write_exp_elt_longcst (1);
+ 			  write_exp_elt_opcode (OP_F90_RANGE_DFT_ALL); }
+ */	;
  
  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	9 Jul 2005 02:25:18 -0000
*************** operator_length_standard (struct express
*** 957,962 ****
--- 957,971 ----
        oplen = 2;
        break;
  
+     case OP_F90_RANGE_NORMAL:
+       oplen = 1;
+       args = 2;
+       break;
+ 
+     case OP_F90_RANGE_DFT_ALL:
+       oplen = 1;
+       break;
+ 
      default:
        args = 1 + (i < (int) BINOP_END);
      }
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	9 Jul 2005 02:25:18 -0000
*************** enum exp_opcode
*** 324,329 ****
--- 324,335 ----
      /* An Objective C Foundation Class NSString constant */
      OP_OBJC_NSSTRING,
  
+     /* Four different kinds of subrange expression for F90 and above.  */
+     OP_F90_RANGE_NORMAL,
+     OP_F90_RANGE_DFT_END,
+     OP_F90_RANGE_DFT_START,
+     OP_F90_RANGE_DFT_ALL,
+ 
       /* 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: 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	9 Jul 2005 02:25:19 -0000
*************** init_array_element (struct value *array,
*** 377,382 ****
--- 377,435 ----
    return index;
  }
  
+ static int
+ is_f90_subarray (struct expression *exp, int position)
+ {
+   int nelts = exp->nelts;
+   enum exp_opcode op = exp->elts[position].opcode;
+   
+   if (op == OP_F90_RANGE_NORMAL || op == OP_F90_RANGE_DFT_END
+       || op == OP_F90_RANGE_DFT_START
+       || op == OP_F90_RANGE_DFT_ALL )
+     return 1;
+ 
+   return 0;
+ 
+ }
+ 
+ struct value *
+ value_f90_subarray (struct value *array, struct expression *exp, int *pos, enum noside noside)
+ {
+   int pc = (*pos)++;
+   enum exp_opcode op = exp->elts[pc].opcode;
+   LONGEST lower_bound, upper_bound;
+   struct type *range_type;
+  
+   switch (op)
+     {
+       case OP_F90_RANGE_NORMAL:
+ 	lower_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ 	upper_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ 	return value_slice (array, lower_bound, upper_bound - lower_bound + 1);
+ 
+       case OP_F90_RANGE_DFT_END:
+ 	range_type = check_typedef (TYPE_INDEX_TYPE (value_type (array)));
+ 	lower_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ 	upper_bound = TYPE_HIGH_BOUND (range_type);
+ 	return value_slice (array, lower_bound, upper_bound - lower_bound + 1);
+ 
+       case OP_F90_RANGE_DFT_START:
+ 	range_type = check_typedef (TYPE_INDEX_TYPE (value_type (array)));
+ 	lower_bound = TYPE_LOW_BOUND (range_type);
+ 	upper_bound = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+ 	return value_slice (array, lower_bound, upper_bound - lower_bound + 1);
+ 
+       case OP_F90_RANGE_DFT_ALL:
+ 	range_type = check_typedef (TYPE_INDEX_TYPE (value_type (array)));
+ 	lower_bound = TYPE_LOW_BOUND (range_type);
+ 	upper_bound = TYPE_HIGH_BOUND (range_type);
+ 	return value_slice (array, lower_bound, upper_bound - lower_bound + 1);
+ 
+       default:
+ 	error (_("This is not a f90 subarray"));
+     }  
+ }
+ 
  struct value *
  evaluate_subexp_standard (struct type *expect_type,
  			  struct expression *exp, int *pos,
*************** 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:
--- 1320,1338 ----
        switch (code)
  	{
  	case TYPE_CODE_ARRAY:
! 	  if (is_f90_subarray (exp, *pos))
! 	    return value_f90_subarray (arg1, exp, pos, noside);
! 	  else
! 	    goto multi_f77_subscript;
  
  	case TYPE_CODE_STRING:
! 	  if (is_f90_subarray (exp, *pos))
! 	    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:

Regards
- Wu Zhou