* [fortran, patch] PR34714 - fix ice-on-invalid
@ 2008-03-20 21:33 Daniel Franke
2008-03-28 12:46 ` Daniel Franke
0 siblings, 1 reply; 3+ messages in thread
From: Daniel Franke @ 2008-03-20 21:33 UTC (permalink / raw)
To: fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 976 bytes --]
Thanks to Paul who gave me a leg-up with this :)
gcc/fortran:
2008-03-20 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-20 Daniel Franke <franke.daniel@gmail.com>
Paul Richard Thomas <paul.richard.thomas@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.
Bootstrapped and regression tested on i686-pc-linux-gnu.
Ok for trunk (and maybe 4.3)?
Regards
Daniel
[-- Attachment #2: pr34714.diff --]
[-- Type: text/x-diff, Size: 8384 bytes --]
Index: fortran/primary.c
===================================================================
--- fortran/primary.c (revision 133396)
+++ fortran/primary.c (working copy)
@@ -2561,8 +2561,18 @@ match_variable (gfc_expr **result, int e
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. */
Index: fortran/resolve.c
===================================================================
--- fortran/resolve.c (revision 133396)
+++ fortran/resolve.c (working copy)
@@ -4868,7 +4868,6 @@ resolve_allocate_deallocate (gfc_code *c
{
gfc_symbol *s = NULL;
gfc_alloc *a;
- bool is_variable;
if (code->expr)
s = code->expr->symtree->n.sym;
@@ -4882,45 +4881,6 @@ resolve_allocate_deallocate (gfc_code *c
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)
Index: testsuite/gfortran.dg/alloc_alloc_expr_3.f90
===================================================================
--- testsuite/gfortran.dg/alloc_alloc_expr_3.f90 (revision 0)
+++ testsuite/gfortran.dg/alloc_alloc_expr_3.f90 (revision 0)
@@ -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" } }
Index: testsuite/gfortran.dg/allocate_stat.f90
===================================================================
--- testsuite/gfortran.dg/allocate_stat.f90 (revision 133396)
+++ testsuite/gfortran.dg/allocate_stat.f90 (working copy)
@@ -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
Index: testsuite/gfortran.dg/func_assign.f90
===================================================================
--- testsuite/gfortran.dg/func_assign.f90 (revision 133396)
+++ testsuite/gfortran.dg/func_assign.f90 (working copy)
@@ -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
Index: testsuite/gfortran.dg/implicit_11.f90
===================================================================
--- testsuite/gfortran.dg/implicit_11.f90 (revision 133396)
+++ testsuite/gfortran.dg/implicit_11.f90 (working copy)
@@ -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
Index: testsuite/gfortran.dg/proc_assign_1.f90
===================================================================
--- testsuite/gfortran.dg/proc_assign_1.f90 (revision 133396)
+++ testsuite/gfortran.dg/proc_assign_1.f90 (working copy)
@@ -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
Index: testsuite/gfortran.dg/proc_assign_2.f90
===================================================================
--- testsuite/gfortran.dg/proc_assign_2.f90 (revision 133396)
+++ testsuite/gfortran.dg/proc_assign_2.f90 (working copy)
@@ -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
Index: testsuite/gfortran.dg/procedure_lvalue.f90
===================================================================
--- testsuite/gfortran.dg/procedure_lvalue.f90 (revision 133396)
+++ testsuite/gfortran.dg/procedure_lvalue.f90 (working copy)
@@ -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
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [fortran, patch] PR34714 - fix ice-on-invalid
2008-03-20 21:33 [fortran, patch] PR34714 - fix ice-on-invalid Daniel Franke
@ 2008-03-28 12:46 ` Daniel Franke
2008-03-28 21:44 ` Jerry DeLisle
0 siblings, 1 reply; 3+ messages in thread
From: Daniel Franke @ 2008-03-28 12:46 UTC (permalink / raw)
To: fortran; +Cc: gcc-patches
On Thursday 20 March 2008 21:58:22 Daniel Franke wrote:
> gcc/fortran:
> 2008-03-20 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-20 Daniel Franke <franke.daniel@gmail.com>
> Paul Richard Thomas <paul.richard.thomas@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.
Ping?
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [fortran, patch] PR34714 - fix ice-on-invalid
2008-03-28 12:46 ` Daniel Franke
@ 2008-03-28 21:44 ` Jerry DeLisle
0 siblings, 0 replies; 3+ messages in thread
From: Jerry DeLisle @ 2008-03-28 21:44 UTC (permalink / raw)
To: Daniel Franke; +Cc: fortran, gcc-patches
On Fri, 2008-03-28 at 12:31 +0100, Daniel Franke wrote:
> On Thursday 20 March 2008 21:58:22 Daniel Franke wrote:
> > gcc/fortran:
> > 2008-03-20 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-20 Daniel Franke <franke.daniel@gmail.com>
> > Paul Richard Thomas <paul.richard.thomas@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.
>
> Ping?
OK, thanks for patch.
Jerry
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2008-03-28 19:56 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2008-03-20 21:33 [fortran, patch] PR34714 - fix ice-on-invalid Daniel Franke
2008-03-28 12:46 ` Daniel Franke
2008-03-28 21:44 ` Jerry DeLisle
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).