[committed] Backports of fortran/27981 and fortran/28548

[Steve Kargl]

I've committed the attached backported patches to the
4.1 branch.

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.
     
	PR fortran/27981
	* match.c (gfc_match_if):  Handle errors in assignment in simple if.

	* gfortran.dg/simpleif_2.f90: New test.

-- 
Steve
-------------- next part --------------
--- trunk/gcc/fortran/match.c	2006/06/23 19:37:58	114949
+++ trunk/gcc/fortran/match.c	2006/06/23 21:05:04	114950
@@ -1061,6 +1061,12 @@
   gfc_undo_symbols ();
   gfc_current_locus = old_loc;
 
+  /* m can be MATCH_NO or MATCH_ERROR, here.  For MATCH_NO, continue to
+     call the various matchers.  For MATCH_ERROR, a mangled assignment
+     was found.  */
+  if (m == MATCH_ERROR)
+    return MATCH_ERROR;
+
   gfc_match (" if ( %e ) ", &expr);	/* Guaranteed to match */
 
   m = gfc_match_pointer_assignment ();
-------------- next part --------------
Index: gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90	(revision 115942)
+++ gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90	(working copy)
@@ -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 @@
     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 @@
     B1 = 1
   end subroutine foobar
 
-END
\ No newline at end of file
+END
+
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 115942)
+++ gcc/fortran/resolve.c	(working copy)
@@ -23,6 +23,7 @@
 
 #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 @@
       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 @@
 /* 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 @@
       break;
     }
 
-  warn_unused_label (label->right);
+  warn_unused_fortran_label (label->right);
 }
 
 
@@ -6649,7 +6651,7 @@
 
   /* 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);