Skip to content

R
riscv-gcc-1
Commit d7e2fcd0 by Tobias Burnus Committed by Tobias Burnus
Options

re PR fortran/34760 (PRIVATE variable not allowed as STAT variable in ALLOCATE) 

2008-01-19  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34760
        * primary.c (match_variable): Handle FL_UNKNOWN without
        uneducated guessing.
        (match_variable): Improve error message.

2008-01-19  Tobias Burnus  <burnus@net-b.de>

        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
parent 0a84fec6
Showing with 84 additions and 16 deletions
gcc/fortran/ChangeLog
2008-01-19 Tobias Burnus <burnus@net-b.de>
PR fortran/34760
* primary.c (match_variable): Handle FL_UNKNOWN without
uneducated guessing.
(match_variable): Improve error message.
2008-01-18 Tobias Burnus <burnus@net-b.de>
PR fortran/32616
......
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;
}
......
gcc/testsuite/ChangeLog
2008-01-19 Tobias Burnus <burnus@net-b.de>
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 <burnus@net-b.de>
PR fortran/32616
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
......
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
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
......
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
......
gcc/testsuite/gfortran.dg/implicit_11.f90 0 → 100644
! { 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" } }
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 }
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)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment