re PR fortran/28548 ([4.1 only] Optional argument failed)

2006-08-05  Steven G. Kargl <kargls@comcast.nt>

	PR fortran/28548
	* gfortran.dg/elemental_optional_args_1.f90: dg-error becomes
	dg-warning.  Add -pedantic option.

	* resolve.c(resolve_elemental_actual): Add flags.h to use -pedantic
	and exclude conversion functions in conditional.  Change gfc_error
	to gfc_warning.
	(warn_unused_label) Rename to ...
	(warn_unused_fortran_label) avoid warn_unused_label in flags.h.

From-SVN: r115963

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bb84735d21a980c3423f0b287b662f73075a9c34..7be47e2ea697dd40d0c9c0da0d9c92a9d4744d3f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2006-08-05  Steven G. Kargl <kargls@comcast.nt>
+
+       PR fortran/28548
+       * resolve.c(resolve_elemental_actual): Add flags.h to use -pedantic
+       and exclude conversion functions in conditional.  Change gfc_error
+       to gfc_warning.
+       (warn_unused_label) Rename to ...
+       (warn_unused_fortran_label) avoid warn_unused_label in flags.h.
+     
 2006-07-30  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
        * intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index aee04eccd6c5eb1f4fe9e361ece9aa3b3b43ed65..c327a82c9d0480eb886b32b3b3634b37ba6c5141 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -23,6 +23,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor,Boston, MA
 
 #include "config.h"
 #include "system.h"
+#include "flags.h"
 #include "gfortran.h"
 #include "arith.h"  /* For gfc_compare_expr().  */
 #include "dependency.h"
@@ -1007,18 +1008,19 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c)
       else if (isym)
        formal_optional = true;
 
-      if (arg->expr != NULL
+      if (pedantic && arg->expr != NULL
            && arg->expr->expr_type == EXPR_VARIABLE
            && arg->expr->symtree->n.sym->attr.optional
            && formal_optional
            && arg->expr->rank
-           && (set_by_optional || arg->expr->rank != rank)) 
+           && (set_by_optional || arg->expr->rank != rank)
+           && !(isym && isym->generic_id == GFC_ISYM_CONVERSION)) 
        {
-         gfc_error ("'%s' at %L is an array and OPTIONAL; it cannot "
-                    "therefore be an actual argument of an ELEMENTAL " 
-                    "procedure unless there is a non-optional argument "
-                    "with the same rank (12.4.1.5)",
-                    arg->expr->symtree->n.sym->name, &arg->expr->where);
+         gfc_warning ("'%s' at %L is an array and OPTIONAL; IF IT IS "
+                      "MISSING, it cannot be the actual argument of an "
+                      "ELEMENTAL procedure unless there is a non-optional"
+                      "argument with the same rank (12.4.1.5)",
+                      arg->expr->symtree->n.sym->name, &arg->expr->where);
          return FAILURE;
        }
     }
@@ -6100,12 +6102,12 @@ gfc_elemental (gfc_symbol * sym)
 /* Warn about unused labels.  */
 
 static void
-warn_unused_label (gfc_st_label * label)
+warn_unused_fortran_label (gfc_st_label * label)
 {
   if (label == NULL)
     return;
 
-  warn_unused_label (label->left);
+  warn_unused_fortran_label (label->left);
 
   if (label->defined == ST_LABEL_UNKNOWN)
     return;
@@ -6126,7 +6128,7 @@ warn_unused_label (gfc_st_label * label)
       break;
     }
 
-  warn_unused_label (label->right);
+  warn_unused_fortran_label (label->right);
 }
 
 
@@ -6649,7 +6651,7 @@ resolve_types (gfc_namespace * ns)
 
   /* Warn about unused labels.  */
   if (gfc_option.warn_unused_labels)
-    warn_unused_label (ns->st_labels);
+    warn_unused_fortran_label (ns->st_labels);
 
   gfc_resolve_uops (ns->uop_root);
     

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0cdbbefb0094265c72a75bd4a83bdb8484dc9c28..7aa23eb3e222ca108a788c743cfaf6c0a9a760dc 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2006-08-05  Steven G. Kargl <kargls@comcast.nt>
+
+       PR fortran/28548
+       * gfortran.dg/elemental_optional_args_1.f90: dg-error becomes
+       dg-warning.  Add -pedantic option.
+
 2006-08-05  Volker Reichelt  <reichelt@igpm.rwth-aachen.de>
 
        PR c/28502

diff --git a/gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90 b/gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90
index 258b6b0f76a0b4d4212fe518f8b940e94e02ab59..4f274baa20bf3ad4b4e1c1836cbc446bc90be7d2 100644 (file)
--- a/gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90
+++ b/gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90
@@ -1,4 +1,5 @@
 ! { dg-do compile }
+! { dg-options "-pedantic" }
 ! Check the fix for PR20893, in which actual arguments could violate: 
 ! "(5) If it is an array, it shall not be supplied as an actual argument to
 ! an elemental procedure unless an array of the same rank is supplied as an
@@ -21,19 +22,19 @@ CONTAINS
     end interface
 
 ! check an intrinsic function
-    write(6,*) MAX(A1,A2,A3) ! { dg-error "array and OPTIONAL" }
+    write(6,*) MAX(A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
     write(6,*) MAX(A1,A3,A2)
     write(6,*) MAX(A1,A4,A3)
 ! check an internal elemental function
-    write(6,*) foo(A1,A2,A3) ! { dg-error "array and OPTIONAL" }
+    write(6,*) foo(A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
     write(6,*) foo(A1,A3,A2)
     write(6,*) foo(A1,A4,A3)
 ! check an external elemental function
-    write(6,*) efoo(A1,A2,A3) ! { dg-error "array and OPTIONAL" }
+    write(6,*) efoo(A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
     write(6,*) efoo(A1,A3,A2)
     write(6,*) efoo(A1,A4,A3)
 ! check an elemental subroutine
-    call foobar (A1,A2,A3) ! { dg-error "array and OPTIONAL" } 
+    call foobar (A1,A2,A3) ! { dg-warning "array and OPTIONAL" } 
     call foobar (A1,A2,A4)
     call foobar (A1,A4,A4)
   END SUBROUTINE
@@ -49,4 +50,5 @@ CONTAINS
     B1 = 1
   end subroutine foobar
 
-END
\ No newline at end of file
+END
+