re PR fortran/32088 (ICE (doesn't occur if given function standalone instead on inter...

fortran/
2007-05-27 Paul Thomas  <pault@gcc.gnu.org>
	   Tobias Burnus  <burnus@net-b.de>

	PR fortran/32088
	* symbol.c (gfc_check_function_type): Copy dimensions of
	  result variable.
	* resolve.c (resolve_contained_fntype): Improve symbol output in
 	  the error message.

testsuite/
2007-05-27  Tobias Burnus  <burnus@net-b.de>

	PR fortran/32088
	* gfortran.dg/func_result_3.f90: New.

-- Diese und die falgenden Zeilen werden ignoriert --

M    gcc/testsuite/ChangeLog
A    gcc/testsuite/gfortran.dg/func_result_3.f90
M    gcc/fortran/symbol.c
M    gcc/fortran/ChangeLog
M    gcc/fortran/resolve.c

From-SVN: r125118

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e86556f..11b6e92 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2007-05-27 Paul Thomas  <pault@gcc.gnu.org>
+          Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/32088
+       * symbol.c (gfc_check_function_type): Copy dimensions of
+         result variable.
+       * resolve.c (resolve_contained_fntype): Improve symbol output in
+         the error message.
+
 2007-05-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR fortran/31813

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 60da300..6142081 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -289,18 +289,20 @@ resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns)
     return;
 
   /* Try to find out of what the return type is.  */
-  if (sym->result != NULL)
-    sym = sym->result;
-
-  if (sym->ts.type == BT_UNKNOWN)
+  if (sym->result->ts.type == BT_UNKNOWN)
     {
-      t = gfc_set_default_type (sym, 0, ns);
+      t = gfc_set_default_type (sym->result, 0, ns);
 
-      if (t == FAILURE && !sym->attr.untyped)
+      if (t == FAILURE && !sym->result->attr.untyped)
        {
-         gfc_error ("Contained function '%s' at %L has no IMPLICIT type",
-                    sym->name, &sym->declared_at); /* FIXME */
-         sym->attr.untyped = 1;
+         if (sym->result == sym)
+           gfc_error ("Contained function '%s' at %L has no IMPLICIT type",
+                      sym->name, &sym->declared_at);
+         else
+           gfc_error ("Result '%s' of contained function '%s' at %L has "
+                      "no IMPLICIT type", sym->result->name, sym->name,
+                      &sym->result->declared_at);
+         sym->result->attr.untyped = 1;
        }
     }
 
@@ -310,9 +312,9 @@ resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns)
      in external functions.  Internal function results are not on that list;
      ergo, not permitted.  */
 
-  if (sym->ts.type == BT_CHARACTER)
+  if (sym->result->ts.type == BT_CHARACTER)
     {
-      gfc_charlen *cl = sym->ts.cl;
+      gfc_charlen *cl = sym->result->ts.cl;
       if (!cl || !cl->length)
        gfc_error ("Character-valued internal function '%s' at %L must "
                   "not be assumed length", sym->name, &sym->declared_at);

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 71f8912..ba48e54 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -271,13 +271,18 @@ gfc_check_function_type (gfc_namespace *ns)
                == SUCCESS)
        {
          if (proc->result != proc)
-           proc->ts = proc->result->ts;
+           {
+             proc->ts = proc->result->ts;
+             proc->as = gfc_copy_array_spec (proc->result->as);
+             proc->attr.dimension = proc->result->attr.dimension;
+             proc->attr.pointer = proc->result->attr.pointer;
+             proc->attr.allocatable = proc->result->attr.allocatable;
+           }
        }
       else
        {
-         gfc_error ("unable to implicitly type the function result "
-                    "'%s' at %L", proc->result->name,
-                    &proc->result->declared_at);
+         gfc_error ("Function result '%s' at %L has no IMPLICIT type",
+                    proc->result->name, &proc->result->declared_at);
          proc->result->attr.untyped = 1;
        }
     }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 29b1eac..710c62c 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2007-05-27  Tobias Burnus  <burnus@net-b.de>
 
+       PR fortran/32088
+       * gfortran.dg/func_result_3.f90: New.
+
+2007-05-27  Tobias Burnus  <burnus@net-b.de>
+
        PR middle-end/32083
        * gfortran.dg/transfer_simplify_3.f90: New.
 

diff --git a/gcc/testsuite/gfortran.dg/func_result_3.f90 b/gcc/testsuite/gfortran.dg/func_result_3.f90
new file mode 100644 (file)
index 0000000..d0f8c71
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_result_3.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! PR fortran/32088
+!
+! Test implicitly defined result variables
+!
+subroutine dummy
+contains
+  function quadric(a,b) result(c)
+  intent(in) a,b; dimension a(0:3),b(0:3),c(0:9)
+    c(0)=a(0)*b(0); c(1:3)=a(1:)*b(0)+a(0)*b(1:); c(4:6)=a(1:)*b(1:)
+    c(7:9)=(/a(1)*b(2)+b(1)*a(2),a(1)*b(3)+b(1)*a(3),a(2)*b(3)+b(2)*a(3)/)
+  end function
+end subroutine dummy
+
+subroutine dummy2
+implicit none
+contains
+  function quadric(a,b) result(c) ! { dg-error "no IMPLICIT type" }
+  real :: a, b
+  intent(in) a,b; dimension a(0:3),b(0:3),c(0:9)
+    c(0)=a(0)*b(0); c(1:3)=a(1:)*b(0)+a(0)*b(1:); c(4:6)=a(1:)*b(1:)
+    c(7:9)=(/a(1)*b(2)+b(1)*a(2),a(1)*b(3)+b(1)*a(3),a(2)*b(3)+b(2)*a(3)/)
+  end function
+end subroutine dummy2
+end