[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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index df7c86909de1a456d316c40cf38868c579f4358f..981f7427aeacc6cbe1c04c4cc1e3847b8b24e7bb 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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-02  David Edelsohn  <dje.gcc@gmail.com>
 
        * trans-common.c: Include <map> after system.h.

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 0ac4f4a03adb6cb565649fc787d17b3d2bd452af..fe3edb9f6e2c3736fecfadad4e9c9abddd92bae8 100644 (file)
--- 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 };

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 598918e3c73c07a01fcc819863b8a2af35436725..2b29e1a6759d03759a48e909bd97b7d4250d6305 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2015-07-04  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/66725
+       * gfortran.dg/pr66725.f90: New test.
+
 2015-07-03  Jason Merrill  <jason@redhat.com>
 
        * gcc.dg/plugin/wide-int_plugin.c (test_double_int_round_udiv):

diff --git a/gcc/testsuite/gfortran.dg/pr66725.f90 b/gcc/testsuite/gfortran.dg/pr66725.f90
new file mode 100644 (file)
index 0000000..8ad97f7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr66725.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! PR fortran/66725
+!
+program foo
+
+   open(unit=1,access = 999)        ! { dg-error "ACCESS requires" }
+   open(unit=1,action = 999)        ! { dg-error "ACTION requires" }
+   open(unit=1,asynchronous = 999)  ! { dg-error "ASYNCHRONOUS requires" }
+   open(unit=1,blank = 999)         ! { dg-error "BLANK requires" }
+   open(unit=1,decimal = 999)       ! { dg-error "DECIMAL requires" }
+   open(unit=1,delim = 999)         ! { dg-error "DELIM requires" }
+   open(unit=1,encoding = 999)      ! { dg-error "ENCODING requires" }
+   open(unit=1,form = 999)          ! { dg-error "FORM requires" }
+   open(unit=1,pad = 999)           ! { dg-error "PAD requires" }
+   open(unit=1,position = 999)      ! { dg-error "POSITION requires" }
+   open(unit=1,round = 999)         ! { dg-error "ROUND requires" }
+   open(unit=1,sign = 999)          ! { dg-error "SIGN requires" }
+   open(unit=1,status = 999)        ! { dg-error "STATUS requires" }
+
+   close(unit=1, status=999)        ! { dg-error "STATUS requires" }
+
+   write (unit=1, asynchronous=257) ! { dg-error "ASYNCHRONOUS requires" }
+   write (unit=1, delim=257)        ! { dg-error "DELIM requires" }
+   write (unit=1, decimal=257)      ! { dg-error "DECIMAL requires" }
+   write (unit=1, round=257)        ! { dg-error "ROUND requires" }
+   write (unit=1, sign=257)         ! { dg-error "SIGN requires" }
+
+   write (unit=1, blank=257)        ! { dg-error "BLANK requires" }
+   write (unit=1, pad=257)          ! { dg-error "PAD requires" }
+
+end program foo