diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 567248af204b..095695f3bf0f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2005-10-23 Andrew Pinski + + 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 * 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 8c9f5294e160..e2e95017cfc7 100644 --- 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; + { + /* 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; - 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 e53515c6a78a..57c5b589c0f2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2005-10-23 Andrew Pinski + + PR fortran/23635 + * gfortran.dg/ichar_1.f90: Add tests for derived types. + 2005-10-23 Hans-Peter Nilsson PR target/18911 diff --git a/gcc/testsuite/gfortran.dg/ichar_1.f90 b/gcc/testsuite/gfortran.dg/ichar_1.f90 index e63b57a8cf82..104c5d166af5 100644 --- 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