[gfortran] Fix PR 19479: Simplification of the {L|U}BOUND intrinsics

[Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>]

This patch fixes the simplification of the UBOUND and LBOUND intrinsics.
Previously they would get confused if there were component references in the
reference chain.  The attached testcase segfaults before the patch and passes
afterwards.

Bubblestrapped and tested on i686-pc-linux.  This patch is ported from g95,
but I simplified the logic and chose non-obfuscated variable names.  Ok for
mainline and the branch?

- Tobi

2005-02-27  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
	(port from g95)

	PR fortran/19479
	* simplify.c (gfc_simplify_bound): Overhaul.

? bak.diff
? curr.diff
? err
? err.diff
? missing.diff
? op.diff
? pool.diff
? pool2.diff
? pr19479.diff
? semantic.cache
Index: simplify.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/simplify.c,v
retrieving revision 1.19
diff -c -3 -p -r1.19 simplify.c
*** simplify.c	19 Feb 2005 20:29:05 -0000	1.19
--- simplify.c	27 Feb 2005 13:44:28 -0000
*************** gfc_simplify_bound (gfc_expr * array, gf
*** 1770,1781 ****
  {
    gfc_ref *ref;
    gfc_array_spec *as;
!   int i;
  
    if (array->expr_type != EXPR_VARIABLE)
      return NULL;
  
    if (dim == NULL)
      return NULL;
  
    if (dim->expr_type != EXPR_CONSTANT)
--- 1770,1783 ----
  {
    gfc_ref *ref;
    gfc_array_spec *as;
!   gfc_expr *e;
!   int d;
  
    if (array->expr_type != EXPR_VARIABLE)
      return NULL;
  
    if (dim == NULL)
+     /* TODO: Simplify constant multi-dimensional bounds.  */
      return NULL;
  
    if (dim->expr_type != EXPR_CONSTANT)
*************** gfc_simplify_bound (gfc_expr * array, gf
*** 1783,1804 ****
  
    /* Follow any component references.  */
    as = array->symtree->n.sym->as;
!   ref = array->ref;
!   while (ref->next != NULL)
      {
!       if (ref->type == REF_COMPONENT)
! 	as = ref->u.c.sym->as;
!       ref = ref->next;
      }
  
!   if (ref->type != REF_ARRAY || ref->u.ar.type != AR_FULL)
      return NULL;
!   
!   i = mpz_get_si (dim->value.integer);
!   if (upper) 
!     return gfc_copy_expr (as->upper[i-1]);
!   else
!     return gfc_copy_expr (as->lower[i-1]);
  }
  
  
--- 1785,1841 ----
  
    /* Follow any component references.  */
    as = array->symtree->n.sym->as;
!   for (ref = array->ref; ref; ref = ref->next)
!     switch (ref->type)
!       {
!       case REF_ARRAY:
! 	switch (ref->u.ar.type)
! 	  {
! 	  case AR_ELEMENT:
! 	    as = NULL;
! 	    continue;
! 
! 	  case AR_FULL:
! 	    /* We're done because 'as' has already been set in the
! 	       previous iteration.  */
! 	    goto done;
! 	    
! 	  case AR_SECTION:
! 	  case AR_UNKNOWN:
! 	    return NULL;
! 	  }
! 
! 	gcc_unreachable ();
! 
!       case REF_COMPONENT:
! 	as = ref->u.c.component->as;
! 	continue;
! 
!       case REF_SUBSTRING:
! 	continue;
!       }
! 
!   gcc_unreachable ();
! 	
! done:
!   if (as->type == AS_DEFERRED || as->type == AS_ASSUMED_SHAPE)
!     return NULL;
! 
!   d = mpz_get_si (dim->value.integer);
! 
!   if (d < 1 || d > as->rank 
!       || (d == as->rank && as->type == AS_ASSUMED_SIZE && upper))
      {
!       gfc_error ("DIM argument at %L is out of bounds", &dim->where);
!       return &gfc_bad_expr;
      }
+   
+   e = upper ? as->upper[d-1] : as->lower[d-1];
  
!   if (e->expr_type != EXPR_CONSTANT)
      return NULL;
! 
!   return gfc_copy_expr (e);
  }
  
  

! { dg-do run }
  implicit none

  type test_type
    integer, dimension(5) :: a
  end type test_type

  type (test_type), target :: tt(2)
  integer i

  i = ubound(tt(1)%a, 1)
  if (i/=5) call abort()
  i = lbound(tt(1)%a, 1)
  if (i/=1) call abort()

  i = ubound(tt, 1)
  if (i/=2) call abort()
  i = lbound(tt, 1)
  if (i/=1) call abort()
end