[multiple changes]

2013-01-27 Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/55789
	PR fortran/56047
	* gfortran.h : Add associate_var to symbol_attr.
	* resolve.c (resolve_assoc_var): Set associate_var attribute.
	If the target class_ok is set, set it for the associate
	variable.
	* check.c (allocatable_check): Associate variables should not
	have the allocatable attribute even if their symbols do.
	* class.c (gfc_build_class_symbol): Symbols with associate_var
	set will always have a good class container.

2013-01-27  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/55789
	* gfortran.dg/associate_14.f90: New test.

	PR fortran/56047
	* gfortran.dg/associate_13.f90: New test.

From-SVN: r195492

gcc/fortran/ChangeLog

+2013-01-27 Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/55789
+	PR fortran/56047
+	* gfortran.h : Add associate_var to symbol_attr.
+	* resolve.c (resolve_assoc_var): Set associate_var attribute.
+	If the target class_ok is set, set it for the associate
+	variable.
+	* check.c (allocatable_check): Associate variables should not
+	have the allocatable attribute even if their symbols do.
+	* class.c (gfc_build_class_symbol): Symbols with associate_var
+	set will always have a good class container.
+
 2013-01-23  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/56081

gcc/fortran/check.c

@@ -454,7 +454,7 @@ allocatable_check (gfc_expr *e, int n)
   symbol_attribute attr;
 
   attr = gfc_variable_attr (e, NULL);
-  if (!attr.allocatable)
+  if (!attr.allocatable || attr.associate_var)
     {
       gfc_error ("'%s' argument of '%s' intrinsic at %L must be ALLOCATABLE",
 		 gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,

gcc/fortran/class.c

@@ -568,7 +568,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
     return SUCCESS;
 
   attr->class_ok = attr->dummy || attr->pointer || attr->allocatable
-		   || attr->select_type_temporary;
+		   || attr->select_type_temporary || attr->associate_var;
 
   if (!attr->class_ok)
     /* We can not build the class container yet.  */

gcc/fortran/gfortran.h

@@ -803,8 +803,9 @@ typedef struct
 	   private_comp:1, zero_comp:1, coarray_comp:1, lock_comp:1,
 	   defined_assign_comp:1, unlimited_polymorphic:1;
 
-  /* This is a temporary selector for SELECT TYPE.  */
-  unsigned select_type_temporary:1;
+  /* This is a temporary selector for SELECT TYPE or an associate
+     variable for SELECT_TYPE or ASSOCIATE.  */
+  unsigned select_type_temporary:1, associate_var:1;
 
   /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES).  */
   unsigned ext_attr:EXT_ATTR_NUM;

gcc/fortran/resolve.c

@@ -8325,6 +8325,13 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
 	 has no corank.  */
       sym->as->corank = 0;
     }
+
+  /* Mark this as an associate variable.  */
+  sym->attr.associate_var = 1;
+
+  /* If the target is a good class object, so is the associate variable.  */
+  if (sym->ts.type == BT_CLASS && gfc_expr_attr (target).class_ok)
+    sym->attr.class_ok = 1;
 }
 
 

gcc/testsuite/ChangeLog

+2013-01-27  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/55789
+	* gfortran.dg/associate_14.f90: New test.
+
+	PR fortran/56047
+	* gfortran.dg/associate_13.f90: New test.
+
 2013-01-25  Jakub Jelinek  <jakub@redhat.com>
 
 	PR tree-optimization/56098

gcc/testsuite/gfortran.dg/associate_13.f90

+! { dg-do run }
+!
+! Tests the fix for PR56047.  This is actually a development of
+! the test case of comment #10.
+!
+! Reported by Juergen Reuter  <juergen.reuter@desy.de>
+!
+  implicit none
+  type :: process_variant_def_t
+    integer :: i
+  end type
+  type :: process_component_def_t
+     class(process_variant_def_t), allocatable :: variant_def
+  end type
+  type(process_component_def_t), dimension(1:2) :: initial
+  allocate (initial(1)%variant_def, source = process_variant_def_t (99))
+  associate (template => initial(1)%variant_def)
+    template%i = 77
+  end associate
+  if (initial(1)%variant_def%i .ne. 77) call abort
+end

gcc/testsuite/gfortran.dg/associate_14.f90

+! { dg-do compile }
+! Tests the fix for PR55984.
+!
+! Contributed by Sylwester Arabas  <slayoo@staszic.waw.pl>
+!
+module bcd_m
+  type, abstract :: bcd_t
+    contains
+    procedure(bcd_fill_halos), deferred :: fill_halos
+  end type
+  abstract interface
+    subroutine bcd_fill_halos(this)
+      import :: bcd_t
+      class(bcd_t ) :: this
+    end subroutine
+  end interface
+end module
+
+module solver_m
+  use bcd_m
+  type, abstract :: solver_t
+    integer :: n, hlo
+    class(bcd_t), pointer :: bcx, bcy
+    contains
+    procedure(solver_advop), deferred :: advop
+  end type
+  abstract interface
+    subroutine solver_advop(this)
+      import solver_t
+      class(solver_t) :: this
+    end subroutine
+  end interface
+  contains
+end module
+
+module solver_mpdata_m
+  use solver_m
+  type :: mpdata_t
+    class(bcd_t), pointer :: bcx, bcy
+    contains
+    procedure :: advop => mpdata_advop
+  end type
+  contains
+  subroutine mpdata_advop(this)
+    class(mpdata_t) :: this
+    associate ( bcx => this%bcx, bcy => this%bcy )
+      call bcx%fill_halos()
+    end associate
+  end subroutine
+end module
+
+  use solver_mpdata_m
+  class(mpdata_t), allocatable :: that
+  call mpdata_advop (that)
+end
+