From: Paul Thomas Date: Thu, 28 Dec 2006 18:41:25 +0000 (+0000) Subject: re PR fortran/30034 ([4.1 only] pure subroutine requires intent for procedure argument) X-Git-Tag: releases/gcc-4.3.0~7808 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=c5bfb0451df393fe3daedd21ed2619eb5f7f5f20;p=thirdparty%2Fgcc.git re PR fortran/30034 ([4.1 only] pure subroutine requires intent for procedure argument) 2006-12-28 Paul Thomas PR fortran/30034 * resolve.c (resolve_formal_arglist): Exclude the test for pointers and procedures for subroutine arguments as well as functions. PR fortran/30237 * intrinsic.c (remove_nullargs): Do not pass up arguments with a label. If the actual has a label and the formal has a type then emit an error. 2006-12-28 Paul Thomas PR fortran/30034 * gfortran.dg/pure_formal_proc_1.f90: New test. PR fortran/30237 * gfortran.dg/intrinsic_actual_3.f90: New test. From-SVN: r120244 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 8d9fd6e0ab8a..f1042bcc8e94 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2006-12-28 Paul Thomas + + PR fortran/30034 + * resolve.c (resolve_formal_arglist): Exclude the test for + pointers and procedures for subroutine arguments as well as + functions. + + PR fortran/30237 + * intrinsic.c (remove_nullargs): Do not pass up arguments with + a label. If the actual has a label and the formal has a type + then emit an error. + 2006-12-27 Jerry DeLisle PR fortran/30014 diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index ea68d69e6c66..2ed42915b9d3 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -2782,7 +2782,7 @@ remove_nullargs (gfc_actual_arglist ** ap) { next = head->next; - if (head->expr == NULL) + if (head->expr == NULL && !head->label) { head->next = NULL; gfc_free_actual_arglist (head); @@ -2898,6 +2898,12 @@ do_sort: for (f = formal; f; f = f->next) { + if (f->actual && f->actual->label != NULL && f->ts.type) + { + gfc_error ("ALTERNATE RETURN not permitted at %L", where); + return FAILURE; + } + if (f->actual == NULL) { a = gfc_get_actual_arglist (); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 9794446d169b..2c71ae4c2d19 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -173,26 +173,20 @@ resolve_formal_arglist (gfc_symbol * proc) if (sym->attr.flavor == FL_UNKNOWN) gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name, &sym->declared_at); - if (gfc_pure (proc)) + if (gfc_pure (proc) && !sym->attr.pointer + && sym->attr.flavor != FL_PROCEDURE) { - if (proc->attr.function && !sym->attr.pointer - && sym->attr.flavor != FL_PROCEDURE - && sym->attr.intent != INTENT_IN) - + if (proc->attr.function && sym->attr.intent != INTENT_IN) gfc_error ("Argument '%s' of pure function '%s' at %L must be " "INTENT(IN)", sym->name, proc->name, &sym->declared_at); - if (proc->attr.subroutine && !sym->attr.pointer - && sym->attr.intent == INTENT_UNKNOWN) - - gfc_error - ("Argument '%s' of pure subroutine '%s' at %L must have " - "its INTENT specified", sym->name, proc->name, - &sym->declared_at); + if (proc->attr.subroutine && sym->attr.intent == INTENT_UNKNOWN) + gfc_error ("Argument '%s' of pure subroutine '%s' at %L must " + "have its INTENT specified", sym->name, proc->name, + &sym->declared_at); } - if (gfc_elemental (proc)) { if (sym->as != NULL) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 6912966cd821..7a5a719acda3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2006-12-28 Paul Thomas + + PR fortran/30034 + * gfortran.dg/pure_formal_proc_1.f90: New test. + + PR fortran/30237 + * gfortran.dg/intrinsic_actual_3.f90: New test. + 2006-12-27 Jerry DeLisle PR fortran/30014 diff --git a/gcc/testsuite/gfortran.dg/intrinsic_actual_3.f90 b/gcc/testsuite/gfortran.dg/intrinsic_actual_3.f90 new file mode 100644 index 000000000000..c2dd07cda5ae --- /dev/null +++ b/gcc/testsuite/gfortran.dg/intrinsic_actual_3.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } +! Tests the fix for PR30237 in which alternate returns in intrinsic +! actual arglists were quietly ignored. +! +! Contributed by Brooks Moses +! +program ar1 + interface random_seed + subroutine x (a, *) + integer a + end subroutine x + end interface random_seed + + real t1(2) + call cpu_time(*20) ! { dg-error "not permitted" } + call cpu_time(*20, t1(1)) ! { dg-error "Too many arguments" } +! This specific version is permitted by the generic interface. + call random_seed(i, *20) +! The new error gets overwritten but the diagnostic is clear enough. + call random_seed(i, *20, *30) ! { dg-error "not consistent" } + stop +20 write(*,*) t1 +30 stop +end diff --git a/gcc/testsuite/gfortran.dg/pure_formal_proc_1.f90 b/gcc/testsuite/gfortran.dg/pure_formal_proc_1.f90 new file mode 100644 index 000000000000..4a55563c878e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pure_formal_proc_1.f90 @@ -0,0 +1,16 @@ +! { dg-do compile } +! Test fix for PR30034 in which the legal, pure procedure formal +! argument was rejected as an error. +! +! Contgributed by Troban Trumsko +! + pure subroutine s_one ( anum, afun ) + integer, intent(in) :: anum + interface + pure function afun (k) result (l) + implicit none + integer, intent(in) :: k + integer :: l + end function afun + end interface +end subroutine s_one