Patchwork PR fortran/46152 -- fix namespace pollution in type-spec matching

login
register
mail settings
Submitter Steve Kargl
Date Oct. 31, 2010, 3:32 a.m.
Message ID <20101031033259.GA44499@troutmask.apl.washington.edu>
Download mbox | patch
Permalink /patch/69688/
State New
Headers show

Comments

Steve Kargl - Oct. 31, 2010, 3:32 a.m.
See the PR for a thorough discussion of the problem and
the fix.  The attached patch has been tested on i686-*-freebsd
without regression.  I plan to commit this within the next 
24 hours.

2010-10-30  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/46152
	* gfortran.dg/select_type_11.f03: Update dg-error phrase.
	* gfortran.dg/allocate_with_typespec_4.f90: New test.
	* gfortran.dg/allocate_with_typespec_1.f90: New test.
	* gfortran.dg/allocate_with_typespec_2.f: New test.
	* gfortran.dg/allocate_with_typespec_3.f90: New test.
	* gfortran.dg/allocate_derived_1.f90: Delete an obselescent test.
	* gfortran.dg/select_type_1.f03: Update dg-error phrase.

2010-10-30  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/46152
	* fortran/match.c (match_derived_type_spec): Reoplace gfc_match_symbol
	with a gfc_find_symbol to prevent namespace pollution.  Remove dead
	code.
	(match_type_spec): Remove parsing of '::'.  Collapse character
	kind checking to one location.
	(gfc_match_allocate): Use correct locus in error message.

Patch

Index: gcc/testsuite/gfortran.dg/select_type_11.f03
===================================================================
--- gcc/testsuite/gfortran.dg/select_type_11.f03	(revision 166091)
+++ gcc/testsuite/gfortran.dg/select_type_11.f03	(working copy)
@@ -19,7 +19,7 @@  contains
     class(vector_class),        intent(in)    :: v
 
     select type (v)
-    class is (bad_id)                    ! { dg-error "is not an accessible derived type" }
+    class is (bad_id)                    ! { dg-error " error in CLASS IS specification" }
        this%elements(:) = v%elements(:)  ! { dg-error "is not a member of" }
     end select
 
