diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/match.c | 38 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/allocate_derived_1.f90 | 2 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/allocate_with_typespec.f90 | 38 |
5 files changed, 70 insertions, 20 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 423a4f1e007..0c70c2b95ea 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2010-07-19 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/44929 + * fortran/match.c (match_type_spec): Check for derived type before + intrinsic types. + 2010-07-19 Paul Thomas <pault@gcc.gnu.org> PR fortran/42385 diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 56e9d1d515d..2fc73fe1f14 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2706,6 +2706,25 @@ match_type_spec (gfc_typespec *ts) gfc_clear_ts (ts); old_locus = gfc_current_locus; + m = match_derived_type_spec (ts); + if (m == MATCH_YES) + { + old_locus = gfc_current_locus; + if (gfc_match (" :: ") != MATCH_YES) + return MATCH_ERROR; + gfc_current_locus = old_locus; + /* Enfore F03:C401. */ + if (ts->u.derived->attr.abstract) + { + gfc_error ("Derived type '%s' at %L may not be ABSTRACT", + ts->u.derived->name, &old_locus); + return MATCH_ERROR; + } + return MATCH_YES; + } + + gfc_current_locus = old_locus; + if (gfc_match ("integer") == MATCH_YES) { ts->type = BT_INTEGER; @@ -2747,25 +2766,6 @@ match_type_spec (gfc_typespec *ts) goto kind_selector; } - m = match_derived_type_spec (ts); - if (m == MATCH_YES) - { - old_locus = gfc_current_locus; - if (gfc_match (" :: ") != MATCH_YES) - return MATCH_ERROR; - gfc_current_locus = old_locus; - /* Enfore F03:C401. */ - if (ts->u.derived->attr.abstract) - { - gfc_error ("Derived type '%s' at %L may not be ABSTRACT", - ts->u.derived->name, &old_locus); - return MATCH_ERROR; - } - return MATCH_YES; - } - else if (m == MATCH_ERROR && gfc_match (" :: ") == MATCH_YES) - return MATCH_ERROR; - /* If a type is not matched, simply return MATCH_NO. */ gfc_current_locus = old_locus; return MATCH_NO; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index aa5b316305e..4146f3bc168 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2010-07-19 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/44929 + * gfortran.dg/allocate_with_typespec.f90: New test. + * gfortran.dg/allocate_derived_1.f90: Update error message. + 2010-07-19 Jason Merrill <jason@redhat.com> PR c++/44996 diff --git a/gcc/testsuite/gfortran.dg/allocate_derived_1.f90 b/gcc/testsuite/gfortran.dg/allocate_derived_1.f90 index b9f6d5580a0..08665abb265 100644 --- a/gcc/testsuite/gfortran.dg/allocate_derived_1.f90 +++ b/gcc/testsuite/gfortran.dg/allocate_derived_1.f90 @@ -32,7 +32,7 @@ allocate(t1 :: x(2)) allocate(t2 :: x(3)) allocate(t3 :: x(4)) - allocate(tx :: x(5)) ! { dg-error "is not an accessible derived type" } + allocate(tx :: x(5)) ! { dg-error "not a nonprocedure pointer or an allocatable variable" } allocate(u0 :: x(6)) ! { dg-error "may not be ABSTRACT" } allocate(v1 :: x(7)) ! { dg-error "is type incompatible with typespec" } diff --git a/gcc/testsuite/gfortran.dg/allocate_with_typespec.f90 b/gcc/testsuite/gfortran.dg/allocate_with_typespec.f90 new file mode 100644 index 00000000000..686abdb5b1b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_with_typespec.f90 @@ -0,0 +1,38 @@ +! +! { dg-do compile } +! +! PR fortran/44929 +! +! The module is contributed by Satish.BD <bdsatish@gmail.com>. +! The subroutines are from Tobias Burnus and Steve Kargl. +! +module temp + + type, abstract :: abst + !! empty + end type abst + + type, extends(abst) :: real_type + !! empty + end type real_type + + contains + + function create(name) result(obj) + character(len=*), intent(in) :: name + class(abst), pointer :: obj + allocate(real_type :: obj) + end function create +end module temp + +subroutine z + real(8), allocatable :: r8 + allocate(real(kind=8) :: r8) +end subroutine z + +subroutine y + real(8), allocatable :: r8 + allocate(real(8) :: r8) +end subroutine y +! { dg-final { cleanup-modules "temp" } } + |