mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-19 03:40:26 +08:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Andrew Pinski 2005-10-23 22:16:38 +00:00 committed by Andrew Pinski
parent f2c48d8b41
commit 78bd27f62c
4 changed files with 56 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View File

@ -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.

45
gcc/fortran/check.c
View File

@ -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;

5
gcc/testsuite/ChangeLog
View File

@ -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

19
gcc/testsuite/gfortran.dg/ichar_1.f90
View File

@ -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