From 70987f6299983c5a764c37827a95f71f831087f0 Mon Sep 17 00:00:00 2001 From: Daniel Franke Date: Wed, 9 Jun 2010 17:36:33 -0400 Subject: [PATCH] re PR fortran/44347 (SELECT_REAL_KIND: Wrongly accepts non-scalar arguments) gcc/fortran/: 2010-06-09 Daniel Franke PR fortran/44347 * check.c (gfc_check_selected_real_kind): Verify that the actual arguments are scalar. gcc/testsuite/: 2010-06-09 Daniel Franke PR fortran/44347 * gfortran.dg/selected_real_kind_1.f90: New. From-SVN: r160506 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/check.c | 20 +++++++++++++++---- gcc/testsuite/ChangeLog | 5 +++++ .../gfortran.dg/selected_real_kind_1.f90 | 10 ++++++++++ 4 files changed, 37 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/selected_real_kind_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index cafbd314b2e..c67dd8f5879 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2010-06-09 Daniel Franke + + PR fortran/44347 + * check.c (gfc_check_selected_real_kind): Verify that the + actual arguments are scalar. + 2010-06-09 Daniel Franke PR fortran/44359 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 6a5c263ed50..81f3e24847b 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -2930,11 +2930,23 @@ gfc_check_selected_real_kind (gfc_expr *p, gfc_expr *r) return FAILURE; } - if (p != NULL && type_check (p, 0, BT_INTEGER) == FAILURE) - return FAILURE; + if (p) + { + if (type_check (p, 0, BT_INTEGER) == FAILURE) + return FAILURE; - if (r != NULL && type_check (r, 1, BT_INTEGER) == FAILURE) - return FAILURE; + if (scalar_check (p, 0) == FAILURE) + return FAILURE; + } + + if (r) + { + if (type_check (r, 1, BT_INTEGER) == FAILURE) + return FAILURE; + + if (scalar_check (r, 1) == FAILURE) + return FAILURE; + } return SUCCESS; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5dcee0fb166..d0154a9fe27 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-06-09 Daniel Franke + + PR fortran/44347 + * gfortran.dg/selected_real_kind_1.f90: New. + 2010-06-09 Daniel Franke PR fortran/44359 diff --git a/gcc/testsuite/gfortran.dg/selected_real_kind_1.f90 b/gcc/testsuite/gfortran.dg/selected_real_kind_1.f90 new file mode 100644 index 00000000000..0f40a595d2f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/selected_real_kind_1.f90 @@ -0,0 +1,10 @@ +! { dg-do "compile" } +! +! PR fortran/44347 - arguments of SELECTED_REAL_KIND shall be scalar +! Testcase contributed by Vittorio Zecca +! + + dimension ip(1), ir(1) + i = selected_real_kind(ip, i) ! { dg-error "must be a scalar" } + j = selected_real_kind(i, ir) ! { dg-error "must be a scalar" } +end -- 2.30.2