mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-19 21:31:42 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/46152 ([F03] ALLOCATE with type-spec fails for intrinsic types)

Browse Source 
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.

From-SVN: r166140
This commit is contained in:
Steven G. Kargl 2010-11-01 19:29:57 +00:00
parent e7e9eb2f27
commit 1fccc6c346
10 changed files with 438 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/fortran/ChangeLog
View File

@ -1,3 +1,13 @@
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

77
gcc/fortran/match.c
View File

@ -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)
@ -2832,15 +2828,6 @@ kind_selector:
m = gfc_match_kind_spec (ts, false);
if (m == MATCH_NO)
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. */
@ -2874,7 +2861,17 @@ gfc_match_allocate (void)
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)
@ -2957,8 +2954,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;
}

11
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,14 @@
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>

2
gcc/testsuite/gfortran.dg/allocate_derived_1.f90
View File

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

121
gcc/testsuite/gfortran.dg/allocate_with_typespec_1.f90 Normal file
View File

@ -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

121
gcc/testsuite/gfortran.dg/allocate_with_typespec_2.f Normal file
View File

@ -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

107
gcc/testsuite/gfortran.dg/allocate_with_typespec_3.f90 Normal file
View File

@ -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 "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

28
gcc/testsuite/gfortran.dg/allocate_with_typespec_4.f90 Normal file
View File

@ -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 "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

2
gcc/testsuite/gfortran.dg/select_type_1.f03
View File

@ -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)"

2
gcc/testsuite/gfortran.dg/select_type_11.f03
View File

@ -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