[multiple changes]

2007-03-15  Tobias Burnus  <burnus@gcc.gnu.org>
	    Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30922
	* decl.c (gfc_match_import): If the parent of the current name-
	space is null, try looking for an imported symbol in the parent
	of the proc_name interface.
	* resolve.c (resolve_fl_variable): Do not check for blocking of
	host association by a same symbol, if the symbol is in an
	interface body.

2007-03-15  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30879
	* decl.c (match_data_constant): Before going on to try to match
	a name, try to match a structure component.


	PR fortran/30870
	* resolve.c (resolve_actual_arglist): Do not reject a generic
	actual argument if it has a same name specific interface.

	PR fortran/31163
	* trans-array.c (parse_interface): Do not nullify allocatable
	components if the symbol has the saved attribute.


2007-03-15  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30922
	* gfortran.dg/import5.f90.f90: New test.


	PR fortran/30879
	* gfortran.dg/data_components_1.f90: New test.


	PR fortran/30870
	* gfortran.dg/generic_13.f90: New test.

	PR fortran/31163
	* gfortran.dg/alloc_comp_basics_5.f90: New test.

From-SVN: r122944

9 files changed, 246 insertions, 9 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 48d4334..449f9b8 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,29 @@
+2007-03-15  Tobias Burnus  <burnus@gcc.gnu.org>
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30922
+	* decl.c (gfc_match_import): If the parent of the current name-
+	space is null, try looking for an imported symbol in the parent
+	of the proc_name interface.
+	* resolve.c (resolve_fl_variable): Do not check for blocking of
+	host association by a same symbol, if the symbol is in an
+	interface body.
+
+2007-03-15  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30879
+	* decl.c (match_data_constant): Before going on to try to match
+	a name, try to match a structure component.
+
+
+	PR fortran/30870
+	* resolve.c (resolve_actual_arglist): Do not reject a generic
+	actual argument if it has a same name specific interface.
+
+	PR fortran/31163
+	* trans-array.c (parse_interface): Do not nullify allocatable
+	components if the symbol has the saved attribute.
+
 2007-03-14  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
 	* trans-array.c (gfc_trans_auto_array_allocation): Replace
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 173ad45..09ded01 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -301,6 +301,7 @@ match_data_constant (gfc_expr **result)
   gfc_symbol *sym;
   gfc_expr *expr;
   match m;
+  locus old_loc;
 
   m = gfc_match_literal_constant (&expr, 1);
   if (m == MATCH_YES)
@@ -316,6 +317,23 @@ match_data_constant (gfc_expr **result)
   if (m != MATCH_NO)
     return m;
 
+  old_loc = gfc_current_locus;
+
+  /* Should this be a structure component, try to match it
+     before matching a name.  */
+  m = gfc_match_rvalue (result);
+  if (m == MATCH_ERROR)
+    return m;
+
+  if (m == MATCH_YES && (*result)->expr_type == EXPR_STRUCTURE)
+    {
+      if (gfc_simplify_expr (*result, 0) == FAILURE)
+	m = MATCH_ERROR;
+      return m;
+    }
+
+  gfc_current_locus = old_loc;
+
   m = gfc_match_name (name);
   if (m != MATCH_YES)
     return m;
@@ -2041,7 +2059,17 @@ gfc_match_import (void)
       switch (m)
 	{
 	case MATCH_YES:
-	  if (gfc_find_symbol (name, gfc_current_ns->parent, 1, &sym))
+	  if (gfc_current_ns->parent !=  NULL
+		  && gfc_find_symbol (name, gfc_current_ns->parent,
+				      1, &sym))
+	    {
+	       gfc_error ("Type name '%s' at %C is ambiguous", name);
+	       return MATCH_ERROR;
+	    }
+	  else if (gfc_current_ns->proc_name->ns->parent !=  NULL
+		  && gfc_find_symbol (name,
+			gfc_current_ns->proc_name->ns->parent,
+			1, &sym))
 	    {
 	       gfc_error ("Type name '%s' at %C is ambiguous", name);
 	       return MATCH_ERROR;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 987d73b..db55c0c 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -922,11 +922,24 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype)
 			 &e->where);
 	    }
 
+	  /* Check if a generic interface has a specific procedure
+	    with the same name before emitting an error.  */
 	  if (sym->attr.generic)
 	    {
-	      gfc_error ("GENERIC non-INTRINSIC procedure '%s' is not "
-			 "allowed as an actual argument at %L", sym->name,
-			 &e->where);
+	      gfc_interface *p;
+	      for (p = sym->generic; p; p = p->next)
+		if (strcmp (sym->name, p->sym->name) == 0)
+		  {
+		    e->symtree = gfc_find_symtree
+					   (p->sym->ns->sym_root, sym->name);
+		    sym = p->sym;
+		    break;
+		  }
+
+	      if (p == NULL || e->symtree == NULL)
+		gfc_error ("GENERIC non-INTRINSIC procedure '%s' is not "
+				"allowed as an actual argument at %L", sym->name,
+				&e->where);
 	    }
 
 	  /* If the symbol is the function that names the current (or
@@ -5663,7 +5676,8 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
   /* Check to see if a derived type is blocked from being host associated
      by the presence of another class I symbol in the same namespace.
      14.6.1.3 of the standard and the discussion on comp.lang.fortran.  */
