[Patch, Fortran, F03] PR 54949: abstract procedure pointers not rejected

[Janus Weil]

Hi all,

attached is a close-to-trivial patch which rejects the declaration of
'abstract procedure pointers' (which is not a valid Fortran concept),
and thereby fixes an ICE-on-invalid.

Regtested on x86_64-unknown-linux-gnu. Ok for trunk?

[In principle the ICE is a regression, but I don't think the patch is
worth backporting.]

Cheers,
Janus



2013-12-16  Janus Weil  <ja...@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  <ja...@gcc.gnu.org>

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

Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c        (revision 206019)
+++ gcc/fortran/symbol.c        (working copy)
@@ -363,6 +363,7 @@ check_conflict (symbol_attribute *attr, const char
     *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
   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* w
     }
 
   attr->abstract = 1;
-  return true;
+
+  return check_conflict (attr, NULL, where);
 }
 
 

! { dg-do compile }
!
! PR 54949: [F03] abstract procedure pointers not rejected
!
! Contributed by Janus Weil <ja...@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