From 6168fc435e1b56df4582cebe3de6b9cf71f9d55d Mon Sep 17 00:00:00 2001
From: "Steven G. Kargl" <kargl@gcc.gnu.org>
Date: Wed, 21 Jul 2010 22:34:07 +0000
Subject: [PATCH] re PR fortran/44929 ([OOP] Parsing error of derived type
name starting with 'REAL')
2010-07-21 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/44929
* Revert my commit r162325 for this PR.
From-SVN: r162386
---
gcc/fortran/ChangeLog | 5 +++
gcc/fortran/match.c | 38 +++++++++----------
gcc/testsuite/ChangeLog | 5 +++
.../gfortran.dg/allocate_derived_1.f90 | 2 +-
.../gfortran.dg/allocate_with_typespec.f90 | 38 -------------------
5 files changed, 30 insertions(+), 58 deletions(-)
delete mode 100644 gcc/testsuite/gfortran.dg/allocate_with_typespec.f90
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fa32e0bfa98b..1b3f555dd4a4 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2010-07-21 Steven G. Kargl <kargl@gcc.gnu.org>
+
+ PR fortran/44929
+ * Revert my commit r162325.
+
2010-07-21 Daniel Kraft <d@domob.eu>
* trans.h (gfc_get_return_label): Removed.
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 2fc73fe1f148..56e9d1d515dd 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -2706,25 +2706,6 @@ 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;
@@ -2766,6 +2747,25 @@ 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 2e4919c9e5aa..d284060a19b6 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-07-21 Steven G. Kargl <kargl@gcc.gnu.org>
+
+ PR fortran/44929
+ * Revert my commit r162325 for this PR.
+
2010-07-21 Jakub Jelinek <jakub@redhat.com>
PR debug/45015
diff --git a/gcc/testsuite/gfortran.dg/allocate_derived_1.f90 b/gcc/testsuite/gfortran.dg/allocate_derived_1.f90
index 08665abb2651..b9f6d5580a04 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 "not a nonprocedure pointer or an allocatable variable" }
+ allocate(tx :: x(5)) ! { dg-error "is not an accessible derived type" }
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
deleted file mode 100644
index 686abdb5b1bb..000000000000
--- a/gcc/testsuite/gfortran.dg/allocate_with_typespec.f90
+++ /dev/null
@@ -1,38 +0,0 @@
-!
-! { 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" } }
-
--
GitLab