From: Tobias Burnus <burnus@gcc.gnu.org>
Date: Sun, 30 Jan 2011 18:16:12 +0000 (+0100)
Subject: re PR fortran/47042 (ICE with character pointer in function)
X-Git-Tag: releases/gcc-4.6.0~869
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=86d7449cc673e466a64f2ad6203c3461049596ba;p=thirdparty%2Fgcc.git

re PR fortran/47042 (ICE with character pointer in function)

2011-01-31  Tobias Burnus  <burnus@net-b.de>

        PR fortran/47042
        * interface.c (gfc_procedure_use): Add explicit interface check
        * for
        pointer/allocatable functions.

2011-01-31  Tobias Burnus  <burnus@net-b.de>

        PR fortran/47042
        * gfortran.dg/interface_34.f90: New.

From-SVN: r169414
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ce56256017b8..888432ebfbea 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2011-01-31  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47042
+	* interface.c (gfc_procedure_use): Add explicit interface check for
+	pointer/allocatable functions.
+
 2011-01-30  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/47523
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 1cbba2483544..1e5df61b5453 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -2686,6 +2686,30 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
   if (sym->attr.if_source == IFSRC_UNKNOWN)
     {
       gfc_actual_arglist *a;
+
+      if (sym->attr.pointer)
+	{
+	  gfc_error("The pointer object '%s' at %L must have an explicit "
+		    "function interface or be declared as array",
+		    sym->name, where);
+	  return;
+	}
+
+      if (sym->attr.allocatable && !sym->attr.external)
+	{
+	  gfc_error("The allocatable object '%s' at %L must have an explicit "
+		    "function interface or be declared as array",
+		    sym->name, where);
+	  return;
+	}
+
+      if (sym->attr.allocatable)
+	{
+	  gfc_error("Allocatable function '%s' at %L must have an explicit "
+		    "function interface", sym->name, where);
+	  return;
+	}
+
       for (a = *ap; a; a = a->next)
 	{
 	  /* Skip g77 keyword extensions like %VAL, %REF, %LOC.  */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a9e16459ecf8..4d432ef6d171 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,7 +1,13 @@
+2011-01-31  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47042
+	* gfortran.dg/interface_34.f90: New.
+
 2011-01-30  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/47523
 	* gfortran.dg/realloc_on_assign_5.f03: New test.
+	* gfortran.dg/realloc_on_assign_5.f03: New test.
 
 2011-01-29  Ulrich Weigand  <Ulrich.Weigand@de.ibm.com>
 
diff --git a/gcc/testsuite/gfortran.dg/interface_34.f90 b/gcc/testsuite/gfortran.dg/interface_34.f90
new file mode 100644
index 000000000000..3e409d5643fa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_34.f90
@@ -0,0 +1,33 @@
+! { dg-compile }
+!
+! PR fortran/47042
+!
+! Contribued by Jerry DeLisle
+!
+
+program bug
+
+contains
+function get_cstring ()
+  character              :: get_cstring
+  character, pointer     :: ptmp
+  character, allocatable :: atmp
+
+  get_cstring = ptmp(i) ! { dg-error "must have an explicit function interface" }
+  get_cstring = atmp(i) ! { dg-error "must have an explicit function interface" }
+end function
+
+function get_cstring2 ()
+  EXTERNAL :: ptmp, atmp
+  character              :: get_cstring2
+  character, pointer     :: ptmp
+  character, allocatable :: atmp
+
+  get_cstring2 = atmp(i) ! { dg-error "must have an explicit function interface" }
+
+  ! The following is regarded as call to a procedure pointer,
+  ! which is in principle valid:
+  get_cstring2 = ptmp(i)
+end function
+
+end program