2013-07-21 Tobias Burnus <burnus@net-b.de>

        PR fortran/57894
        * check.c (min_max_args): Add keyword= check.

2013-07-21  Tobias Burnus  <burnus@net-b.de>

        PR fortran/57894
        * gfortran.dg/min_max_conformance_2.f90: New.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@201092 138bc75d-0d04-0410-961f-82ee72b054a4

4 files changed, 105 insertions, 3 deletions

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  <burnus@net-b.de>
+
+	PR fortran/57894
+	* check.c (min_max_args): Add keyword= check.
+
 2013-07-17  Mikael Morin  <mikael@gcc.gnu.org>
 	    Tobias Burnus  <burnus@net-b.de>
 
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  <burnus@net-b.de>
+
+	PR fortran/57894
+	* gfortran.dg/min_max_conformance_2.f90: New.
+
 2013-07-20  Jakub Jelinek  <jakub@redhat.com>
 
 	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