re PR fortran/18833 (ICE 'missing spec' on integer/char equivalence)

	PR fortran/18833
	PR fortran/20850
	* primary.c (match_varspec): If equiv_flag, don't look at sym's
	attributes, call gfc_match_array_ref up to twice and don't do any
	substring or component processing.
	* resolve.c (resolve_equivalence): Transform REF_ARRAY into
	REF_SUBSTRING or nothing if needed.  Check that substrings
	don't have zero length.

	* gfortran.dg/equiv_1.f90: New test.
	* gfortran.dg/equiv_2.f90: New test.
	* gfortran.fortran-torture/execute/equiv_2.f90: New test.
	* gfortran.fortran-torture/execute/equiv_3.f90: New test.
	* gfortran.fortran-torture/execute/equiv_4.f90: New test.

From-SVN: r102801

gcc/fortran/ChangeLog

+2005-08-06  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/18833
+	PR fortran/20850
+	* primary.c (match_varspec): If equiv_flag, don't look at sym's
+	attributes, call gfc_match_array_ref up to twice and don't do any
+	substring or component processing.
+	* resolve.c (resolve_equivalence): Transform REF_ARRAY into
+	REF_SUBSTRING or nothing if needed.  Check that substrings
+	don't have zero length.
+
 2005-08-05  Thomas Koenig  <Thomas.Koenig@online.de>
 
 	* trans-expr.c  (gfc_build_builtin_function_decls):  Mark

gcc/fortran/primary.c

@@ -1517,28 +1517,42 @@ match_varspec (gfc_expr * primary, int equiv_flag)
   char name[GFC_MAX_SYMBOL_LEN + 1];
   gfc_ref *substring, *tail;
   gfc_component *component;
-  gfc_symbol *sym;
+  gfc_symbol *sym = primary->symtree->n.sym;
   match m;
 
   tail = NULL;
 
-  if (primary->symtree->n.sym->attr.dimension
-      || (equiv_flag
-	  && gfc_peek_char () == '('))
+  if ((equiv_flag && gfc_peek_char () == '(')
+      || sym->attr.dimension)
     {
-
+      /* In EQUIVALENCE, we don't know yet whether we are seeing
+	 an array, character variable or array of character
+	 variables.  We'll leave the decision till resolve
+	 time.  */
       tail = extend_ref (primary, tail);
       tail->type = REF_ARRAY;
 
-      m = gfc_match_array_ref (&tail->u.ar, primary->symtree->n.sym->as,
-                               equiv_flag);
+      m = gfc_match_array_ref (&tail->u.ar, equiv_flag ? NULL : sym->as,
+			       equiv_flag);
       if (m != MATCH_YES)
 	return m;
+
+      if (equiv_flag && gfc_peek_char () == '(')
+	{
+	  tail = extend_ref (primary, tail);
+	  tail->type = REF_ARRAY;
+
+	  m = gfc_match_array_ref (&tail->u.ar, NULL, equiv_flag);
+	  if (m != MATCH_YES)
+	    return m;
+	}
     }
 
-  sym = primary->symtree->n.sym;
   primary->ts = sym->ts;
 
+  if (equiv_flag)
+    return MATCH_YES;
+
   if (sym->ts.type != BT_DERIVED || gfc_match_char ('%') != MATCH_YES)
     goto check_substring;
 

gcc/fortran/resolve.c

@@ -4757,7 +4757,7 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e)
    sequence derived type containing a pointer at any level of component
    selection, an automatic object, a function name, an entry name, a result
    name, a named constant, a structure component, or a subobject of any of
-   the preceding objects.  */
+   the preceding objects.  A substring shall not have length zero.  */
 
 static void
 resolve_equivalence (gfc_equiv *eq)
