2014-01-04 Tobias Burnus <burnus@net-b.de>

        PR fortran/55763
        * decl.c (gfc_match_null): Parse and reject MOLD.

2014-01-04  Tobias Burnus  <burnus@net-b.de>

        PR fortran/55763
        * gfortran.dg/null_7.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@194886 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 591a289..5c0d6d4 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,10 @@
 2013-01-04  Tobias Burnus  <burnus@net-b.de>
 
+       PR fortran/55763
+       * decl.c (gfc_match_null): Parse and reject MOLD.
+
+2013-01-04  Tobias Burnus  <burnus@net-b.de>
+
        PR fortran/55854
        PR fortran/55763
        * class.c (gfc_class_null_initializer): Fix finding the vtab.

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 5ed8388..fc86efb 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1,5 +1,6 @@
 /* Declaration statement matcher
-   Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
+   Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011,
+   2012, 2013
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -1671,11 +1672,31 @@ match
 gfc_match_null (gfc_expr **result)
 {
   gfc_symbol *sym;
-  match m;
+  match m, m2 = MATCH_NO;
 
-  m = gfc_match (" null ( )");
-  if (m != MATCH_YES)
-    return m;
+  if ((m = gfc_match (" null ( )")) == MATCH_ERROR)
+    return MATCH_ERROR;
+
+  if (m == MATCH_NO)
+    {
+      locus old_loc;
+      char name[GFC_MAX_SYMBOL_LEN + 1];
+
+      if ((m2 = gfc_match (" null (", name)) != MATCH_YES)
+       return m2;
+
+      old_loc = gfc_current_locus;
+      if ((m2 = gfc_match (" %n ) ", name)) == MATCH_ERROR)
+       return MATCH_ERROR;
+      if (m2 != MATCH_YES
+         && ((m2 = gfc_match (" mold = %n )", name)) == MATCH_ERROR))
+       return MATCH_ERROR;
+      if (m2 == MATCH_NO)
+       {
+         gfc_current_locus = old_loc;
+         return MATCH_NO;
+       }
+    }
 
   /* The NULL symbol now has to be/become an intrinsic function.  */
   if (gfc_get_symbol ("null", NULL, &sym))
@@ -1694,6 +1715,13 @@ gfc_match_null (gfc_expr **result)
 
   *result = gfc_get_null_expr (&gfc_current_locus);
 
+  /* Invalid per F2008, C512.  */
+  if (m2 == MATCH_YES)
+    {
+      gfc_error ("NULL() initialization at %C may not have MOLD");
+      return MATCH_ERROR;
+    }
+
   return MATCH_YES;
 }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5357e0b..2594b26 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2013-01-04  Tobias Burnus  <burnus@net-b.de>
 
+       PR fortran/55763
+       * gfortran.dg/null_7.f90: New.
+
+2013-01-04  Tobias Burnus  <burnus@net-b.de>
+
        PR fortran/55854
        PR fortran/55763
        * gfortran.dg/unlimited_polymorphic_3.f03: Remove invalid code.

diff --git a/gcc/testsuite/gfortran.dg/null_7.f90 b/gcc/testsuite/gfortran.dg/null_7.f90
new file mode 100644 (file)
index 0000000..d6d77d2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/null_7.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+!
+! PR fortran/55763
+!
+
+implicit none
+integer, pointer :: x
+class(*), pointer :: y
+integer, pointer :: p1 => null(x) ! { dg-error "NULL.. initialization at .1. may not have MOLD" }
+integer, pointer :: p2 => null(mold=x) ! { dg-error "NULL.. initialization at .1. may not have MOLD" }
+class(*), pointer :: p3 =>null(x) ! { dg-error "NULL.. initialization at .1. may not have MOLD" }
+type t
+  real, pointer :: a1 => null(x) ! { dg-error "NULL.. initialization at .1. may not have MOLD" }
+  real, pointer :: a2 => null ( mold = x) ! { dg-error "NULL.. initialization at .1. may not have MOLD" }
+  class(*), pointer :: a3 => null(mold = x )  ! { dg-error "NULL.. initialization at .1. may not have MOLD" }
+end type t
+
+x => null(x) ! OK
+y => null(y) ! OK
+end