Index: gcc/testsuite/gfortran.dg/allocate_with_typespec_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_with_typespec_4.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/allocate_with_typespec_4.f90	(revision 0)
@@ -0,0 +1,28 @@ 
+! { dg-do compile }
+! { dg-options "-w" }
+subroutine not_an_f03_intrinsic
+
+   implicit none
+
+   byte, allocatable :: x, y(:)
+   real*8, allocatable :: x8, y8(:)
+   double complex :: z
+
+   type real_type
+      integer mytype
+   end type real_type
+
+   type(real_type), allocatable :: b, c(:)
+
+   allocate(byte :: x)            ! { dg-error "not a nonprocedure pointer or an allocatable" }
+   allocate(byte :: y(1))         ! { dg-error "not a nonprocedure pointer or an allocatable" }
+
+   allocate(real*8 :: x)          ! { dg-error "Invalid type-spec at" }
+   allocate(real*8 :: y(1))       ! { dg-error "Invalid type-spec at" }
+   allocate(real*4 :: x8)         ! { dg-error "Invalid type-spec at" }
+   allocate(real*4 :: y8(1))      ! { dg-error "Invalid type-spec at" }
+   allocate(double complex :: d1) ! { dg-error "not a nonprocedure pointer or an allocatable" }
+   allocate(real_type :: b)
+   allocate(real_type :: c(1))
+
+end subroutine not_an_f03_intrinsic
Index: gcc/testsuite/gfortran.dg/allocate_with_typespec_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_with_typespec_1.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/allocate_with_typespec_1.f90	(revision 0)
@@ -0,0 +1,121 @@ 
+! { dg-do compile }
+!
+! Allocation of arrays with a type-spec specification with implicit none.
+!
+subroutine implicit_none_test1
+
+   implicit none
+
+   real, allocatable :: x(:)
+   real(4), allocatable :: x4(:)
+   real(8), allocatable :: x8(:)
+   double precision, allocatable :: d1(:)
+   doubleprecision, allocatable :: d2(:)
+   character, allocatable :: c1(:)
+   character(len=4), allocatable :: c2(:)
+
+   type a
+      integer mytype
+   end type a
+
+   type(a), allocatable :: b(:)
+
+   allocate(real :: x(1))
+   allocate(real(4) :: x4(1))
+   allocate(real(8) :: x8(1))
+   allocate(double precision :: d1(1))
+   allocate(doubleprecision :: d2(1))
+   allocate(character :: c1(1))
+   allocate(character(len=4) :: c2(1))
+   allocate(a :: b(1))
+
+end subroutine implicit_none_test1
+!
+! Allocation of a scalar with a type-spec specification with implicit none
+!
+subroutine implicit_none_test2
+
+   implicit none
+
+   real, allocatable :: x
+   real(4), allocatable :: x4
+   real(8), allocatable :: x8
+   double precision, allocatable :: d1
+   doubleprecision, allocatable :: d2
+   character, allocatable :: c1
+   character(len=4), allocatable :: c2
+
+   type a
+      integer mytype
+   end type a
+
+   type(a), allocatable :: b
+
+   allocate(real :: x)
+   allocate(real(4) :: x4)
+   allocate(real(8) :: x8)
+   allocate(double precision :: d1)
+   allocate(doubleprecision :: d2)
+   allocate(character :: c1)
+   allocate(character(len=4) :: c2)
+   allocate(a :: b)
+
+end subroutine implicit_none_test2
+!
+! Allocation of arrays with a type-spec specification with implicit none.
+!
+subroutine implicit_test3
+
+   real, allocatable :: x(:)
+   real(4), allocatable :: x4(:)
+   real(8), allocatable :: x8(:)
+   double precision, allocatable :: d1(:)
+   doubleprecision, allocatable :: d2(:)
+   character, allocatable :: c1(:)
+   character(len=4), allocatable :: c2(:)
+
+   type a
+      integer mytype
+   end type a
+
+   type(a), allocatable :: b(:)
+
+   allocate(real :: x(1))
+   allocate(real(4) :: x4(1))
+   allocate(real(8) :: x8(1))
+   allocate(double precision :: d1(1))
+   allocate(doubleprecision :: d2(1))
+   allocate(character :: c1(1))
+   allocate(character(len=4) :: c2(1))
+   allocate(a :: b(1))
+
+end subroutine implicit_test3
+!
+! Allocation of a scalar with a type-spec specification without implicit none
+!
+subroutine implicit_test4
+
+   real, allocatable :: x
+   real(4), allocatable :: x4
+   real(8), allocatable :: x8
+   double precision, allocatable :: d1
+   doubleprecision, allocatable :: d2
+   character, allocatable :: c1
+   character(len=4), allocatable :: c2
+
+   type a
+      integer mytype
+   end type a
+
+   type(a), allocatable :: b
+
+   allocate(real :: x)
+   allocate(real(4) :: x4)
+   allocate(real(8) :: x8)
+   allocate(double precision :: d1)
+   allocate(doubleprecision :: d2)
+   allocate(character :: c1)
+   allocate(character(len=4) :: c2)
+   allocate(a :: b)
+
+end subroutine implicit_test4
Index: gcc/testsuite/gfortran.dg/allocate_with_typespec_2.f
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_with_typespec_2.f	(revision 0)
+++ gcc/testsuite/gfortran.dg/allocate_with_typespec_2.f	(revision 0)
@@ -0,0 +1,121 @@ 
+C { dg-do compile }
+C
+C Allocation of arrays with a type-spec specification with implicit none.
+C
+       subroutine implicit_none_test1
+
+          implicit none
+
+          real, allocatable :: x(:)
+          real(4), allocatable :: x4(:)
+          real(8), allocatable :: x8(:)
+          double precision, allocatable :: d1(:)
+          doubleprecision, allocatable :: d2(:)
+          character, allocatable :: c1(:)
+          character(len=4), allocatable :: c2(:)
+
+          type a
+             integer mytype
+          end type a
+
+          type(a), allocatable :: b(:)
+
+          allocate(real :: x(1))
+          allocate(real(4) :: x4(1))
+          allocate(real(8) :: x8(1))
+          allocate(double precision :: d1(1))
+          allocate(doubleprecision :: d2(1))
+          allocate(character :: c1(1))
+          allocate(character(len=4) :: c2(1))
+          allocate(a :: b(1))
+
+       end
+C
+C Allocation of a scalar with a type-spec specification with implicit none
+C
+       subroutine implicit_none_test2
+
+          implicit none
+
+          real, allocatable :: x
+          real(4), allocatable :: x4
+          real(8), allocatable :: x8
+          double precision, allocatable :: d1
+          doubleprecision, allocatable :: d2
+          character, allocatable :: c1
+          character(len=4), allocatable :: c2
+
+          type a
+             integer mytype
+          end type a
+
+          type(a), allocatable :: b
+
+          allocate(real :: x)
+          allocate(real(4) :: x4)
+          allocate(real(8) :: x8)
+          allocate(double precision :: d1)
+          allocate(doubleprecision :: d2)
+          allocate(character :: c1)
+          allocate(character(len=4) :: c2)
+          allocate(a :: b)
+
+       end subroutine implicit_none_test2
+C
+C Allocation of arrays with a type-spec specification with implicit none.
+C
+       subroutine implicit_test3
+
+          real, allocatable :: x(:)
+          real(4), allocatable :: x4(:)
+          real(8), allocatable :: x8(:)
+          double precision, allocatable :: d1(:)
+          doubleprecision, allocatable :: d2(:)
+          character, allocatable :: c1(:)
+          character(len=4), allocatable :: c2(:)
+
+          type a
+             integer mytype
+          end type a
+
+          type(a), allocatable :: b(:)
+
+          allocate(real :: x(1))
+          allocate(real(4) :: x4(1))
+          allocate(real(8) :: x8(1))
+          allocate(double precision :: d1(1))
+          allocate(doubleprecision :: d2(1))
+          allocate(character :: c1(1))
+          allocate(character(len=4) :: c2(1))
+          allocate(a :: b(1))
+
+       end
+C
+C Allocation of a scalar with a type-spec specification without implicit none
+C
+       subroutine implicit_test4
+
+          real, allocatable :: x
+          real(4), allocatable :: x4
+          real(8), allocatable :: x8
+          double precision, allocatable :: d1
+          doubleprecision, allocatable :: d2
+          character, allocatable :: c1
+          character(len=4), allocatable :: c2
+
+          type a
+             integer mytype
+          end type a
+
+          type(a), allocatable :: b
+
+          allocate(real :: x)
+          allocate(real(4) :: x4)
+          allocate(real(8) :: x8)
+          allocate(double precision :: d1)
+          allocate(doubleprecision :: d2)
+          allocate(character :: c1)
+          allocate(character(len=4) :: c2)
+          allocate(a :: b)
+
+       end
Index: gcc/testsuite/gfortran.dg/allocate_with_typespec_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_with_typespec_3.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/allocate_with_typespec_3.f90	(revision 0)
@@ -0,0 +1,107 @@ 
+! { dg-do compile }
+!
+! Allocation of arrays with a type-spec specification with implicit none.
+!
+subroutine implicit_none_test1
+
+   implicit none
+
+   real, allocatable :: x(:)
+   real(4), allocatable :: x4(:)
+   real(8), allocatable :: x8(:)
+   double precision, allocatable :: d1(:)
+   doubleprecision, allocatable :: d2(:)
+   character, allocatable :: c1(:)
+
+   type a
+      integer mytype
+   end type a
+
+   type(a), allocatable :: b(:)
+
+   allocate(complex :: x(1))       ! { dg-error "is type incompatible" }
+   allocate(real(8) :: x4(1))      ! { dg-error "differs from the kind type parameter" }
+   allocate(real(4) :: x8(1))      ! { dg-error "differs from the kind type parameter" }
+   allocate(double :: d1(1))       ! { dg-error "not a nonprocedure pointer or an allocatable" }
+   allocate(character(:) :: c1(1)) ! { dg-error "Syntax error in CHARACTER declaration" }
+   allocate(real :: b(1))          ! { dg-error "is type incompatible" }
+
+end subroutine implicit_none_test1
+!
+! Allocation of a scalar with a type-spec specification with implicit none
+!
+subroutine implicit_none_test2
+
+   implicit none
+
+   real, allocatable :: x
+   real(4), allocatable :: x4
+   real(8), allocatable :: x8
+   double precision, allocatable :: d1
+   character, allocatable :: c1
+
+   type a
+      integer mytype
+   end type a
+
+   type(a), allocatable :: b
+
+   allocate(complex :: x)       ! { dg-error "is type incompatible" }
+   allocate(real(8) :: x4)      ! { dg-error "differs from the kind type parameter" }
+   allocate(real(4) :: x8)      ! { dg-error "differs from the kind type parameter" }
+   allocate(double :: d1)       ! { dg-error "not a nonprocedure pointer or an allocatable" }
+   allocate(character(:) :: c1) ! { dg-error "Syntax error in CHARACTER declaration" }
+   allocate(real :: b)          ! { dg-error "is type incompatible" }
+
+end subroutine implicit_none_test2
+!
+! Allocation of arrays with a type-spec specification with implicit none.
+!
+subroutine implicit_test3
+
+   real, allocatable :: x(:)
+   real(4), allocatable :: x4(:)
+   real(8), allocatable :: x8(:)
+   double precision, allocatable :: d1(:)
+   doubleprecision, allocatable :: d2(:)
+   character, allocatable :: c1(:)
+
+   type a
+      integer mytype
+   end type a
+
+   type(a), allocatable :: b(:)
+
+   allocate(complex :: x(1))       ! { dg-error "is type incompatible" }
+   allocate(real(8) :: x4(1))      ! { dg-error "differs from the kind type parameter" }
+   allocate(real(4) :: x8(1))      ! { dg-error "differs from the kind type parameter" }
+   allocate(double :: d1(1))       ! { dg-error "not a nonprocedure pointer or an allocatable" }
+   allocate(character(:) :: c1(1)) ! { dg-error "Syntax error in CHARACTER declaration" }
+   allocate(real :: b(1))          ! { dg-error "is type incompatible" }
+
+end subroutine implicit_test3
+!
+! Allocation of a scalar with a type-spec specification without implicit none
+!
+subroutine implicit_test4
+
+   real, allocatable :: x
+   real(4), allocatable :: x4
+   real(8), allocatable :: x8
+   double precision, allocatable :: d1
+   character, allocatable :: c1
+
+   type a
+      integer mytype
+   end type a
+
+   type(a), allocatable :: b
+
+   allocate(complex :: x)       ! { dg-error "is type incompatible" }
+   allocate(real(8) :: x4)      ! { dg-error "differs from the kind type parameter" }
+   allocate(real(4) :: x8)      ! { dg-error "differs from the kind type parameter" }
+   allocate(double :: d1)       ! { dg-error "not a nonprocedure pointer or an allocatable" }
+   allocate(character(:) :: c1) ! { dg-error "Syntax error in CHARACTER declaration" }
+   allocate(real :: b)          ! { dg-error "is type incompatible" }
+
+end subroutine implicit_test4
Index: gcc/testsuite/gfortran.dg/allocate_derived_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_derived_1.f90	(revision 166091)
+++ gcc/testsuite/gfortran.dg/allocate_derived_1.f90	(working copy)
@@ -32,7 +32,6 @@ 
  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(u0 :: x(6))  ! { dg-error "may not be ABSTRACT" }
  allocate(v1 :: x(7))  ! { dg-error "is type incompatible with typespec" }
 
