re PR fortran/14067 (no warning when character data statement overflows declared size)

2006-06-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/14067
	* data.c (create_character_intializer): Add warning message
	for truncated string.

	PR fortran/16943
	* symbol.c : Include flags.h.
	(gfc_add_type): If a procedure and types are the same do not
	throw an error unless standard is less than gnu or pedantic.

	PR fortran/20838
	* parse.c (parse_do_block): Error if named block do construct
	does not have a named enddo.

	PR fortran/27655
	* check.c (gfc_check_associated): Pick up EXPR_NULL for pointer
	as well as target and put error return at end of function.

2006-06-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/14067
	* gfortran.dg/data_char_1.f90: Add messages for truncated
	strings.

	PR fortran/16943
	* gfortran.dg/func_decl_2.f90: New test.

	PR fortran/20838
	* gfortran.dg/do_2.f90: New test.

	PR fortran/27655
	* gfortran.dg/associated_3.f90: New test.

From-SVN: r114385

5 files changed, 61 insertions, 10 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index cc040a6..abff6a2 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,22 @@
+2006-06-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/14067
+	* data.c (create_character_intializer): Add warning message
+	for truncated string.
+
+	PR fortran/16943
+	* symbol.c : Include flags.h.
+	(gfc_add_type): If a procedure and types are the same do not
+	throw an error unless standard is less than gnu or pedantic.
+
+	PR fortran/20838
+	* parse.c (parse_do_block): Error if named block do construct
+	does not have a named enddo.
+
+	PR fortran/27655
+	* check.c (gfc_check_associated): Pick up EXPR_NULL for pointer
+	as well as target and put error return at end of function.
+
 2006-06-03  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
 	* trans.c (gfc_msg_bounds, gfc_msg_fault, gfc_msg_wrong_return):
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index c68e59c..15278f4 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -499,11 +499,16 @@ gfc_check_associated (gfc_expr * pointer, gfc_expr * target)
   symbol_attribute attr;
   int i;
   try t;
+  locus *where;
+
+  where = &pointer->where;
 
   if (pointer->expr_type == EXPR_VARIABLE)
     attr = gfc_variable_attr (pointer, NULL);
   else if (pointer->expr_type == EXPR_FUNCTION)
     attr = pointer->symtree->n.sym->attr;
+  else if (pointer->expr_type == EXPR_NULL)
+    goto null_arg;
   else
     gcc_assert (0); /* Pointer must be a variable or a function.  */
 
@@ -519,13 +524,9 @@ gfc_check_associated (gfc_expr * pointer, gfc_expr * target)
   if (target == NULL)
     return SUCCESS;
 
+  where = &target->where;
   if (target->expr_type == EXPR_NULL)
-    {
-      gfc_error ("NULL pointer at %L is not permitted as actual argument "
-                 "of '%s' intrinsic function",
-                 &target->where, gfc_current_intrinsic);
-      return FAILURE;
-    }
+    goto null_arg;
 
   if (target->expr_type == EXPR_VARIABLE)
     attr = gfc_variable_attr (target, NULL);
@@ -565,6 +566,13 @@ gfc_check_associated (gfc_expr * pointer, gfc_expr * target)
           }
     }
   return t;
+
+null_arg:
+
+  gfc_error ("NULL pointer at %L is not permitted as actual argument "
+	     "of '%s' intrinsic function", where, gfc_current_intrinsic);
+  return FAILURE;
+
 }
 
 
diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c
index 9f256bc..c708bec 100644
--- a/gcc/fortran/data.c
+++ b/gcc/fortran/data.c
@@ -185,7 +185,12 @@ create_character_intializer (gfc_expr * init, gfc_typespec * ts,
   /* Copy the initial value.  */
   len = rvalue->value.character.length;
   if (len > end - start)
-    len = end - start;
+    {
+      len = end - start;
+      gfc_warning_now ("initialization string truncated to match variable "
+		       "at %L", &rvalue->where);
+    }
+
   memcpy (&dest[start], rvalue->value.character.string, len);
 
   /* Pad with spaces.  Substrings will already be blanked.  */
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 70c92b7..5b98d1d 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2282,6 +2282,15 @@ loop:
       break;
 
     case ST_IMPLIED_ENDDO:
+     /* If the do-stmt of this DO construct has a do-construct-name,
+	the corresponding end-do must be an end-do-stmt (with a matching
+	name, but in that case we must have seen ST_ENDDO first).
+	We only complain about this in pedantic mode.  */
+     if (gfc_current_block () != NULL)
+	gfc_error_now
+	  ("named block DO at %L requires matching ENDDO name",
+	   &gfc_current_block()->declared_at);
+
       break;
 
     default:
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 7acef42..63e45ec 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.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 "parse.h"
 
@@ -1178,9 +1179,18 @@ gfc_add_type (gfc_symbol * sym, gfc_typespec * ts, locus * where)
 
   if (sym->ts.type != BT_UNKNOWN)
     {
-      gfc_error ("Symbol '%s' at %L already has basic type of %s", sym->name,
-		 where, gfc_basic_typename (sym->ts.type));
-      return FAILURE;
+      const char *msg = "Symbol '%s' at %L already has basic type of %s";
+      if (!(sym->ts.type == ts->type
+	     && (sym->attr.flavor == FL_PROCEDURE || sym->attr.result))
+	   || gfc_notification_std (GFC_STD_GNU) == ERROR
+	   || pedantic)
+	{
+	  gfc_error (msg, sym->name, where, gfc_basic_typename (sym->ts.type));
+	  return FAILURE;
+	}
+      else if (gfc_notify_std (GFC_STD_GNU, msg, sym->name, where,
+			       gfc_basic_typename (sym->ts.type)) == FAILURE)
+	  return FAILURE;
     }
 
   flavor = sym->attr.flavor;