From: dfranke Date: Sat, 12 Jun 2010 13:43:48 +0000 (+0000) Subject: gcc/fortran/: X-Git-Tag: upstream/4.9.2~28784 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=ab0a1ed67c21194d59fb8b6c8791953a93bab581;p=platform%2Fupstream%2Flinaro-gcc.git gcc/fortran/: 2010-06-12 Daniel Franke * resolve.c (resolve_global_procedure): Improved checking if an explicit interface is required. gcc/testsuite/: 2010-06-12 Daniel Franke * gfortran.dg/whole_file_20.f03: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@160663 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 911184b..02d6d4c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2010-06-12 Daniel Franke + + * resolve.c (resolve_global_procedure): Improved checking if an + explicit interface is required. + 2010-06-12 Francois-Xavier Coudert * trans-decl.c (gfc_build_intrinsic_function_decls): Fix diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 4b4c505..d5fa370 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1858,29 +1858,6 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, } } - if (gsym->ns->proc_name->attr.function - && gsym->ns->proc_name->as - && gsym->ns->proc_name->as->rank - && (!sym->as || sym->as->rank != gsym->ns->proc_name->as->rank)) - 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); - } - } - /* Differences in constant character lengths. */ if (sym->attr.function && sym->ts.type == BT_CHARACTER) { @@ -1911,26 +1888,108 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, sym->name, &sym->declared_at, gfc_typename (&sym->ts), gfc_typename (&gsym->ns->proc_name->ts)); - /* Assumed shape arrays as dummy arguments. */ if (gsym->ns->proc_name->formal) { gfc_formal_arglist *arg = gsym->ns->proc_name->formal; for ( ; arg; arg = arg->next) - if (arg->sym && arg->sym->as - && arg->sym->as->type == AS_ASSUMED_SHAPE) + if (!arg->sym) + continue; + /* F2003, 12.3.1.1 (2a); F2008, 12.4.2.2 (2a) */ + else if (arg->sym->attr.allocatable + || arg->sym->attr.asynchronous + || arg->sym->attr.optional + || arg->sym->attr.pointer + || arg->sym->attr.target + || arg->sym->attr.value + || arg->sym->attr.volatile_) + { + gfc_error ("Dummy argument '%s' of procedure '%s' at %L " + "has an attribute that requires an explicit " + "interface for this procedure", arg->sym->name, + sym->name, &sym->declared_at); + break; + } + /* F2003, 12.3.1.1 (2b); F2008, 12.4.2.2 (2b) */ + else if (arg->sym && arg->sym->as + && arg->sym->as->type == AS_ASSUMED_SHAPE) { gfc_error ("Procedure '%s' at %L with assumed-shape dummy " - "'%s' argument must have an explicit interface", + "argument '%s' must have an explicit interface", sym->name, &sym->declared_at, arg->sym->name); break; } - else if (arg->sym && arg->sym->attr.optional) + /* F2008, 12.4.2.2 (2c) */ + else if (arg->sym->attr.codimension) { - gfc_error ("Procedure '%s' at %L with optional dummy argument " + gfc_error ("Procedure '%s' at %L with coarray dummy argument " "'%s' must have an explicit interface", sym->name, &sym->declared_at, arg->sym->name); break; } + /* F2003, 12.3.1.1 (2c); F2008, 12.4.2.2 (2d) */ + else if (false) /* TODO: is a parametrized derived type */ + { + gfc_error ("Procedure '%s' at %L with parametrized derived " + "type argument '%s' must have an explicit " + "interface", sym->name, &sym->declared_at, + arg->sym->name); + break; + } + /* F2003, 12.3.1.1 (2d); F2008, 12.4.2.2 (2e) */ + else if (arg->sym->ts.type == BT_CLASS) + { + gfc_error ("Procedure '%s' at %L with polymorphic dummy " + "argument '%s' must have an explicit interface", + sym->name, &sym->declared_at, arg->sym->name); + break; + } + } + + if (gsym->ns->proc_name->attr.function) + { + /* F2003, 12.3.1.1 (3a); F2008, 12.4.2.2 (3a) */ + if (gsym->ns->proc_name->as + && gsym->ns->proc_name->as->rank + && (!sym->as || sym->as->rank != gsym->ns->proc_name->as->rank)) + gfc_error ("The reference to function '%s' at %L either needs an " + "explicit INTERFACE or the rank is incorrect", sym->name, + where); + + /* F2003, 12.3.1.1 (3b); F2008, 12.4.2.2 (3b) */ + if (gsym->ns->proc_name->result->attr.pointer + || gsym->ns->proc_name->result->attr.allocatable) + gfc_error ("Function '%s' at %L with a POINTER or ALLOCATABLE " + "result must have an explicit interface", sym->name, + where); + + /* F2003, 12.3.1.1 (3c); F2008, 12.4.2.2 (3c) */ + if (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); + } + } + } + + /* F2003, 12.3.1.1 (4); F2008, 12.4.2.2 (4) */ + if (gsym->ns->proc_name->attr.elemental) + { + gfc_error ("ELEMENTAL procedure '%s' at %L must have an explicit " + "interface", sym->name, &sym->declared_at); + } + + /* F2003, 12.3.1.1 (5); F2008, 12.4.2.2 (5) */ + if (gsym->ns->proc_name->attr.is_bind_c) + { + gfc_error ("Procedure '%s' at %L with BIND(C) attribute must have " + "an explicit interface", sym->name, &sym->declared_at); } if (gfc_option.flag_whole_file == 1 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5041fc5..b3129f1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2010-06-12 Daniel Franke + + * gfortran.dg/whole_file_20.f03: New. + 2010-06-12 Jan Hubicka * gcc.c-torture/compile/pc44485.c: New testcase. diff --git a/gcc/testsuite/gfortran.dg/whole_file_20.f03 b/gcc/testsuite/gfortran.dg/whole_file_20.f03 new file mode 100644 index 0000000..231a5aa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/whole_file_20.f03 @@ -0,0 +1,33 @@ +! { dg-do "compile" } +! { dg-options "-fwhole-file -fcoarray=single" } +! +! Procedures with dummy arguments that are coarrays or polymorphic +! must have an explicit interface in the calling routine. +! + +MODULE classtype + type :: t + integer :: comp + end type +END MODULE + +PROGRAM main + USE classtype + CLASS(t), POINTER :: tt + + INTEGER :: coarr[*] + + CALL coarray(coarr) ! { dg-error " must have an explicit interface" } + CALL polymorph(tt) ! { dg-error " must have an explicit interface" } +END PROGRAM + +SUBROUTINE coarray(a) + INTEGER :: a[*] +END SUBROUTINE + +SUBROUTINE polymorph(b) + USE classtype + CLASS(t) :: b +END SUBROUTINE + +! { dg-final { cleanup-modules "classtype" } }