OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/55763 (Issues with some simpler CLASS(*) programs) 

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.

From-SVN: r194886
This commit is contained in:
Tobias Burnus 2013-01-04 09:59:47 +01:00 committed by Tobias Burnus
parent 15115f7aa8
commit 576f6da639
4 changed files with 63 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/fortran/ChangeLog
View File

@ -1,3 +1,8 @@
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

38
gcc/fortran/decl.c
View File

@ -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;
}

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
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

20
gcc/testsuite/gfortran.dg/null_7.f90 Normal file
View File

@ -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