OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

io.c (check_io_constraints): Don't look at dt->advance->value.charater.string, unless it is a CHARACTER constant.

Browse Source 
* io.c (check_io_constraints): Don't look at
	dt->advance->value.charater.string, unless it is a CHARACTER
	constant.

	* gfortran.dg/advance_2.f90: New test.
	* gfortran.dg/advance_3.f90: New test.

From-SVN: r112417
This commit is contained in:
Jakub Jelinek 2006-03-27 14:32:51 +02:00 committed by Jakub Jelinek
parent 7b9c708f15
commit 8370d5bcb1
5 changed files with 35 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
gcc/fortran/ChangeLog
View File

@ -1,5 +1,9 @@
2006-03-27 Jakub Jelinek <jakub@redhat.com>
* io.c (check_io_constraints): Don't look at
dt->advance->value.charater.string, unless it is a CHARACTER
constant.
* f95-lang.c (gfc_get_alias_set): New function.
(LANG_HOOKS_GET_ALIAS_SET): Define.

24
gcc/fortran/io.c
View File

@ -2317,30 +2317,34 @@ if (condition) \
if (dt->advance)
{
const char * advance;
int not_yes, not_no;
expr = dt->advance;
advance = expr->value.character.string;
io_constraint (dt->format_label == &format_asterisk,
"List directed format(*) is not allowed with a "
"ADVANCE=specifier at %L.", &expr->where);
not_no = strncasecmp (advance, "no", 2) != 0;
not_yes = strncasecmp (advance, "yes", 2) != 0;
if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_CHARACTER)
{
const char * advance = expr->value.character.string;
not_no = strncasecmp (advance, "no", 2) != 0;
not_yes = strncasecmp (advance, "yes", 2) != 0;
}
else
{
not_no = 0;
not_yes = 0;
}
io_constraint (expr->expr_type == EXPR_CONSTANT
&& not_no && not_yes,
io_constraint (not_no && not_yes,
"ADVANCE=specifier at %L must have value = "
"YES or NO.", &expr->where);
io_constraint (dt->size && expr->expr_type == EXPR_CONSTANT
&& not_no && k == M_READ,
io_constraint (dt->size && not_no && k == M_READ,
"SIZE tag at %L requires an ADVANCE = 'NO'",
&dt->size->where);
io_constraint (dt->eor && expr->expr_type == EXPR_CONSTANT
&& not_no && k == M_READ,
io_constraint (dt->eor && not_no && k == M_READ,
"EOR tag at %L requires an ADVANCE = 'NO'",
&dt->eor_where);
}

3
gcc/testsuite/ChangeLog
View File

@ -1,5 +1,8 @@
2006-03-27 Jakub Jelinek <jakub@redhat.com>
* gfortran.dg/advance_2.f90: New test.
* gfortran.dg/advance_3.f90: New test.
* gfortran.fortran-torture/execute/equiv_5.f: New test.
2006-03-26 Jerry DeLisle <jvdelisle@gcc.gnu.org>

6
gcc/testsuite/gfortran.dg/advance_2.f90 Normal file
View File

@ -0,0 +1,6 @@
! { dg-do compile }
subroutine foo
character(len=5) :: a
a = "yes"
write(*, '(a)', advance=a) "hello world"
end subroutine foo

8
gcc/testsuite/gfortran.dg/advance_3.f90 Normal file
View File

@ -0,0 +1,8 @@
subroutine foo
real :: a
a = 1
write(*, '(a)', advance=a) "hello world" ! { dg-error "must be of type CHARACTER" }
end subroutine foo
subroutine bar
write(*, '(a)', advance=5.) "hello world" ! { dg-error "must be of type CHARACTER" }
end subroutine bar