This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[PATCH] PR fortran/46152 -- fix namespace pollution in type-spec matching
- From: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Sat, 30 Oct 2010 20:32:59 -0700
- Subject: [PATCH] PR fortran/46152 -- fix namespace pollution in type-spec matching
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.
--
Steve
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;
}