OSDN Git Service

2010-07-30 Janus Weil <janus@gcc.gnu.org>
authorjanus <janus@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 30 Jul 2010 17:50:28 +0000 (17:50 +0000)
committerjanus <janus@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 30 Jul 2010 17:50:28 +0000 (17:50 +0000)
    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.

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

gcc/fortran/ChangeLog
gcc/fortran/match.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/allocate_derived_3.f90 [new file with mode: 0644]

index 04676ee..bf7d4d1 100644 (file)
@@ -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.
index bd73929..a37a679 100644 (file)
@@ -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;
index b410475..0a181e8 100644 (file)
@@ -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 (file)
index 0000000..0cd1511
--- /dev/null
@@ -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