-  if (sym->ts.type == BT_DERIVED && sym->ns != sym->ts.derived->ns)
+  if (sym->ts.type == BT_DERIVED && sym->ns != sym->ts.derived->ns
+	&& sym->ns->proc_name->attr.if_source != IFSRC_IFBODY)
     {
       gfc_symbol *s;
       gfc_find_symbol (sym->ts.derived->name, sym->ns, 0, &s);
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 5d41331..00e54c8 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5216,9 +5216,12 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
     
   if (sym_has_alloc_comp && !(sym->attr.pointer || sym->attr.allocatable))
     {
-      rank = sym->as ? sym->as->rank : 0;
-      tmp = gfc_nullify_alloc_comp (sym->ts.derived, descriptor, rank);
-      gfc_add_expr_to_block (&fnblock, tmp);
+      if (!sym->attr.save)
+	{
+	  rank = sym->as ? sym->as->rank : 0;
+	  tmp = gfc_nullify_alloc_comp (sym->ts.derived, descriptor, rank);
+	  gfc_add_expr_to_block (&fnblock, tmp);
+	}
     }
   else if (!GFC_DESCRIPTOR_TYPE_P (type))
     {
@@ -5239,7 +5242,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
   /* Allocatable arrays need to be freed when they go out of scope.
      The allocatable components of pointers must not be touched.  */
   if (sym_has_alloc_comp && !(sym->attr.function || sym->attr.result)
-      && !sym->attr.pointer)
+      && !sym->attr.pointer && !sym->attr.save)
     {
       int rank;
       rank = sym->as ? sym->as->rank : 0;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 991755e..291295c 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,19 @@
+2007-03-15  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30922
+	* gfortran.dg/import5.f90.f90: New test.
+
+
+	PR fortran/30879
+	* gfortran.dg/data_components_1.f90: New test.
+
+
+	PR fortran/30870
+	* gfortran.dg/generic_13.f90: New test.
+
+	PR fortran/31163
+	* gfortran.dg/alloc_comp_basics_5.f90: New test.
+
 2007-03-14  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR libgfortran/31051
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_basics_5.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_basics_5.f90
new file mode 100644
index 0000000..99cd9e0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_basics_5.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+! This checks the correct functioning of derived types with the SAVE
+! attribute and allocatable components - PR31163
+!
+! Contributed by Salvatore Filippone  <salvatore.filippone@uniroma2.it>
+!
+Module bar_mod
+
+  type foo_type
+     integer, allocatable :: mv(:)
+  end type foo_type
+
+
+contains
+
+
+  subroutine bar_foo_ab(info)
+
+    integer, intent(out)               :: info
+    Type(foo_type), save :: f_a
+    
+    if (allocated(f_a%mv)) then 
+      info = size(f_a%mv)
+    else
+      allocate(f_a%mv(10),stat=info)
+      if (info /= 0) then 
+        info = -1 
+      endif
+    end if
+  end subroutine bar_foo_ab
+
+
+end module bar_mod
+
+program tsave
+  use bar_mod
+
+  integer :: info
+  
+  call bar_foo_ab(info) 
+  if (info .ne. 0) call abort ()
+  call bar_foo_ab(info) 
+  if (info .ne. 10) call abort ()
+  
+end program tsave
+
+! { dg-final { cleanup-modules "bar_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/data_components_1.f90 b/gcc/testsuite/gfortran.dg/data_components_1.f90
new file mode 100644
index 0000000..2ce677e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_components_1.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! Check the fix for PR30879, in which the structure
+! components in the DATA values would cause a syntax
+! error.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+  TYPE T1
+   INTEGER :: I
+  END TYPE T1
+
+  TYPE(T1), PARAMETER :: D1=T1(2)
+  TYPE(T1) :: D2(2)
+
+  INTEGER :: a(2)
+
+  DATA (a(i),i=1,D1%I) /D1%I*D1%I/
+
+  DATA (D2(i),i=1,D1%I) /D1%I*T1(4)/
+
+  print *, a
+  print *, D2
+  END
diff --git a/gcc/testsuite/gfortran.dg/generic_13.f90 b/gcc/testsuite/gfortran.dg/generic_13.f90
new file mode 100644
index 0000000..5661345
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_13.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! tests the patch for PR30870, in which the generic XX was rejected
+! because the specific with the same name was not looked for.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+MODULE TEST
+ INTERFACE xx
+   MODULE PROCEDURE xx
+ END INTERFACE
+ public :: xx
+CONTAINS
+ SUBROUTINE xx(i)
+  INTEGER :: I
+  I=7
+ END SUBROUTINE
+END
+MODULE TOO
+CONTAINS
+ SUBROUTINE SUB(xx,I)
+  INTERFACE
+    SUBROUTINE XX(I)
+        INTEGER :: I
+    END SUBROUTINE
+  END INTERFACE
+  CALL XX(I)
+ END SUBROUTINE
+END MODULE TOO
+PROGRAM TT
+ USE TEST
+ USE TOO
+ INTEGER :: I
+ CALL SUB(xx,I)
+ IF (I.NE.7) CALL ABORT()
+END PROGRAM
+! { dg-final { cleanup-modules "test too" } }
diff --git a/gcc/testsuite/gfortran.dg/import5.f90 b/gcc/testsuite/gfortran.dg/import5.f90
new file mode 100644
index 0000000..0106c4e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/import5.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! Test for import in interfaces PR fortran/30922
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module test_import
+  implicit none
+
+  type :: my_type
+     integer :: data
+  end type my_type
+  integer, parameter :: n = 20
+
+  interface
+     integer function func1(param)
+       import
+       type(my_type) :: param(n)
+     end function func1
+
+     integer function func2(param)
+       import :: my_type
+       type(my_type), value :: param
+     end function func2
+  end interface
+
+contains
+
+  subroutine sub1 ()
+
+    interface
+      integer function func3(param)
+        import
+        type(my_type), dimension (n) :: param
+      end function func3
+
+      integer function func4(param)
+        import :: my_type, n
+        type(my_type), dimension (n) :: param
+      end function func4
+    end interface
+
+  end subroutine sub1
+end module test_import
+! { dg-final { cleanup-modules "test_import" } }