procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/34714 (ICE-on-invalid in gfc_conv_descriptor_dtype)

Browse source 
gcc/fortran:
2008-03-28  Daniel Franke  <franke.daniel@gmail.com>
            Paul Richard Thomas <paul.richard.thomas@gmail.com>

	PR fortran/34714
        * primary.c (match_variable): Improved matching of function
        result variables.
        * resolve.c (resolve_allocate_deallocate): Removed checks if
        the actual argument for STAT is a variable.

gcc/testsuite:
2008-03-28  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/34714
        * gfortran.dg/alloc_alloc_expr_3.f90: New test.
        * gfortran.dg/allocate_stat.f90: Adjusted error-match text.
        * gfortran.dg/func_assign.f90: Likewise.
        * gfortran.dg/implicit_11.f90: Likewise.
        * gfortran.dg/proc_assign_1.f90: Likewise.
        * gfortran.dg/proc_assign_2.f90: Likewise.
        * gfortran.dg/procedure_lvalue.f90: Likewise.
								


Co-Authored-By: Paul Richard Thomas <paul.richard.thomas@gmail.com>

From-SVN: r133701
This commit is contained in:
Daniel Franke 2008-03-28 18:57:25 -04:00 • committed by Daniel Franke
parent 716aaa593a
commit 01d2a7d703
11 changed files with 72 additions and 57 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View file

@ -1,3 +1,12 @@
2008-03-28 Daniel Franke <franke.daniel@gmail.com>
Paul Richard Thomas <paul.richard.thomas@gmail.com>
PR fortran/34714
* primary.c (match_variable): Improved matching of function
result variables.
* resolve.c (resolve_allocate_deallocate): Removed checks if
the actual argument for STAT is a variable.
2008-03-28 Tobias Burnus <burnus@net-b.de>
* symbol.c (gfc_get_default_type): Fix error message; option

14
gcc/fortran/primary.c
View file

