From 293dffcaf9aba66d88f5a02124e37a2ad7861a55 Mon Sep 17 00:00:00 2001 From: burnus Date: Wed, 22 May 2013 11:13:17 +0000 Subject: [PATCH] 2013-05-22 Tobias Burnus PR fortran/57338 * intrinsic.c (do_check): Move some checks to ... (do_ts29113_check): ... this new function. (check_specific, gfc_intrinsic_sub_interface): Call it. 2013-05-22 Tobias Burnus PR fortran/57338 * gfortran.dg/assumed_type_6.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@199192 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 9 +++++- gcc/fortran/intrinsic.c | 41 ++++++++++++++++++++-------- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/assumed_type_6.f90 | 12 ++++++++ 4 files changed, 55 insertions(+), 12 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/assumed_type_6.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 89d83cf..6fb27dc 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2013-05-22 Tobias Burnus + + PR fortran/57338 + * intrinsic.c (do_check): Move some checks to ... + (do_ts29113_check): ... this new function. + (check_specific, gfc_intrinsic_sub_interface): Call it. + 2013-05-22 Janne Blomqvist * intrinsic.texi (RANDOM_SEED): Improve example. @@ -5,7 +12,7 @@ 2013-05-21 Tobias Burnus PR fortran/57035 - * intrinsic.c (do_check): Add contraint check for + * intrinsic.c (do_check): Add constraint check for NO_ARG_CHECK, assumed rank and assumed type. * gfortran.texi (NO_ARG_CHECK): Minor wording change, allow PRESENT intrinsic. diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index ddf9d80..3251ebb 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -174,21 +174,14 @@ find_char_conv (gfc_typespec *from, gfc_typespec *to) } -/* Interface to the check functions. We break apart an argument list - and call the proper check function rather than forcing each - function to manipulate the argument list. */ +/* Check TS29113, C407b for assumed type and C535b for assumed-rank, + and a likewise check for NO_ARG_CHECK. */ static bool -do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg) +do_ts29113_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg) { - gfc_expr *a1, *a2, *a3, *a4, *a5; gfc_actual_arglist *a; - if (arg == NULL) - return (*specific->check.f0) (); - - /* Check TS29113, C407b for assumed type and C535b for assumed-rank, - and a likewise check for NO_ARG_CHECK. */ for (a = arg; a; a = a->next) { if (!a->expr) @@ -242,6 +235,22 @@ do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg) } } + return true; +} + + +/* Interface to the check functions. We break apart an argument list + and call the proper check function rather than forcing each + function to manipulate the argument list. */ + +static bool +do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg) +{ + gfc_expr *a1, *a2, *a3, *a4, *a5; + + if (arg == NULL) + return (*specific->check.f0) (); + a1 = arg->expr; arg = arg->next; if (arg == NULL) @@ -4038,11 +4047,18 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag) || specific->check.f1m == gfc_check_min_max_integer || specific->check.f1m == gfc_check_min_max_real || specific->check.f1m == gfc_check_min_max_double) - return (*specific->check.f1m) (*ap); + { + if (!do_ts29113_check (specific, *ap)) + return false; + return (*specific->check.f1m) (*ap); + } if (!sort_actual (specific->name, ap, specific->formal, &expr->where)) return false; + if (!do_ts29113_check (specific, *ap)) + return false; + if (specific->check.f3ml == gfc_check_minloc_maxloc) /* This is special because we might have to reorder the argument list. */ t = gfc_check_minloc_maxloc (*ap); @@ -4352,6 +4368,9 @@ gfc_intrinsic_sub_interface (gfc_code *c, int error_flag) if (!sort_actual (name, &c->ext.actual, isym->formal, &c->loc)) goto fail; + if (!do_ts29113_check (isym, c->ext.actual)) + goto fail; + if (isym->check.f1 != NULL) { if (!do_check (isym, c->ext.actual)) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index fc2a2f3..dcf16a4 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-05-22 Tobias Burnus + + PR fortran/57338 + * gfortran.dg/assumed_type_6.f90: New. + 2013-05-22 Paolo Carlini PR c++/57211 diff --git a/gcc/testsuite/gfortran.dg/assumed_type_6.f90 b/gcc/testsuite/gfortran.dg/assumed_type_6.f90 new file mode 100644 index 0000000..78ff849 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/assumed_type_6.f90 @@ -0,0 +1,12 @@ +! { dg-do compile } +! +! PR fortran/ +! +! Contributed by Vladimír Fuka +! +function avg(a) + integer :: avg + integer,intent(in) :: a(..) + + avg = sum(a)/size(a) ! { dg-error "Assumed-rank argument at .1. is only permitted as actual argument to intrinsic inquiry functions" } +end function -- 2.7.4