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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 567248a..095695f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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.

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 8c9f529..e2e9501 100644 (file)
--- a/gcc/fortran/check.c
+++ b/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;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e53515c..57c5b58 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/ichar_1.f90 b/gcc/testsuite/gfortran.dg/ichar_1.f90
index e63b57a..104c5d1 100644 (file)
--- a/gcc/testsuite/gfortran.dg/ichar_1.f90
+++ b/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