re PR fortran/44929 ([OOP] Parsing error of derived type name starting with 'REAL')

2010-07-30  Janus Weil  <janus@gcc.gnu.org>
	    Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/44929
	* match.c (match_type_spec): Try to parse derived types before
	intrinsic types.


2010-07-30  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/44929
	* gfortran.dg/allocate_derived_3.f90: New.

Co-Authored-By: Steven G. Kargl <kargl@gcc.gnu.org>

From-SVN: r162724

4 files changed, 52 insertions, 20 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 04676ee..bf7d4d1 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2010-07-30  Janus Weil  <janus@gcc.gnu.org>
+	    Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/44929
+	* match.c (match_type_spec): Try to parse derived types before
+	intrinsic types.
+
 2010-07-30  Mikael Morin  <mikael@gcc.gnu.org>
 
 	* gfortran.h (gfc_release_symbol): New prototype.
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index bd73929..a37a679 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -2709,7 +2709,7 @@ match_derived_type_spec (gfc_typespec *ts)
    gfc_match_decl_type_spec() from decl.c, with the following exceptions:
    It only includes the intrinsic types from the Fortran 2003 standard
    (thus, neither BYTE nor forms like REAL*4 are allowed). Additionally,
-   the implicit_flag is not needed, so it was removed.  Derived types are
+   the implicit_flag is not needed, so it was removed. Derived types are
    identified by their name alone.  */
 
 static match
@@ -2719,8 +2719,30 @@ match_type_spec (gfc_typespec *ts)
   locus old_locus;
 
   gfc_clear_ts (ts);
+  gfc_gobble_whitespace();
   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;
+    }
+  else if (m == MATCH_ERROR && gfc_match (" :: ") == MATCH_YES)
+    return MATCH_ERROR;
+
+  gfc_current_locus = old_locus;
+
   if (gfc_match ("integer") == MATCH_YES)
     {
       ts->type = BT_INTEGER;
@@ -2762,25 +2784,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 b410475..0a181e8 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-07-30  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44929
+	* gfortran.dg/allocate_derived_3.f90: New.
+
 2010-07-30  Xinliang David Li  <davidxl@google.com>
 	PR tree-optimization/45121
 	* c-c++-common/uninit-17.c: Add -fno-ivops option.
diff --git a/gcc/testsuite/gfortran.dg/allocate_derived_3.f90 b/gcc/testsuite/gfortran.dg/allocate_derived_3.f90
new file mode 100644
index 0000000..0cd1511
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_derived_3.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+!
+! PR 44929: [OOP] Parsing error of derived type name starting with 'REAL'
+!
+! Contributed by Satish.BD <bdsatish@gmail.com>
+
+ type :: real_type
+ end type
+ class(real_type), allocatable :: obj
+ real(8), allocatable :: r8
+
+ allocate(real_type :: obj)
+
+ allocate( real(kind=8) :: r8)
+ allocate(real(8)  :: r8 )
+
+end