re PR fortran/41235 (Missing explicit interface for variable-length character functions)
2009-12-15 Tobias Burnus <burnus@net-b.de> Daniel Franke <franke.daniel@gmail.com> PR fortran/41235 * resolve.c (resolve_global_procedure): Add check for presence of an explicit interface for nonconstant, nonassumed character-length functions. (resolve_fl_procedure): Remove check for nonconstant character-length functions. 2009-12-15 Tobias Burnus <burnus@net-b.de> PR fortran/41235 * auto_char_len_1.f90: New test. * auto_char_len_2.f90: New test. * auto_char_len_4.f90: Correct test. From-SVN: r155247
This commit is contained in:
parent
0857d1f0b1
commit
d94be5e02d
|
@ -1,3 +1,13 @@
|
|||
2009-12-15 Tobias Burnus <burnus@net-b.de>
|
||||
Daniel Franke <franke.daniel@gmail.com>
|
||||
|
||||
PR fortran/41235
|
||||
* resolve.c (resolve_global_procedure): Add check for
|
||||
presence of an explicit interface for nonconstant,
|
||||
nonassumed character-length functions.
|
||||
(resolve_fl_procedure): Remove check for nonconstant
|
||||
character-length functions.
|
||||
|
||||
2009-12-14 Daniel Franke <franke.daniel@gmail.com>
|
||||
|
||||
PR fortran/42354
|
||||
|
@ -10,13 +20,13 @@
|
|||
|
||||
2009-12-11 Daniel Franke <franke.daniel@gmail.com>
|
||||
|
||||
PR fortran/40290
|
||||
* expr.c (gfc_type_convert_binary): Added warn-on-conversion flag,
|
||||
passed on to gfc_convert_type_warn() instead of gfc_convert_type();
|
||||
enabled warnings on all callers but ...
|
||||
* arith.c (eval_intrinsic): Disabled warnings on implicit type
|
||||
conversion.
|
||||
* gfortran.h gfc_type_convert_binary): Adjusted prototype.
|
||||
PR fortran/40290
|
||||
* expr.c (gfc_type_convert_binary): Added warn-on-conversion flag,
|
||||
passed on to gfc_convert_type_warn() instead of gfc_convert_type();
|
||||
enabled warnings on all callers but ...
|
||||
* arith.c (eval_intrinsic): Disabled warnings on implicit type
|
||||
conversion.
|
||||
* gfortran.h gfc_type_convert_binary): Adjusted prototype.
|
||||
|
||||
2009-12-11 Janus Weil <janus@gcc.gnu.org>
|
||||
|
||||
|
|
|
@ -1830,6 +1830,21 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
|
|||
gfc_error ("The reference to function '%s' at %L either needs an "
|
||||
"explicit INTERFACE or the rank is incorrect", sym->name,
|
||||
where);
|
||||
|
||||
/* Non-assumed length character functions. */
|
||||
if (sym->attr.function && sym->ts.type == BT_CHARACTER
|
||||
&& gsym->ns->proc_name->ts.u.cl->length != NULL)
|
||||
{
|
||||
gfc_charlen *cl = sym->ts.u.cl;
|
||||
|
||||
if (!sym->attr.entry_master && sym->attr.if_source == IFSRC_UNKNOWN
|
||||
&& cl && cl->length && cl->length->expr_type != EXPR_CONSTANT)
|
||||
{
|
||||
gfc_error ("Nonconstant character-length function '%s' at %L "
|
||||
"must have an explicit interface", sym->name,
|
||||
&sym->declared_at);
|
||||
}
|
||||
}
|
||||
|
||||
if (gfc_option.flag_whole_file == 1
|
||||
|| ((gfc_option.warn_std & GFC_STD_LEGACY)
|
||||
|
@ -9038,23 +9053,12 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
|
|||
&& resolve_charlen (cl) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
|
||||
if ((!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
|
||||
&& sym->attr.proc == PROC_ST_FUNCTION)
|
||||
{
|
||||
if (sym->attr.proc == PROC_ST_FUNCTION)
|
||||
{
|
||||
gfc_error ("Character-valued statement function '%s' at %L must "
|
||||
"have constant length", sym->name, &sym->declared_at);
|
||||
return FAILURE;
|
||||
}
|
||||
|
||||
if (sym->attr.external && sym->formal == NULL
|
||||
&& cl && cl->length && cl->length->expr_type != EXPR_CONSTANT)
|
||||
{
|
||||
gfc_error ("Automatic character length function '%s' at %L must "
|
||||
"have an explicit interface", sym->name,
|
||||
&sym->declared_at);
|
||||
return FAILURE;
|
||||
}
|
||||
gfc_error ("Character-valued statement function '%s' at %L must "
|
||||
"have constant length", sym->name, &sym->declared_at);
|
||||
return FAILURE;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
@ -1,3 +1,10 @@
|
|||
2009-12-15 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/41235
|
||||
* auto_char_len_1.f90: New test.
|
||||
* auto_char_len_2.f90: New test.
|
||||
* auto_char_len_4.f90: Correct test.
|
||||
|
||||
2009-12-14 Jason Merrill <jason@redhat.com>
|
||||
|
||||
PR c++/42364
|
||||
|
|
|
@ -0,0 +1,27 @@
|
|||
! { dg-do compile }
|
||||
! { dg-options "" }
|
||||
! [option to disable -pedantic as assumed character length
|
||||
! functions are obsolescent]
|
||||
!
|
||||
! PR fortran/41235
|
||||
!
|
||||
|
||||
character(len=*) function func()
|
||||
func = 'ABC'
|
||||
end function func
|
||||
|
||||
subroutine test(i)
|
||||
integer :: i
|
||||
character(len=i), external :: func
|
||||
print *, func()
|
||||
end subroutine test
|
||||
|
||||
subroutine test2(i)
|
||||
integer :: i
|
||||
character(len=i) :: func
|
||||
print *, func()
|
||||
end subroutine test2
|
||||
|
||||
call test(2)
|
||||
call test2(2)
|
||||
end
|
|
@ -0,0 +1,25 @@
|
|||
! { dg-do compile }
|
||||
! { dg-options "-fwhole-file" }
|
||||
!
|
||||
! PR fortran/41235
|
||||
!
|
||||
|
||||
character(len=*) function func()
|
||||
func = 'ABC'
|
||||
end function func
|
||||
|
||||
subroutine test(i)
|
||||
integer :: i
|
||||
character(len=i), external :: func
|
||||
print *, func()
|
||||
end subroutine test
|
||||
|
||||
subroutine test2(i)
|
||||
integer :: i
|
||||
character(len=i) :: func
|
||||
print *, func()
|
||||
end subroutine test2
|
||||
|
||||
call test(2)
|
||||
call test2(2)
|
||||
end
|
|
@ -1,20 +1,31 @@
|
|||
! { dg-do compile }
|
||||
! { dg-options "-fwhole-file" }
|
||||
!
|
||||
! Tests the fix for PR25087, in which the following invalid code
|
||||
! was not detected.
|
||||
!
|
||||
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
|
||||
!
|
||||
! Modified by Tobias Burnus to fix PR fortran/41235.
|
||||
!
|
||||
FUNCTION a()
|
||||
CHARACTER(len=10) :: a
|
||||
a = ''
|
||||
END FUNCTION a
|
||||
|
||||
SUBROUTINE s(n)
|
||||
CHARACTER(LEN=n), EXTERNAL :: a ! { dg-error "must have an explicit interface" }
|
||||
CHARACTER(LEN=n), EXTERNAL :: d ! { dg-error "must have an explicit interface" }
|
||||
interface
|
||||
function b (m) ! This is OK
|
||||
CHARACTER(LEN=m) :: b
|
||||
integer :: m
|
||||
end function b
|
||||
end interface
|
||||
write(6,*) a(n)
|
||||
write(6,*) a()
|
||||
write(6,*) b(n)
|
||||
write(6,*) c()
|
||||
write(6,*) d()
|
||||
contains
|
||||
function c () ! This is OK
|
||||
CHARACTER(LEN=n):: c
|
||||
|
@ -22,3 +33,7 @@ contains
|
|||
end function c
|
||||
END SUBROUTINE s
|
||||
|
||||
FUNCTION d()
|
||||
CHARACTER(len=99) :: d
|
||||
d = ''
|
||||
END FUNCTION d
|
||||
|
|
Loading…
Reference in New Issue