re PR fortran/23635 (Argument of ichar at (1) must be of length one)

2005-10-23  Andrew Pinski  <pinskia@physics.uc.edu>

        PR fortran/23635
        * gfortran.dg/ichar_1.f90: Add tests for derived types.


2005-10-23  Andrew Pinski  <pinskia@physics.uc.edu>

        PR fortran/23635
        * check.c (gfc_check_ichar_iachar): Move the code around so
        that the check on the length is after check for
        references.

From-SVN: r105829

gcc/fortran/ChangeLog

+2005-10-23  Andrew Pinski  <pinskia@physics.uc.edu>
+
+	PR fortran/23635
+	* check.c (gfc_check_ichar_iachar): Move the code around so
+	that the check on the length is after check for
+	references.
+	
 2005-10-23  Asher Langton  <langton2@llnl.gov>
 
 	* decl.c (match_type_spec): Add a BYTE type as an extension.

gcc/fortran/check.c

@@ -929,16 +929,7 @@ gfc_check_ichar_iachar (gfc_expr * c)
   if (type_check (c, 0, BT_CHARACTER) == FAILURE)
     return FAILURE;
 
-  /* Check that the argument is length one.  Non-constant lengths
-     can't be checked here, so assume thay are ok.  */
-  if (c->ts.cl && c->ts.cl->length)
-    {
-      /* If we already have a length for this expression then use it.  */
-      if (c->ts.cl->length->expr_type != EXPR_CONSTANT)
-	return SUCCESS;
-      i = mpz_get_si (c->ts.cl->length->value.integer);
-    }
-  else if (c->expr_type == EXPR_VARIABLE || c->expr_type == EXPR_SUBSTRING)
+  if (c->expr_type == EXPR_VARIABLE || c->expr_type == EXPR_SUBSTRING)
     {
       gfc_expr *start;
       gfc_expr *end;
@@ -952,18 +943,32 @@ gfc_check_ichar_iachar (gfc_expr * c)
       gcc_assert (ref == NULL || ref->type == REF_SUBSTRING);
 
       if (!ref)
-	return SUCCESS;
-
-      start = ref->u.ss.start;
-      end = ref->u.ss.end;
+	{
+          /* Check that the argument is length one.  Non-constant lengths
+	     can't be checked here, so assume thay are ok.  */
+	  if (c->ts.cl && c->ts.cl->length)
+	    {
+	      /* If we already have a length for this expression then use it.  */
+	      if (c->ts.cl->length->expr_type != EXPR_CONSTANT)
+		return SUCCESS;
+	      i = mpz_get_si (c->ts.cl->length->value.integer);
+	    }
+	  else 
+	    return SUCCESS;
+	}
+      else
+	{
+	  start = ref->u.ss.start;
+	  end = ref->u.ss.end;
 
-      gcc_assert (start);
-      if (end == NULL || end->expr_type != EXPR_CONSTANT
-	  || start->expr_type != EXPR_CONSTANT)
-	return SUCCESS;
+	  gcc_assert (start);
+	  if (end == NULL || end->expr_type != EXPR_CONSTANT
+	      || start->expr_type != EXPR_CONSTANT)
+	    return SUCCESS;
 
-      i = mpz_get_si (end->value.integer) + 1
-	  - mpz_get_si (start->value.integer);
+	  i = mpz_get_si (end->value.integer) + 1
+	      - mpz_get_si (start->value.integer);
+	}
     }
   else
     return SUCCESS;

gcc/testsuite/ChangeLog

+2005-10-23  Andrew Pinski  <pinskia@physics.uc.edu>
+
+	PR fortran/23635
+	* gfortran.dg/ichar_1.f90: Add tests for derived types.
+
 2005-10-23  Hans-Peter Nilsson  <hp@bitrange.com>
 
 	PR target/18911

gcc/testsuite/gfortran.dg/ichar_1.f90

@@ -14,6 +14,14 @@ subroutine test (c)
 end subroutine
 
 program ichar_1
+   type derivedtype
+      character(len=4) :: addr
+   end type derivedtype
+
+   type derivedtype1
+      character(len=1) :: addr
+   end type derivedtype1
+
    integer i
    integer, parameter :: j = 2
    character(len=8) :: c = 'abcd'
@@ -21,6 +29,8 @@ program ichar_1
    character(len=1) :: g2(2,2)
    character*1, parameter :: s1 = 'e'
    character*2, parameter :: s2 = 'ef'
+   type(derivedtype) :: dt
+   type(derivedtype1) :: dt1
 
    if (ichar(c(3:3)) /= 97) call abort
    if (ichar(c(:1)) /= 97) call abort
@@ -45,6 +55,15 @@ program ichar_1
 
    if (ichar(c(3:3)) /= 97) call abort
    i = ichar(c)      ! { dg-error "must be of length one" "" }
+   
+   i = ichar(dt%addr(1:1))
+   i = ichar(dt%addr) ! { dg-error "must be of length one" "" }
+   i = ichar(dt%addr(1:2)) ! { dg-error "must be of length one" "" }
+   i = ichar(dt%addr(1:)) ! { dg-error "must be of length one" "" }
+   
+   i = ichar(dt1%addr(1:1))
+   i = ichar(dt1%addr)
+
 
    call test(g1(1))
 end program ichar_1