[multiple changes]

2015-07-04  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/66725
	* io.c (is_char_type): New function to test for BT_CHARACTER
	(gfc_match_open, gfc_match_close, match_dt_element): Use it.


2015-07-03  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/66725
	* gfortran.dg/pr66725.f90: New test.

From-SVN: r225415

1 files changed, 80 insertions, 1 deletions

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 0ac4f4a..fe3edb9 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -1242,6 +1242,19 @@ gfc_match_format (void)
 }
 
 
+static bool
+is_char_type (const char *name, gfc_expr *e)
+{
+  if (e->ts.type != BT_CHARACTER)
+    {
+      gfc_error ("%s requires a scalar-default-char-expr at %L",
+		   name, &e->where);
+      return false;
+    }
+  return true;
+}
+
+
 /* Match an expression I/O tag of some sort.  */
 
 static match
@@ -1870,6 +1883,9 @@ gfc_match_open (void)
       static const char *access_f2003[] = { "STREAM", NULL };
       static const char *access_gnu[] = { "APPEND", NULL };
 
+      if (!is_char_type ("ACCESS", open->access))
+	goto cleanup;
+
       if (!compare_to_allowed_values ("ACCESS", access_f95, access_f2003,
 				      access_gnu,
 				      open->access->value.character.string,
@@ -1882,6 +1898,9 @@ gfc_match_open (void)
     {
       static const char *action[] = { "READ", "WRITE", "READWRITE", NULL };
 
+      if (!is_char_type ("ACTION", open->action))
+	goto cleanup;
+
       if (!compare_to_allowed_values ("ACTION", action, NULL, NULL,
 				      open->action->value.character.string,
 				      "OPEN", warn))
@@ -1895,6 +1914,9 @@ gfc_match_open (void)
 			   "not allowed in Fortran 95"))
 	goto cleanup;
 
+      if (!is_char_type ("ASYNCHRONOUS", open->asynchronous))
+	goto cleanup;
+
       if (open->asynchronous->expr_type == EXPR_CONSTANT)
 	{
 	  static const char * asynchronous[] = { "YES", "NO", NULL };
@@ -1913,6 +1935,9 @@ gfc_match_open (void)
 			   "not allowed in Fortran 95"))
 	goto cleanup;
 
+      if (!is_char_type ("BLANK", open->blank))
+	goto cleanup;
+
       if (open->blank->expr_type == EXPR_CONSTANT)
 	{
 	  static const char *blank[] = { "ZERO", "NULL", NULL };
@@ -1931,6 +1956,9 @@ gfc_match_open (void)
 			   "not allowed in Fortran 95"))
 	goto cleanup;
 
