From 3b833dcda53c814695ce250f91ae769d20962d75 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sun, 21 Jul 2013 13:46:43 +0200 Subject: [PATCH] re PR fortran/57894 (min/max required actual argument missing) 2013-07-21 Tobias Burnus PR fortran/57894 * check.c (min_max_args): Add keyword= check. 2013-07-21 Tobias Burnus PR fortran/57894 * gfortran.dg/min_max_conformance_2.f90: New. From-SVN: r201092 --- gcc/fortran/ChangeLog | 5 ++ gcc/fortran/check.c | 74 +++++++++++++++++++++- gcc/testsuite/ChangeLog | 5 ++ .../gfortran.dg/min_max_conformance_2.f90 | 24 +++++++ 4 files changed, 105 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/min_max_conformance_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6c977b9491c..3e4ecb8e74a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2013-07-21 Tobias Burnus + + PR fortran/57894 + * check.c (min_max_args): Add keyword= check. + 2013-07-17 Mikael Morin Tobias Burnus diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 4024cd45652..884dc43b125 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -2328,16 +2328,85 @@ gfc_check_logical (gfc_expr *a, gfc_expr *kind) /* Min/max family. */ static bool -min_max_args (gfc_actual_arglist *arg) +min_max_args (gfc_actual_arglist *args) { - if (arg == NULL || arg->next == NULL) + gfc_actual_arglist *arg; + int i, j, nargs, *nlabels, nlabelless; + bool a1 = false, a2 = false; + + if (args == NULL || args->next == NULL) { gfc_error ("Intrinsic '%s' at %L must have at least two arguments", gfc_current_intrinsic, gfc_current_intrinsic_where); return false; } + if (!args->name) + a1 = true; + + if (!args->next->name) + a2 = true; + + nargs = 0; + for (arg = args; arg; arg = arg->next) + if (arg->name) + nargs++; + + if (nargs == 0) + return true; + + /* Note: Having a keywordless argument after an "arg=" is checked before. */ + nlabelless = 0; + nlabels = XALLOCAVEC (int, nargs); + for (arg = args, i = 0; arg; arg = arg->next, i++) + if (arg->name) + { + int n; + char *endp; + + if (arg->name[0] != 'a' || arg->name[1] < '1' || arg->name[1] > '9') + goto unknown; + n = strtol (&arg->name[1], &endp, 10); + if (endp[0] != '\0') + goto unknown; + if (n <= 0) + goto unknown; + if (n <= nlabelless) + goto duplicate; + nlabels[i] = n; + if (n == 1) + a1 = true; + if (n == 2) + a2 = true; + } + else + nlabelless++; + + if (!a1 || !a2) + { + gfc_error ("Missing '%s' argument to the %s intrinsic at %L", + !a1 ? "a1" : "a2", gfc_current_intrinsic, + gfc_current_intrinsic_where); + return false; + } + + /* Check for duplicates. */ + for (i = 0; i < nargs; i++) + for (j = i + 1; j < nargs; j++) + if (nlabels[i] == nlabels[j]) + goto duplicate; + return true; + +duplicate: + gfc_error ("Duplicate argument '%s' at %L to intrinsic %s", arg->name, + &arg->expr->where, gfc_current_intrinsic); + return false; + +unknown: + gfc_error ("Unknown argument '%s' at %L to intrinsic %s", arg->name, + &arg->expr->where, gfc_current_intrinsic); + return false; } @@ -2345,7 +2414,6 @@ static bool check_rest (bt type, int kind, gfc_actual_arglist *arglist) { gfc_actual_arglist *arg, *tmp; - gfc_expr *x; int m, n; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2787d67b17c..ad1d2749146 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-07-21 Tobias Burnus + + PR fortran/57894 + * gfortran.dg/min_max_conformance_2.f90: New. + 2013-07-20 Jakub Jelinek PR preprocessor/57620 diff --git a/gcc/testsuite/gfortran.dg/min_max_conformance_2.f90 b/gcc/testsuite/gfortran.dg/min_max_conformance_2.f90 new file mode 100644 index 00000000000..085206c492e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/min_max_conformance_2.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } +! +! PR fortran/57894 +! +! Contributed by Vittorio Zecca +! +print *, max(a2=2,a65=45,a2=5) ! { dg-error "has already appeared in the current argument list" } +print *, min(a1=2.0,a65=45.0,a2=5.0e0) ! OK +print *, max(a2=2,a65=45,a3=5) ! { dg-error "Missing 'a1' argument to the max intrinsic" } +print *, min(a1=2.0,a65=45.0,a3=5.0e0) ! { dg-error "Missing 'a2' argument to the min intrinsic" } +print *, min1(2.0,a1=45.0,a2=5.0e0) ! { dg-error "Duplicate argument 'a1'" } + +print *, max0(a1=2,a65a=45,a2=5) ! { dg-error "Unknown argument 'a65a'" } +print *, amax0(a1=2,as65=45,a2=5) ! { dg-error "Unknown argument 'as65'" } +print *, max1(a1=2,a2=45,5) ! { dg-error "Missing keyword name in actual argument list" } +print *, amax1(a1=2,a3=45,a4=5) ! { dg-error "Missing 'a2' argument" } +print *, dmax1(a1=2,a2=45,a4z=5) ! { dg-error "Unknown argument 'a4z'" } + +print *, min0(a1=2,a65a=45,a2=5) ! { dg-error "Unknown argument 'a65a'" } +print *, amin0(a1=2,as65=45,a2=5) ! { dg-error "Unknown argument 'as65'" } +print *, min1(a1=2,a2=45,5) ! { dg-error "Missing keyword name in actual argument list" } +print *, amin1(a1=2,a3=45,a4=5) ! { dg-error "Missing 'a2' argument" } +print *, dmin1(a1=2,a2=45,a4z=5) ! { dg-error "Unknown argument 'a4z'" } +end -- 2.11.4.GIT