* expression.h (enum exp_opcode): Add a new operator for F90

        subrange.
        * f-lang.h (enum f90_range_type): New enumeration type to identify
        F90 subrange type.
        * 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
        array section and substring.
        (value_f90_subarray): New function to evaluate F90 array section.
        (evaluate_subexp_standard): Delete label op_f77_substr and its code
        because the logic is implemented by function value_f90_subarray now.

6 files changed, 116 insertions, 29 deletions

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index ea3a2cd..b1eeab0 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,19 @@
+2005-09-20  Wu Zhou  <woodzltc@cn.ibm.com>
+
+	* expression.h (enum exp_opcode): Add a new operator for F90
+	subrange.
+	* f-lang.h (enum f90_range_type): New enumeration type to identify
+	F90 subrange type.
+	* 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
+	array section and substring.
+	(value_f90_subarray): New function to evaluate F90 array section.
+	(evaluate_subexp_standard): Delete label op_f77_substr and its code
+	because the logic is implemented by function value_f90_subarray now.
+
 2005-09-19  Paul Gilliam  <pgilliam@us.ibm.com>
 
 	* rs6000-tdep.c (_initialize_rs6000_tdep): Get rid of the unused
diff --git a/gdb/eval.c b/gdb/eval.c
index 58e77d3..302e5b8 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -378,6 +378,30 @@ init_array_element (struct value *array, struct value *element,
 }
 
 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)
@@ -1267,10 +1291,19 @@ evaluate_subexp_standard (struct type *expect_type,
       switch (code)
 	{
 	case TYPE_CODE_ARRAY:
-	  goto multi_f77_subscript;
+	  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:
-	  goto op_f77_substr;
+	  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:
@@ -1289,27 +1322,6 @@ evaluate_subexp_standard (struct type *expect_type,
 	  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 */
diff --git a/gdb/expression.h b/gdb/expression.h
index 773a738..4cb3438 100644
--- a/gdb/expression.h
+++ b/gdb/expression.h
@@ -1,6 +1,6 @@
 /* Definitions for expressions stored in reversed prefix form, for GDB.
 
-   Copyright 1986, 1989, 1992, 1994, 2000, 2003 Free Software
+   Copyright 1986, 1989, 1992, 1994, 2000, 2003, 2005 Free Software
    Foundation, Inc.
 
    This file is part of GDB.
@@ -324,6 +324,9 @@ enum exp_opcode
     /* 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 
diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index 0deb816..4e1f635 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -283,18 +283,39 @@ arglist	:	exp
 			{ arglist_len = 1; }
 	;
 
-arglist :      substring
-                        { arglist_len = 2;}
+arglist :	subrange
+			{ arglist_len = 1; }
 	;
    
 arglist	:	arglist ',' exp   %prec ABOVE_COMMA
 			{ arglist_len++; }
 	;
 
-substring:	exp ':' exp   %prec ABOVE_COMMA
-			{ } 
+/* 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 
                 	{ }                          
diff --git a/gdb/f-lang.h b/gdb/f-lang.h
index 6145cb5..ddc0e89 100644
--- a/gdb/f-lang.h
+++ b/gdb/f-lang.h
@@ -36,6 +36,19 @@ extern int f_val_print (struct type *, const gdb_byte *, int, CORE_ADDR,
 
 /* 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
diff --git a/gdb/parse.c b/gdb/parse.c
index 4ec96c6..f6b0c4f 100644
--- a/gdb/parse.c
+++ b/gdb/parse.c
@@ -1,7 +1,7 @@
 /* Parse expressions for GDB.
 
    Copyright 1986, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996,
-   1997, 1998, 1999, 2000, 2001, 2004 Free Software Foundation, Inc.
+   1997, 1998, 1999, 2000, 2001, 2004, 2005 Free Software Foundation, Inc.
 
    Modified from expread.y by the Department of Computer Science at the
    State University of New York at Buffalo, 1991.
@@ -43,6 +43,7 @@
 #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 */
@@ -837,6 +838,7 @@ operator_length_standard (struct expression *expr, int endpos,
 {
   int oplen = 1;
   int args = 0;
+  enum f90_range_type range_type;
   int i;
 
   if (endpos < 1)
@@ -957,6 +959,26 @@ operator_length_standard (struct expression *expr, int endpos,
       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);
     }