+      if (!is_char_type ("DECIMAL", open->decimal))
+	goto cleanup;
+
       if (open->decimal->expr_type == EXPR_CONSTANT)
 	{
 	  static const char * decimal[] = { "COMMA", "POINT", NULL };
@@ -1949,6 +1977,9 @@ gfc_match_open (void)
 	{
 	  static const char *delim[] = { "APOSTROPHE", "QUOTE", "NONE", NULL };
 
+	if (!is_char_type ("DELIM", open->delim))
+	  goto cleanup;
+
 	  if (!compare_to_allowed_values ("DELIM", delim, NULL, NULL,
 					  open->delim->value.character.string,
 					  "OPEN", warn))
@@ -1962,7 +1993,10 @@ gfc_match_open (void)
       if (!gfc_notify_std (GFC_STD_F2003, "ENCODING= at %C "
 			   "not allowed in Fortran 95"))
 	goto cleanup;
-    
+
+      if (!is_char_type ("ENCODING", open->encoding))
+	goto cleanup;
+
       if (open->encoding->expr_type == EXPR_CONSTANT)
 	{
 	  static const char * encoding[] = { "DEFAULT", "UTF-8", NULL };
@@ -1979,6 +2013,9 @@ gfc_match_open (void)
     {
       static const char *form[] = { "FORMATTED", "UNFORMATTED", NULL };
 
+      if (!is_char_type ("FORM", open->form))
+	goto cleanup;
+
       if (!compare_to_allowed_values ("FORM", form, NULL, NULL,
 				      open->form->value.character.string,
 				      "OPEN", warn))
@@ -1990,6 +2027,9 @@ gfc_match_open (void)
     {
       static const char *pad[] = { "YES", "NO", NULL };
 
+      if (!is_char_type ("PAD", open->pad))
+	goto cleanup;
+
       if (!compare_to_allowed_values ("PAD", pad, NULL, NULL,
 				      open->pad->value.character.string,
 				      "OPEN", warn))
@@ -2001,6 +2041,9 @@ gfc_match_open (void)
     {
       static const char *position[] = { "ASIS", "REWIND", "APPEND", NULL };
 
+      if (!is_char_type ("POSITION", open->position))
+	goto cleanup;
+
       if (!compare_to_allowed_values ("POSITION", position, NULL, NULL,
 				      open->position->value.character.string,
 				      "OPEN", warn))
@@ -2014,6 +2057,9 @@ gfc_match_open (void)
 			   "not allowed in Fortran 95"))
       goto cleanup;
 
+      if (!is_char_type ("ROUND", open->round))
+	goto cleanup;
+
       if (open->round->expr_type == EXPR_CONSTANT)
 	{
 	  static const char * round[] = { "UP", "DOWN", "ZERO", "NEAREST",
@@ -2034,6 +2080,9 @@ gfc_match_open (void)
 			   "not allowed in Fortran 95"))
 	goto cleanup;
 
+      if (!is_char_type ("SIGN", open->sign))
+	goto cleanup;
+
       if (open->sign->expr_type == EXPR_CONSTANT)
 	{
 	  static const char * sign[] = { "PLUS", "SUPPRESS", "PROCESSOR_DEFINED",
@@ -2071,6 +2120,9 @@ gfc_match_open (void)
       static const char *status[] = { "OLD", "NEW", "SCRATCH",
 	"REPLACE", "UNKNOWN", NULL };
 
+      if (!is_char_type ("STATUS", open->status))
+	goto cleanup;
+
       if (!compare_to_allowed_values ("STATUS", status, NULL, NULL,
 				      open->status->value.character.string,
 				      "OPEN", warn))
@@ -2256,6 +2308,9 @@ gfc_match_close (void)
     {
       static const char *status[] = { "KEEP", "DELETE", NULL };
 
+      if (!is_char_type ("STATUS", close->status))
+	goto cleanup;
+
       if (!compare_to_allowed_values ("STATUS", status, NULL, NULL,
 				      close->status->value.character.string,
 				      "CLOSE", warn))
@@ -2708,6 +2763,7 @@ match_dt_element (io_kind k, gfc_dt *dt)
   m = match_out_tag (&tag_iomsg, &dt->iomsg);
   if (m != MATCH_NO)
     return m;
+
   m = match_out_tag (&tag_iostat, &dt->iostat);
   if (m != MATCH_NO)
     return m;
@@ -3305,6 +3361,9 @@ if (condition) \
 	  return MATCH_ERROR;
 	}
 
+      if (!is_char_type ("ASYNCHRONOUS", dt->asynchronous))
+	return MATCH_ERROR;
+
       if (!compare_to_allowed_values
 		("ASYNCHRONOUS", asynchronous, NULL, NULL,
 		 dt->asynchronous->value.character.string,
@@ -3334,6 +3393,9 @@ if (condition) \
 	{
 	  static const char * decimal[] = { "COMMA", "POINT", NULL };
 
+      if (!is_char_type ("DECIMAL", dt->decimal))
+	return MATCH_ERROR;
+
 	  if (!compare_to_allowed_values ("DECIMAL", decimal, NULL, NULL,
 					  dt->decimal->value.character.string,
 					  io_kind_name (k), warn))
@@ -3351,10 +3413,14 @@ if (condition) \
 			   "not allowed in Fortran 95"))
 	return MATCH_ERROR;
 
+      if (!is_char_type ("BLANK", dt->blank))
+	return MATCH_ERROR;
+
       if (dt->blank->expr_type == EXPR_CONSTANT)
 	{
 	  static const char * blank[] = { "NULL", "ZERO", NULL };
 
+
 	  if (!compare_to_allowed_values ("BLANK", blank, NULL, NULL,
 					  dt->blank->value.character.string,
 					  io_kind_name (k), warn))
@@ -3372,6 +3438,9 @@ if (condition) \
 			   "not allowed in Fortran 95"))
 	return MATCH_ERROR;
 
+      if (!is_char_type ("PAD", dt->pad))
+	return MATCH_ERROR;
+
       if (dt->pad->expr_type == EXPR_CONSTANT)
 	{
 	  static const char * pad[] = { "YES", "NO", NULL };
@@ -3393,6 +3462,9 @@ if (condition) \
 			   "not allowed in Fortran 95"))
 	return MATCH_ERROR;
 
+      if (!is_char_type ("ROUND", dt->round))
+	return MATCH_ERROR;
+
       if (dt->round->expr_type == EXPR_CONSTANT)
 	{
 	  static const char * round[] = { "UP", "DOWN", "ZERO", "NEAREST",
@@ -3412,6 +3484,10 @@ if (condition) \
       if (gfc_notify_std (GFC_STD_F2003, "SIGN= at %C "
 	  "not allowed in Fortran 95") == false)
 	return MATCH_ERROR;  */
+
+      if (!is_char_type ("SIGN", dt->sign))
+	return MATCH_ERROR;
+
       if (dt->sign->expr_type == EXPR_CONSTANT)
 	{
 	  static const char * sign[] = { "PLUS", "SUPPRESS", "PROCESSOR_DEFINED",
@@ -3438,6 +3514,9 @@ if (condition) \
 			   "not allowed in Fortran 95"))
 	return MATCH_ERROR;
 
+      if (!is_char_type ("DELIM", dt->delim))
+	return MATCH_ERROR;
+
       if (dt->delim->expr_type == EXPR_CONSTANT)
 	{
 	  static const char *delim[] = { "APOSTROPHE", "QUOTE", "NONE", NULL };