@@ -4770,6 +4770,69 @@ resolve_equivalence (gfc_equiv *eq)
   for (; eq; eq = eq->eq)
     {
       e = eq->expr;
+
+      e->ts = e->symtree->n.sym->ts;
+      /* match_varspec might not know yet if it is seeing
+	 array reference or substring reference, as it doesn't
+	 know the types.  */
+      if (e->ref && e->ref->type == REF_ARRAY)
+	{
+	  gfc_ref *ref = e->ref;
+	  sym = e->symtree->n.sym;
+
+	  if (sym->attr.dimension)
+	    {
+	      ref->u.ar.as = sym->as;
+	      ref = ref->next;
+	    }
+
+	  /* For substrings, convert REF_ARRAY into REF_SUBSTRING.  */
+	  if (e->ts.type == BT_CHARACTER
+	      && ref
+	      && ref->type == REF_ARRAY
+	      && ref->u.ar.dimen == 1
+	      && ref->u.ar.dimen_type[0] == DIMEN_RANGE
+	      && ref->u.ar.stride[0] == NULL)
+	    {
+	      gfc_expr *start = ref->u.ar.start[0];
+	      gfc_expr *end = ref->u.ar.end[0];
+	      void *mem = NULL;
+
+	      /* Optimize away the (:) reference.  */
+	      if (start == NULL && end == NULL)
+		{
+		  if (e->ref == ref)
+		    e->ref = ref->next;
+		  else
+		    e->ref->next = ref->next;
+		  mem = ref;
+		}
+	      else
+		{
+		  ref->type = REF_SUBSTRING;
+		  if (start == NULL)
+		    start = gfc_int_expr (1);
+		  ref->u.ss.start = start;
+		  if (end == NULL && e->ts.cl)
+		    end = gfc_copy_expr (e->ts.cl->length);
+		  ref->u.ss.end = end;
+		  ref->u.ss.length = e->ts.cl;
+		  e->ts.cl = NULL;
+		}
+	      ref = ref->next;
+	      gfc_free (mem);
+	    }
+
+	  /* Any further ref is an error.  */
+	  if (ref)
+	    {
+	      gcc_assert (ref->type == REF_ARRAY);
+	      gfc_error ("Syntax error in EQUIVALENCE statement at %L",
+			 &ref->u.ar.where);
+	      continue;
+	    }
+	}
+
       if (gfc_resolve_expr (e) == FAILURE)
         continue;
 
@@ -4832,19 +4895,30 @@ resolve_equivalence (gfc_equiv *eq)
           continue;
         }
 
-      /* Shall not be a structure component.  */
       r = e->ref;
       while (r)
         {
-          if (r->type == REF_COMPONENT)
-            {
-              gfc_error ("Structure component '%s' at %L cannot be an "
-                         "EQUIVALENCE object",
-                         r->u.c.component->name, &e->where);
-              break;
-            }
-          r = r->next;
-        }
+	  /* Shall not be a structure component.  */
+	  if (r->type == REF_COMPONENT)
+	    {
+	      gfc_error ("Structure component '%s' at %L cannot be an "
+			 "EQUIVALENCE object",
+			 r->u.c.component->name, &e->where);
+	      break;
+	    }
+
+	  /* A substring shall not have length zero.  */
+	  if (r->type == REF_SUBSTRING)
+	    {
+	      if (compare_bound (r->u.ss.start, r->u.ss.end) == CMP_GT)
+		{
+		  gfc_error ("Substring at %L has length zero",
+			     &r->u.ss.start->where);
+		  break;
+		}
+	    }
+	  r = r->next;
+	}
     }    
 }      
 

gcc/testsuite/ChangeLog

+2005-08-06  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/18833
+	PR fortran/20850
+	* gfortran.dg/equiv_1.f90: New test.
+	* gfortran.dg/equiv_2.f90: New test.
+	* gfortran.fortran-torture/execute/equiv_2.f90: New test.
+	* gfortran.fortran-torture/execute/equiv_3.f90: New test.
+	* gfortran.fortran-torture/execute/equiv_4.f90: New test.
+
 2005-08-05  James A. Morrison  <phython@gcc.gnu.org>
 
 	* gcc.c-torture/execute/vrp-5.c: New test.

gcc/testsuite/gfortran.dg/equiv_1.f90

+      program broken_equiv
+      real d (2)	! { dg-error "Inconsistent equivalence rules" "d" }
+      real e		! { dg-error "Inconsistent equivalence rules" "e" }
+      equivalence (d (1), e), (d (2), e)
+
+      real f (2)	! { dg-error "Inconsistent equivalence rules" "f" }
+      double precision g (2) ! { dg-error "Inconsistent equivalence rules" "g" }
+      equivalence (f (1), g (1)), (f (2), g (2)) ! Not standard conforming
+      end

gcc/testsuite/gfortran.dg/equiv_2.f90

+      subroutine broken_equiv1
+      character*4 h
+      character*3 i
+      equivalence (h(1:3), i(2:1))	! { dg-error "has length zero" }
+      end subroutine
+
+      subroutine broken_equiv2
+      character*4 j
+      character*2 k
+      equivalence (j(2:3), k(1:5))	! { dg-error "out of bounds" }
+      end subroutine
+
+      subroutine broken_equiv3
+      character*4 l
+      character*2 m
+      equivalence (l(2:3:4), m(1:2))	! { dg-error "\[Ss\]yntax error" }
+      end subroutine

gcc/testsuite/gfortran.fortran-torture/execute/equiv_2.f90

