+2010-11-01 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.
+
2010-10-30 Thomas Koenig <tkoenig@gcc.gnu.org>
* gfortran.h (gfc_option_t): Replace dump_parse_tree by
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;
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",
}
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)
{
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)
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;
}
if (m == MATCH_ERROR)
goto cleanup;
else if (m == MATCH_NO)
- ts.type = BT_UNKNOWN;
+ {
+ char name[GFC_MAX_SYMBOL_LEN + 3];
+
+ if (gfc_match ("%n :: ", name) == MATCH_YES)
+ {
+ gfc_error ("Error in type-spec at %L", &old_locus);
+ goto cleanup;
+ }
+
+ ts.type = BT_UNKNOWN;
+ }
else
{
if (gfc_match (" :: ") == MATCH_YES)
|| 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;
}
+2010-11-01 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: Update dg-error phrase.
+ * gfortran.dg/select_type_1.f03: Update dg-error phrase.
+
2010-11-01 H.J. Lu <hongjiu.lu@intel.com>
Nathan Froyd <froydnj@codesourcery.com>
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 "Error in type-spec at" }
allocate(u0 :: x(6)) ! { dg-error "may not be ABSTRACT" }
allocate(v1 :: x(7)) ! { dg-error "is type incompatible with typespec" }
--- /dev/null
+! { 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
--- /dev/null
+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
--- /dev/null
+! { 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 "Error in type-spec at" }
+ 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 "Error in type-spec at" }
+ 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 "Error in type-spec" }
+ 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 "Error in type-spec at" }
+ allocate(character(:) :: c1) ! { dg-error "Syntax error in CHARACTER declaration" }
+ allocate(real :: b) ! { dg-error "is type incompatible" }
+
+end subroutine implicit_test4
--- /dev/null
+! { 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 "Error in type-spec at" }
+ allocate(byte :: y(1)) ! { dg-error "Error in type-spec at" }
+
+ 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
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)"
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
OSDN Git Service