@ -2561,8 +2561,18 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag)
break;
case FL_PROCEDURE:
/* Check for a nonrecursive function result */
if (sym->attr.function && sym->result == sym && !sym->attr.external)
/* Check for a nonrecursive function result variable. */
if (sym->attr.function
&& !sym->attr.external
&& sym->result == sym
&& ((sym == gfc_current_ns->proc_name
&& sym == gfc_current_ns->proc_name->result)
|| (gfc_current_ns->parent
&& sym == gfc_current_ns->parent->proc_name->result)
|| (sym->attr.entry
&& sym->ns == gfc_current_ns)
|| (sym->attr.entry
&& sym->ns == gfc_current_ns->parent)))
{
/* If a function result is a derived type, then the derived
type may still have to be resolved. */

40
gcc/fortran/resolve.c
View file

@ -4878,7 +4878,6 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
{
gfc_symbol *s = NULL;
gfc_alloc *a;
bool is_variable;
if (code->expr)
s = code->expr->symtree->n.sym;
@ -4892,45 +4891,6 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
if (gfc_pure (NULL) && gfc_impure_variable (s))
gfc_error ("Illegal STAT variable in %s statement at %C "
"for a PURE procedure", fcn);
is_variable = false;
if (s->attr.flavor == FL_VARIABLE)
is_variable = true;
else if (s->attr.function && s->result == s
&& (gfc_current_ns->proc_name == s
||
(gfc_current_ns->parent
&& gfc_current_ns->parent->proc_name == s)))
is_variable = true;
else if (gfc_current_ns->entries && s->result == s)
{
gfc_entry_list *el;
for (el = gfc_current_ns->entries; el; el = el->next)
if (el->sym == s)
{
is_variable = true;
}
}
else if (gfc_current_ns->parent && gfc_current_ns->parent->entries
&& s->result == s)
{
gfc_entry_list *el;
for (el = gfc_current_ns->parent->entries; el; el = el->next)
if (el->sym == s)
{
is_variable = true;
}
}
if (s->attr.flavor == FL_UNKNOWN
&& gfc_add_flavor (&s->attr, FL_VARIABLE,
s->name, NULL) == SUCCESS)
is_variable = true;
if (!is_variable)
gfc_error ("STAT tag in %s statement at %L must be "
"a variable", fcn, &code->expr->where);
}
if (s && code->expr->ts.type != BT_INTEGER)

11
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,14 @@
2008-03-28 Daniel Franke <franke.daniel@gmail.com>
PR fortran/34714
* gfortran.dg/alloc_alloc_expr_3.f90: New test.
* gfortran.dg/allocate_stat.f90: Adjusted error-match text.
* gfortran.dg/func_assign.f90: Likewise.
* gfortran.dg/implicit_11.f90: Likewise.
* gfortran.dg/proc_assign_1.f90: Likewise.
* gfortran.dg/proc_assign_2.f90: Likewise.
* gfortran.dg/procedure_lvalue.f90: Likewise.
2008-03-28 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/35699

25
gcc/testsuite/gfortran.dg/alloc_alloc_expr_3.f90 Normal file
View file

@ -0,0 +1,25 @@
! { dg-do compile }
!
! PR fortran/34714 - ICE on invalid
! Testcase contributed by Martin Reinecke <martin AT mpa-garching DOT mpg DOT de>
!
module foo
type bar
logical, pointer, dimension(:) :: baz
end type
contains
function func1()
type(bar) func1
allocate(func1%baz(1))
end function
function func2()
type(bar) func2
allocate(func1%baz(1)) ! { dg-error "is not a variable" }
end function
end module foo
! { dg-final { cleanup-modules "foo" } }

6
gcc/testsuite/gfortran.dg/allocate_stat.f90
View file

@ -51,7 +51,7 @@ subroutine sub()
end interface
real, pointer :: gain
integer, parameter :: res = 2
allocate (gain,STAT=func2) ! { dg-error "STAT tag in ALLOCATE statement at .1. must be a variable" }
allocate (gain,STAT=func2) ! { dg-error "is not a variable" }
deallocate(gain)
end subroutine sub
@ -68,9 +68,9 @@ contains
end function one
subroutine sub()
integer, pointer :: p
allocate(p, stat=one) ! { dg-error "STAT tag in ALLOCATE statement at .1. must be a variable" }
allocate(p, stat=one) ! { dg-error "is not a variable" }
if(associated(p)) deallocate(p)
allocate(p, stat=two) ! { dg-error "STAT tag in ALLOCATE statement at .1. must be a variable" }
allocate(p, stat=two) ! { dg-error "is not a variable" }
if(associated(p)) deallocate(p)
end subroutine sub
end module test

4
gcc/testsuite/gfortran.dg/func_assign.f90
View file

@ -25,8 +25,8 @@ contains
end interface
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" }
funget = 4 ! { dg-error "is not a variable" }
bar = 5 ! { dg-error "is not a variable" }
end subroutine a
end module mod

2
gcc/testsuite/gfortran.dg/implicit_11.f90
View file

@ -31,7 +31,7 @@
SUBROUTINE AD0001
REAL RLA1(:)
ALLOCATABLE RLA1
ALLOCATE (RLA1(NF10), STAT = ISTAT2) ! { dg-error "must be a variable" }
ALLOCATE (RLA1(NF10), STAT = ISTAT2) ! { dg-error "is not a variable" }
END SUBROUTINE
END MODULE tests2

14
gcc/testsuite/gfortran.dg/proc_assign_1.f90
View file

@ -30,11 +30,11 @@ contains
end subroutine foobar
end function foo
subroutine bar() ! This was the original bug.
foo = 10 ! { dg-error "is not a VALUE" }
foo = 10 ! { dg-error "is not a variable" }
end subroutine bar
integer function oh_no ()
oh_no = 1
foo = 5 ! { dg-error "is not a VALUE" }
foo = 5 ! { dg-error "is not a variable" }
end function oh_no
end module simple
@ -59,16 +59,16 @@ end module simpler
stmt_fcn (w) = sin (w)
call x (y ())
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" }
y = 20 ! { dg-error "is not a variable" }
foo_er = 8 ! { dg-error "is not a variable" }
ext1 = 99 ! { dg-error "is not a variable" }
ext2 = 99 ! { dg-error "is not a variable" }
stmt_fcn = 1.0 ! { dg-error "is not a variable" }
w = stmt_fcn (1.0)
contains
subroutine x (i)
integer i
y = i ! { dg-error "is not a VALUE" }
y = i ! { dg-error "is not a variable" }
end subroutine x
function y ()
integer y

2
gcc/testsuite/gfortran.dg/proc_assign_2.f90
View file

@ -14,7 +14,7 @@ CONTAINS
END FUNCTION
LOGICAL FUNCTION f2()
f1 = .FALSE. ! { dg-error "not a VALUE" }
f1 = .FALSE. ! { dg-error "is not a variable" }
END FUNCTION
END FUNCTION
END MODULE

2
gcc/testsuite/gfortran.dg/procedure_lvalue.f90
View file

@ -14,7 +14,7 @@ end module t
subroutine r
use t
b = 1. ! { dg-error "is not a VALUE" }
b = 1. ! { dg-error "is not a variable" }
y = a(1.)
end subroutine r