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  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/44929
	* fortran/match.c (match_type_spec): Check for derived type before
	intrinsic types.


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

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" } }
+