Index: gcc/testsuite/gfortran.dg/select_type_1.f03
===================================================================
--- gcc/testsuite/gfortran.dg/select_type_1.f03	(revision 166091)
+++ gcc/testsuite/gfortran.dg/select_type_1.f03	(working copy)
@@ -45,7 +45,7 @@ 
     print *,"a is TYPE(ts)"
   type is (t3)   ! { dg-error "must be an extension of" }
     print *,"a is TYPE(t3)"
-  type is (t4)   ! { dg-error "is not an accessible derived type" }
+  type is (t4)   ! { dg-error "error in TYPE IS specification" }
     print *,"a is TYPE(t3)"
   class is (t1)
     print *,"a is CLASS(t1)"
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c	(revision 166091)
+++ gcc/fortran/match.c	(working copy)
@@ -2711,26 +2711,25 @@  gfc_free_alloc_list (gfc_alloc *p)
 static match
 match_derived_type_spec (gfc_typespec *ts)
 {
+  char name[GFC_MAX_SYMBOL_LEN + 1];
   locus old_locus; 
   gfc_symbol *derived;
 
-  old_locus = gfc_current_locus; 
+  old_locus = gfc_current_locus;
 
-  if (gfc_match_symbol (&derived, 1) == MATCH_YES)
+  if (gfc_match ("%n", name) != MATCH_YES)
     {
-      if (derived->attr.flavor == FL_DERIVED)
-	{
-	  ts->type = BT_DERIVED;
-	  ts->u.derived = derived;
-	  return MATCH_YES;
-	}
-      else
-	{
-	  /* Enforce F03:C476.  */
-	  gfc_error ("'%s' at %L is not an accessible derived type",
-		     derived->name, &gfc_current_locus);
-	  return MATCH_ERROR;
-	}
+       gfc_current_locus = old_locus;
+       return MATCH_NO;
+    }
+
+  gfc_find_symbol (name, NULL, 1, &derived);
+
+  if (derived && derived->attr.flavor == FL_DERIVED)
+    {
+      ts->type = BT_DERIVED;
+      ts->u.derived = derived;
+      return MATCH_YES;
     }
 
   gfc_current_locus = old_locus; 
@@ -2752,17 +2751,12 @@  match_type_spec (gfc_typespec *ts)
   locus old_locus;
 
   gfc_clear_ts (ts);
-  gfc_gobble_whitespace();
+  gfc_gobble_whitespace ();
   old_locus = gfc_current_locus;
 
-  m = match_derived_type_spec (ts);
-  if (m == MATCH_YES)
+  if (match_derived_type_spec (ts) == MATCH_YES)
     {
-      old_locus = gfc_current_locus;
-      if (gfc_match (" :: ") != MATCH_YES)
-	return MATCH_ERROR;
-      gfc_current_locus = old_locus;
-      /* Enfore F03:C401.  */
+      /* Enforce F03:C401.  */
       if (ts->u.derived->attr.abstract)
 	{
 	  gfc_error ("Derived type '%s' at %L may not be ABSTRACT",
@@ -2771,10 +2765,6 @@  match_type_spec (gfc_typespec *ts)
 	}
       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)
     {
@@ -2807,7 +2797,13 @@  match_type_spec (gfc_typespec *ts)
   if (gfc_match ("character") == MATCH_YES)
     {
       ts->type = BT_CHARACTER;
-      goto char_selector;
+
+      m = gfc_match_char_spec (ts);
+
+      if (m == MATCH_NO)
+	m = MATCH_YES;
+
+      return m;
     }
 
   if (gfc_match ("logical") == MATCH_YES)
@@ -2836,15 +2832,6 @@  kind_selector:
     m = MATCH_YES;		/* No kind specifier found.  */
 
   return m;
-
-char_selector:
-
-  m = gfc_match_char_spec (ts);
-
-  if (m == MATCH_NO)
-    m = MATCH_YES;		/* No kind specifier found.  */
-
-  return m;
 }
 
 
@@ -2957,8 +2944,8 @@  gfc_match_allocate (void)
 		|| sym->ns->proc_name->attr.proc_pointer);
       if (b1 && b2 && !b3)
 	{
-	  gfc_error ("Allocate-object at %C is not a nonprocedure pointer "
-		     "or an allocatable variable");
+	  gfc_error ("Allocate-object at %L is not a nonprocedure pointer "
+		     "or an allocatable variable", &tail->expr->where);
 	  goto cleanup;
 	}