From: Tobias Burnus Date: Sat, 19 Jan 2008 15:41:04 +0000 (+0100) Subject: re PR fortran/34760 (PRIVATE variable not allowed as STAT variable in ALLOCATE) X-Git-Tag: releases/gcc-4.3.0~534 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=d7e2fcd0038214e3e3d9301fa7f22cccb54de009;p=thirdparty%2Fgcc.git re PR fortran/34760 (PRIVATE variable not allowed as STAT variable in ALLOCATE) 2008-01-19 Tobias Burnus PR fortran/34760 * primary.c (match_variable): Handle FL_UNKNOWN without uneducated guessing. (match_variable): Improve error message. 2008-01-19 Tobias Burnus PR fortran/34760 * gfortran.dg/implicit_11.f90: New. * gfortran.dg/allocate_stat.f90: Update dg-error pattern. * gfortran.dg/entry_15.f90: Ditto. * gfortran.dg/func_assign.f90: Ditto. * gfortran.dg/gomp/reduction3.f90: Ditto. * gfortran.dg/proc_assign_1.f90: Ditto. * gfortran.dg/interface_proc_end.f90: Use dg-error instead of dg-excess-errors. From-SVN: r131652 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 736c67f131b4..46c95e00f26b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2008-01-19 Tobias Burnus + + PR fortran/34760 + * primary.c (match_variable): Handle FL_UNKNOWN without + uneducated guessing. + (match_variable): Improve error message. + 2008-01-18 Tobias Burnus PR fortran/32616 diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 1d282f2b37c3..4e7d4a11506d 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -2521,12 +2521,22 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag) break; case FL_UNKNOWN: - if (sym->attr.access == ACCESS_PUBLIC - || sym->attr.access == ACCESS_PRIVATE) - break; - if (gfc_add_flavor (&sym->attr, FL_VARIABLE, - sym->name, NULL) == FAILURE) - return MATCH_ERROR; + { + sym_flavor flavor = FL_UNKNOWN; + + gfc_gobble_whitespace (); + + if (sym->attr.external || sym->attr.procedure + || sym->attr.function || sym->attr.subroutine) + flavor = FL_PROCEDURE; + else if (gfc_peek_char () != '(' || sym->ts.type != BT_UNKNOWN + || sym->attr.pointer || sym->as != NULL) + flavor = FL_VARIABLE; + + if (flavor != FL_UNKNOWN + && gfc_add_flavor (&sym->attr, flavor, sym->name, NULL) == FAILURE) + return MATCH_ERROR; + } break; case FL_PARAMETER: @@ -2553,7 +2563,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag) /* Fall through to error */ default: - gfc_error ("Expected VARIABLE at %C"); + gfc_error ("'%s' at %C is not a variable", sym->name); return MATCH_ERROR; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index b25f7f5c38a0..73c1e6084a0c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,16 @@ +2008-01-19 Tobias Burnus + + PR fortran/34760 + * gfortran.dg/implicit_11.f90: New. + * gfortran.dg/allocate_stat.f90: Update dg-error pattern. + * gfortran.dg/entry_15.f90: Ditto. + * gfortran.dg/func_assign.f90: Ditto. + * gfortran.dg/gomp/reduction3.f90: Ditto. + * gfortran.dg/proc_assign_1.f90: Ditto. + + * gfortran.dg/interface_proc_end.f90: Use dg-error instead + of dg-excess-errors. + 2008-01-18 Tobias Burnus PR fortran/32616 diff --git a/gcc/testsuite/gfortran.dg/allocate_stat.f90 b/gcc/testsuite/gfortran.dg/allocate_stat.f90 index 1361d779226a..94ec4303f816 100644 --- a/gcc/testsuite/gfortran.dg/allocate_stat.f90 +++ b/gcc/testsuite/gfortran.dg/allocate_stat.f90 @@ -38,7 +38,7 @@ function func2() result(res) implicit none real, pointer :: gain integer :: res - allocate (gain,STAT=func2) ! { dg-error "Expected VARIABLE" } + allocate (gain,STAT=func2) ! { dg-error "is not a variable" } deallocate(gain) res = 0 end function func2 diff --git a/gcc/testsuite/gfortran.dg/entry_15.f90 b/gcc/testsuite/gfortran.dg/entry_15.f90 index ed0eb4b0c445..0449695e7c86 100644 --- a/gcc/testsuite/gfortran.dg/entry_15.f90 +++ b/gcc/testsuite/gfortran.dg/entry_15.f90 @@ -16,7 +16,7 @@ function func(a) func = a*8 return entry ent(a) result(func2) - ent = -a*4.0 ! { dg-error "Expected VARIABLE" } + ent = -a*4.0 ! { dg-error "is not a variable" } return end function func end module m2 @@ -31,7 +31,7 @@ function func(a) result(res) res = a*12 return entry ent(a) result(func2) - ent = -a*6.0 ! { dg-error "Expected VARIABLE" } + ent = -a*6.0 ! { dg-error "is not a variable" } return end function func end module m3 diff --git a/gcc/testsuite/gfortran.dg/func_assign.f90 b/gcc/testsuite/gfortran.dg/func_assign.f90 index 3651dfded2ee..1f7407c7ccfe 100644 --- a/gcc/testsuite/gfortran.dg/func_assign.f90 +++ b/gcc/testsuite/gfortran.dg/func_assign.f90 @@ -23,8 +23,8 @@ contains subroutine sub() end subroutine sub end interface - sub = 'a' ! { dg-error "Expected VARIABLE" } - fun = 4.4 ! { dg-error "Expected VARIABLE" } + sub = 'a' ! { dg-error "is not a variable" } + fun = 4.4 ! { dg-error "is not a variable" } funget = 4 ! { dg-error "is not a VALUE" } bar = 5 ! { dg-error "is not a VALUE" } end subroutine a diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction3.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction3.f90 index 50f6450ac2f7..abd6d04415d2 100644 --- a/gcc/testsuite/gfortran.dg/gomp/reduction3.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/reduction3.f90 @@ -48,7 +48,7 @@ subroutine f4 integer :: i, ior i = 6 !$omp parallel reduction (ior:i) - ior = 4 ! { dg-error "Expected VARIABLE" } + ior = 4 ! { dg-error "is not a variable" } !$omp end parallel end subroutine f4 subroutine f5 diff --git a/gcc/testsuite/gfortran.dg/implicit_11.f90 b/gcc/testsuite/gfortran.dg/implicit_11.f90 new file mode 100644 index 000000000000..26cf5ae8795a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/implicit_11.f90 @@ -0,0 +1,38 @@ +! { dg-do compile } +! +! PR fortran/34760 +! The problem with implict typing is that it is unclear +! whether an existing symbol is a variable or a function. +! Thus it remains long FL_UNKNOWN, which causes extra +! problems; it was failing here since ISTAT was not +! FL_VARIABLE but still FL_UNKNOWN. +! +! Test case contributed by Dick Hendrickson. +! + MODULE TESTS + PRIVATE :: ISTAT + PUBLIC :: ISTAT2 + CONTAINS + SUBROUTINE AD0001 + REAL RLA1(:) + ALLOCATABLE RLA1 + ISTAT = -314 + ALLOCATE (RLA1(NF10), STAT = ISTAT) + ALLOCATE (RLA1(NF10), STAT = ISTAT2) + END SUBROUTINE + END MODULE + + MODULE TESTS2 + PRIVATE :: ISTAT2 + CONTAINS + function istat2() + istat2 = 0 + end function istat2 + SUBROUTINE AD0001 + REAL RLA1(:) + ALLOCATABLE RLA1 + ALLOCATE (RLA1(NF10), STAT = ISTAT2) ! { dg-error "must be a variable" } + END SUBROUTINE + END MODULE tests2 + +! { dg-final { cleanup-modules "TESTS" } } diff --git a/gcc/testsuite/gfortran.dg/interface_proc_end.f90 b/gcc/testsuite/gfortran.dg/interface_proc_end.f90 index d037de694a52..c6ea2b9e032c 100644 --- a/gcc/testsuite/gfortran.dg/interface_proc_end.f90 +++ b/gcc/testsuite/gfortran.dg/interface_proc_end.f90 @@ -16,4 +16,4 @@ END INTERFACE end ! { dg-error "END SUBROUTINE statement" } end module ! { dg-error "END SUBROUTINE statement" } -! { dg-excess-errors "Unexpected end of file" } +! { dg-error "Unexpected end of file" "" { target "*-*-*" } 0 } diff --git a/gcc/testsuite/gfortran.dg/proc_assign_1.f90 b/gcc/testsuite/gfortran.dg/proc_assign_1.f90 index 418e5f49e86c..9f2952b5d03d 100644 --- a/gcc/testsuite/gfortran.dg/proc_assign_1.f90 +++ b/gcc/testsuite/gfortran.dg/proc_assign_1.f90 @@ -58,12 +58,12 @@ end module simpler end interface stmt_fcn (w) = sin (w) call x (y ()) - x = 10 ! { dg-error "Expected VARIABLE" } + x = 10 ! { dg-error "is not a variable" } y = 20 ! { dg-error "is not a VALUE" } foo_er = 8 ! { dg-error "is not a VALUE" } ext1 = 99 ! { dg-error "is not a VALUE" } ext2 = 99 ! { dg-error "is not a VALUE" } - stmt_fcn = 1.0 ! { dg-error "Expected VARIABLE" } + stmt_fcn = 1.0 ! { dg-error "is not a variable" } w = stmt_fcn (1.0) contains subroutine x (i)