re PR fortran/54949 ([F03] abstract procedure pointers not rejected)

2013-12-16  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/54949
	* symbol.c (check_conflict): Forbid abstract procedure pointers.
	(gfc_add_abstract): Check for attribute conflicts.


2013-12-16  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/54949
	* gfortran.dg/proc_ptr_44.f90: New.

From-SVN: r206033
This commit is contained in:
Janus Weil 2013-12-16 23:01:58 +01:00
parent 71eba7a0c6
commit 5b0b27f9c3
4 changed files with 45 additions and 1 deletions

View file

@ -1,3 +1,9 @@
2013-12-16 Janus Weil <janus@gcc.gnu.org>
PR fortran/54949
* symbol.c (check_conflict): Forbid abstract procedure pointers.
(gfc_add_abstract): Check for attribute conflicts.
2013-12-16 Jakub Jelinek <jakub@redhat.com>
PR libgomp/59337

View file

@ -363,6 +363,7 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
*cray_pointee = "CRAY POINTEE", *data = "DATA", *value = "VALUE",
*volatile_ = "VOLATILE", *is_protected = "PROTECTED",
*is_bind_c = "BIND(C)", *procedure = "PROCEDURE",
*proc_pointer = "PROCEDURE POINTER", *abstract = "ABSTRACT",
*asynchronous = "ASYNCHRONOUS", *codimension = "CODIMENSION",
*contiguous = "CONTIGUOUS", *generic = "GENERIC";
static const char *threadprivate = "THREADPRIVATE";
@ -593,6 +594,8 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (procedure, asynchronous)
conf (procedure, entry)
conf (proc_pointer, abstract)
a1 = gfc_code2string (flavors, attr->flavor);
if (attr->in_namelist
@ -1440,7 +1443,8 @@ gfc_add_abstract (symbol_attribute* attr, locus* where)
}
attr->abstract = 1;
return true;
return check_conflict (attr, NULL, where);
}

View file

@ -1,3 +1,8 @@
2013-12-16 Janus Weil <janus@gcc.gnu.org>
PR fortran/54949
* gfortran.dg/proc_ptr_44.f90: New.
2013-12-16 Jakub Jelinek <jakub@redhat.com>
* c-c++-common/ubsan/overflow-mul-3.c: New test.

View file

@ -0,0 +1,29 @@
! { dg-do compile }
!
! PR 54949: [F03] abstract procedure pointers not rejected
!
! Contributed by Janus Weil <janus@gcc.gnu.org>
implicit none
abstract interface
subroutine abssub1
end subroutine
end interface
pointer :: abssub1 ! { dg-error "PROCEDURE POINTER attribute conflicts with ABSTRACT attribute" }
pointer :: abssub2
abstract interface
subroutine abssub2 ! { dg-error "PROCEDURE POINTER attribute conflicts with ABSTRACT attribute" }
end subroutine
end interface
abssub1 => sub ! { dg-error "is not a variable" }
abssub2 => sub
contains
subroutine sub
end subroutine
end