OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/58023 ([F03] ICE on invalid with bad PPC declaration) 

2015-01-15  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/58023
	* resolve.c (resolve_fl_derived0): Continue resolving next component
	after error.

2015-01-15  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/58023
	* gfortran.dg/proc_ptr_comp_43.f90: New.

From-SVN: r219676
This commit is contained in:
Janus Weil 2015-01-15 19:28:02 +01:00
parent 1357c6e167
commit cab283f5c0
4 changed files with 81 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2015-01-15 Janus Weil <janus@gcc.gnu.org>
PR fortran/58023
* resolve.c (resolve_fl_derived0): Continue resolving next component
after error.
2015-01-14 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/61933

52
gcc/fortran/resolve.c
View File

@ -12377,6 +12377,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
c = (sym->attr.is_class) ? sym->components->ts.u.derived->components
: sym->components;
bool success = true;
for ( ; c != NULL; c = c->next)
{
if (c->attr.artificial)
@ -12389,7 +12391,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
{
gfc_error ("Coarray component %qs at %L must be allocatable with "
"deferred shape", c->name, &c->loc);
return false;
success = false;
continue;
}
/* F2008, C443. */
@ -12398,7 +12401,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
{
gfc_error ("Component %qs at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) "
"shall not be a coarray", c->name, &c->loc);
return false;
success = false;
continue;
}
/* F2008, C444. */
@ -12409,7 +12413,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
gfc_error ("Component %qs at %L with coarray component "
"shall be a nonpointer, nonallocatable scalar",
c->name, &c->loc);
return false;
success = false;
continue;
}
/* F2008, C448. */
@ -12417,7 +12422,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
{
gfc_error ("Component %qs at %L has the CONTIGUOUS attribute but "
"is not an array pointer", c->name, &c->loc);
return false;
success = false;
continue;
}
if (c->attr.proc_pointer && c->ts.interface)
@ -12427,7 +12433,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
if (!sym->attr.vtype && !check_proc_interface (ifc, &c->loc))
{
c->tb->error = 1;
return false;
success = false;
continue;
}
if (ifc->attr.if_source || ifc->attr.intrinsic)
@ -12471,7 +12478,11 @@ resolve_fl_derived0 (gfc_symbol *sym)
gfc_charlen *cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl);
if (cl->length && !cl->resolved
&& !gfc_resolve_expr (cl->length))
return false;
{
c->tb->error = 1;
success = false;
continue;
}
c->ts.u.cl = cl;
}
}
@ -12514,7 +12525,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
"at %L has no argument %qs", c->name,
c->tb->pass_arg, &c->loc, c->tb->pass_arg);
c->tb->error = 1;
return false;
success = false;
continue;
}
}
else
@ -12528,7 +12540,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
"must have at least one argument",
c->name, &c->loc);
c->tb->error = 1;
return false;
success = false;
continue;
}
me_arg = c->ts.interface->formal->sym;
}
@ -12544,7 +12557,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
" the derived type %qs", me_arg->name, c->name,
me_arg->name, &c->loc, sym->name);
c->tb->error = 1;
return false;
success = false;
continue;
}
/* Check for C453. */
@ -12554,7 +12568,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
"must be scalar", me_arg->name, c->name, me_arg->name,
&c->loc);
c->tb->error = 1;
return false;
success = false;
continue;
}
if (me_arg->attr.pointer)
@ -12563,7 +12578,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
"may not have the POINTER attribute", me_arg->name,
c->name, me_arg->name, &c->loc);
c->tb->error = 1;
return false;
success = false;
continue;
}
if (me_arg->attr.allocatable)
@ -12572,12 +12588,17 @@ resolve_fl_derived0 (gfc_symbol *sym)
"may not be ALLOCATABLE", me_arg->name, c->name,
me_arg->name, &c->loc);
c->tb->error = 1;
return false;
success = false;
continue;
}
if (gfc_type_is_extensible (sym) && me_arg->ts.type != BT_CLASS)
gfc_error ("Non-polymorphic passed-object dummy argument of %qs"
" at %L", c->name, &c->loc);
{
gfc_error ("Non-polymorphic passed-object dummy argument of %qs"
" at %L", c->name, &c->loc);
success = false;
continue;
}
}
@ -12746,6 +12767,9 @@ resolve_fl_derived0 (gfc_symbol *sym)
return false;
}
if (!success)
return false;
check_defined_assignments (sym);
if (!sym->attr.defined_assign_comp && super_type)

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2015-01-15 Janus Weil <janus@gcc.gnu.org>
PR fortran/58023
* gfortran.dg/proc_ptr_comp_43.f90: New.
2015-01-15 Mike Stump <mikestump@comcast.net>
* gcc.dg/unroll_1.c: Rename gcc.dg/unroll_[1-5].c to unroll-[2-6].

32
gcc/testsuite/gfortran.dg/proc_ptr_comp_43.f90 Normal file
View File

@ -0,0 +1,32 @@
! { dg-do compile }
!
! PR 58023: [F03] ICE on invalid with bad PPC declaration
!
! Contributed by Andrew Benson <abensonca@gmail.com>
module m
implicit none
abstract interface
double precision function mr()
end function mr
end interface
type :: sfd
procedure(mr), pointer :: mr1 ! { dg-error "must have at least one argument" }
procedure(mr), pointer :: mr2 ! { dg-error "must have at least one argument" }
end type sfd
contains
subroutine go()
implicit none
type(sfd):: d
write (0,*) d%mr2()
return
end subroutine go
end module m
! { dg-final { cleanup-modules "m" } }