Fix -fpedantic combined with `F()' invocation,

        also -fugly-comma combined with `IARGC()' invocation:
        * bad.def (FFEBAD_NULL_ARGUMENT_W): New diagnostic.
        * expr.c (ffeexpr_finished_): Don't reject null expressions
        in the argument-expression context -- let outer context
        handle that.
        (ffeexpr_token_arguments_): Warn about null expressions
        here if -fpedantic (as appropriate).
        Obey -fugly-comma for only external-procedure invocations.

From-SVN: r17793

1 files changed, 68 insertions, 54 deletions

diff --git a/gcc/f/expr.c b/gcc/f/expr.c
index 86b1509..8f41f3d 100644
--- a/gcc/f/expr.c
+++ b/gcc/f/expr.c
@@ -12257,8 +12257,7 @@ again:				/* :::::::::::::::::::: */
 	default:
 	  break;
 	}
-      error = ((expr == NULL) && ffe_is_pedantic ())
-	|| ((expr != NULL) && (ffeinfo_rank (info) != 0));
+      error = (expr != NULL) && (ffeinfo_rank (info) != 0);
       break;
 
     case FFEEXPR_contextACTUALARG_:
@@ -18305,80 +18304,95 @@ ffeexpr_token_arguments_ (ffelexToken ft, ffebld expr, ffelexToken t)
   procedure = ffeexpr_stack_->exprstack;
   info = ffebld_info (procedure->u.operand);
 
-  if (ffeinfo_where (info) == FFEINFO_whereCONSTANT)
-    {				/* Statement function (or subroutine, if
-				   there was such a thing). */
-      if ((expr == NULL)
-	  && ((ffe_is_pedantic ()
-	       && (ffeexpr_stack_->expr != NULL))
-	      || (ffelex_token_type (t) == FFELEX_typeCOMMA)))
+  /* Is there an expression to add?  If the expression is nil,
+     it might still be an argument.  It is if:
+
+       -  The current token is comma, or
+
+       -  The -fugly-comma flag was specified *and* the procedure
+          being invoked is external.
+
+     Otherwise, if neither of the above is the case, just
+     ignore this (nil) expression.  */
+
+  if ((expr != NULL)
+      || (ffelex_token_type (t) == FFELEX_typeCOMMA)
+      || (ffe_is_ugly_comma ()
+	  && (ffeinfo_where (info) == FFEINFO_whereGLOBAL)))
+    {
+      /* This expression, even if nil, is apparently intended as an argument.  */
+
+      /* Internal procedure (CONTAINS, or statement function)?  */
+
+      if (ffeinfo_where (info) == FFEINFO_whereCONSTANT)
 	{
-	  if (ffebad_start (FFEBAD_NULL_ARGUMENT))
+	  if ((expr == NULL)
+	      && ffebad_start (FFEBAD_NULL_ARGUMENT))
 	    {
 	      ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
-		     ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+			   ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
 	      ffebad_here (1, ffelex_token_where_line (t),
 			   ffelex_token_where_column (t));
 	      ffebad_finish ();
 	    }
-	  if (ffeexpr_stack_->next_dummy != NULL)
-	    {			/* Don't bother if we're going to complain
-				   later! */
-	      expr = ffebld_new_conter
-		(ffebld_constant_new_integerdefault_val (0));
-	      ffebld_set_info (expr, ffeinfo_new_any ());
-	    }
-	}
 
-      if (expr == NULL)
-	;
-      else
-	{
-	  if (ffeexpr_stack_->next_dummy == NULL)
-	    {			/* Report later which was the first extra
-				   argument. */
-	      if (ffeexpr_stack_->tokens[1] == NULL)
-		{
-		  ffeexpr_stack_->tokens[1] = ffelex_token_use (ft);
-		  ffeexpr_stack_->num_args = 0;
-		}
-	      ++ffeexpr_stack_->num_args;	/* Count # of extra
-						   arguments. */
-	    }
+	  if (expr == NULL)
+	    ;
 	  else
 	    {
-	      if (ffeinfo_rank (ffebld_info (expr)) != 0)
+	      if (ffeexpr_stack_->next_dummy == NULL)
+		{			/* Report later which was the first extra argument. */
+		  if (ffeexpr_stack_->tokens[1] == NULL)
+		    {
+		      ffeexpr_stack_->tokens[1] = ffelex_token_use (ft);
+		      ffeexpr_stack_->num_args = 0;
+		    }
+		  ++ffeexpr_stack_->num_args;	/* Count # of extra arguments. */
+		}
+	      else
 		{
-		  if (ffebad_start (FFEBAD_ARRAY_AS_SFARG))
+		  if ((ffeinfo_rank (ffebld_info (expr)) != 0)
+		      && ffebad_start (FFEBAD_ARRAY_AS_SFARG))
 		    {
 		      ffebad_here (0,
-			ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
-		      ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+				   ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+				   ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
 		      ffebad_here (1, ffelex_token_where_line (ft),
 				   ffelex_token_where_column (ft));
 		      ffebad_string (ffesymbol_text (ffesymbol_sfdummyparent
-						 (ffebld_symter (ffebld_head
-					   (ffeexpr_stack_->next_dummy)))));
+						     (ffebld_symter (ffebld_head
+								     (ffeexpr_stack_->next_dummy)))));
 		      ffebad_finish ();
 		    }
+		  else
+		    {
+		      expr = ffeexpr_convert_expr (expr, ft,
+						   ffebld_head (ffeexpr_stack_->next_dummy),
+						   ffeexpr_stack_->tokens[0],
+						   FFEEXPR_contextLET);
+		      ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+		    }
+		  --ffeexpr_stack_->num_args;	/* Count down # of args. */
+		  ffeexpr_stack_->next_dummy
+		    = ffebld_trail (ffeexpr_stack_->next_dummy);
 		}
-	      else
-		{
-		  expr = ffeexpr_convert_expr (expr, ft,
-				   ffebld_head (ffeexpr_stack_->next_dummy),
-					       ffeexpr_stack_->tokens[0],
-					       FFEEXPR_contextLET);
-		  ffebld_append_item (&ffeexpr_stack_->bottom, expr);
-		}
-	      --ffeexpr_stack_->num_args;	/* Count down # of args. */
-	      ffeexpr_stack_->next_dummy
-		= ffebld_trail (ffeexpr_stack_->next_dummy);
 	    }
 	}
+      else
+	{
+	  if ((expr == NULL)
+	      && ffe_is_pedantic ()
+	      && ffebad_start (FFEBAD_NULL_ARGUMENT_W))
+	    {
+	      ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+			   ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+	      ffebad_here (1, ffelex_token_where_line (t),
+			   ffelex_token_where_column (t));
+	      ffebad_finish ();
+	    }
+	  ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+	}
     }
-  else if ((expr != NULL) || ffe_is_ugly_comma ()
-	   || (ffelex_token_type (t) == FFELEX_typeCOMMA))
-    ffebld_append_item (&ffeexpr_stack_->bottom, expr);
 
   switch (ffelex_token_type (t))
     {