+      subroutine test1
+      character*8 c
+      character*1 d, f
+      dimension d(2), f(2)
+      character*4 e
+      equivalence (c(1:1), d(1)), (c(3:5), e(2:4)), (c(6:6), f(2))
+      c='abcdefgh'
+      if (c.ne.'abcdefgh'.or.d(1).ne.'a'.or.d(2).ne.'b') call abort
+      if (e.ne.'bcde'.or.f(1).ne.'e'.or.f(2).ne.'f') call abort
+      end subroutine test1
+      subroutine test2
+      equivalence (c(1:1), d(1)), (c(3:5), e(2:4)), (c(6:6), f(2))
+      character*8 c
+      character*1 d, f
+      dimension d(2), f(2)
+      character*4 e
+      c='abcdefgh'
+      if (c.ne.'abcdefgh'.or.d(1).ne.'a'.or.d(2).ne.'b') call abort
+      if (e.ne.'bcde'.or.f(1).ne.'e'.or.f(2).ne.'f') call abort
+      end subroutine test2
+      subroutine test3
+      character*8 c
+      character*1 d, f
+      character*4 e
+      equivalence (c(1:1), d(1)), (c(3:5), e(2:4)), (c(6:6), f(2))
+      dimension d(2), f(2)
+      c='abcdefgh'
+      if (c.ne.'abcdefgh'.or.d(1).ne.'a'.or.d(2).ne.'b') call abort
+      if (e.ne.'bcde'.or.f(1).ne.'e'.or.f(2).ne.'f') call abort
+      end subroutine test3
+      subroutine test4
+      dimension d(2), f(2)
+      equivalence (c(1:1), d(1)), (c(3:5), e(2:4)), (c(6:6), f(2))
+      character*8 c
+      character*1 d, f
+      character*4 e
+      c='abcdefgh'
+      if (c.ne.'abcdefgh'.or.d(1).ne.'a'.or.d(2).ne.'b') call abort
+      if (e.ne.'bcde'.or.f(1).ne.'e'.or.f(2).ne.'f') call abort
+      end subroutine test4
+      program main
+      call test1
+      call test2
+      call test3
+      call test4
+      end program main

gcc/testsuite/gfortran.fortran-torture/execute/equiv_3.f90

+      subroutine test1
+      type t
+      sequence
+      character(8) c
+      end type t
+      type(t) :: tc, td
+      equivalence (tc, td)
+      tc%c='abcdefgh'
+      if (tc%c.ne.'abcdefgh'.or.td%c(1:1).ne.'a') call abort
+      end subroutine test1
+      program main
+      call test1
+      end program main

gcc/testsuite/gfortran.fortran-torture/execute/equiv_4.f90

+      subroutine test1
+      character*8 c
+      character*2 d, f
+      dimension d(2), f(2)
+      character*4 e
+      equivalence (c(1:1), d(1)(2:)), (c(3:5), e(2:4))
+      equivalence (c(6:6), f(2)(:))
+      d(1)='AB'
+      c='abcdefgh'
+      if (c.ne.'abcdefgh'.or.d(1).ne.'Aa'.or.d(2).ne.'bc') call abort
+      if (e.ne.'bcde'.or.f(1).ne.'de'.or.f(2).ne.'fg') call abort
+      end subroutine test1
+      subroutine test2
+      equivalence (c(1:1), d(1)(2:2)), (c(3:5), e(2:4))
+      equivalence (c(6:6), f(2)(1:))
+      character*8 c
+      character*2 d, f
+      dimension d(2), f(2)
+      character*4 e
+      d(1)='AB'
+      c='abcdefgh'
+      if (c.ne.'abcdefgh'.or.d(1).ne.'Aa'.or.d(2).ne.'bc') call abort
+      if (e.ne.'bcde'.or.f(1).ne.'de'.or.f(2).ne.'fg') call abort
+      end subroutine test2
+      subroutine test3
+      character*8 c
+      character*2 d, f
+      character*4 e
+      equivalence (c(1:1), d(1)(2:)), (c(3:5), e(2:4))
+      equivalence (c(6:6), f(2)(:1))
+      dimension d(2), f(2)
+      d(1)='AB'
+      c='abcdefgh'
+      if (c.ne.'abcdefgh'.or.d(1).ne.'Aa'.or.d(2).ne.'bc') call abort
+      if (e.ne.'bcde'.or.f(1).ne.'de'.or.f(2).ne.'fg') call abort
+      end subroutine test3
+      subroutine test4
+      dimension d(2), f(2)
+      equivalence (c(1:1), d(1)(2:2)), (c(3:5), e(2:4))
+      equivalence (c(6:6), f(2)(1:2))
+      character*8 c
+      character*2 d, f
+      character*4 e
+      d(1)='AB'
+      c='abcdefgh'
+      if (c.ne.'abcdefgh'.or.d(1).ne.'Aa'.or.d(2).ne.'bc') call abort
+      if (e.ne.'bcde'.or.f(1).ne.'de'.or.f(2).ne.'fg') call abort
+      end subroutine test4
+      program main
+      call test1
+      call test2
+      call test3
+      call test4
+      end program main