PF fortran/60322

gcc/testsuite/ChangeLog:

2015-04-23  Andre Vehreschild  <vehre@gmx.de>

	PF fortran/60322
	* gfortran.dg/class_allocate_19.f03: New test.
	* gfortran.dg/class_array_20.f03: New test.
	* gfortran.dg/class_array_21.f03: New test.
	* gfortran.dg/finalize_10.f90: Corrected scan-trees.
	* gfortran.dg/finalize_15.f90: Fixing comparision to model
	initialization correctly.
	* gfortran.dg/finalize_29.f08: New test.


gcc/fortran/ChangeLog:

2015-04-23  Andre Vehreschild  <vehre@gmx.de>

	PR fortran/60322
	* expr.c (gfc_lval_expr_from_sym): Code to select the regular
	or class array added.
	* gfortran.h: Add IS_CLASS_ARRAY macro.
	* trans-array.c (gfc_add_loop_ss_code): Treat class objects
	to be referenced always.
	(build_class_array_ref): Adapt retrieval of array descriptor.
	(build_array_ref): Likewise.
	(gfc_conv_array_ref): Hand the vptr or the descriptor to 
	build_array_ref depending whether the sym is class or not.
	(gfc_trans_array_cobounds):  Select correct gfc_array_spec for
	regular and class arrays.
	(gfc_trans_array_bounds): Likewise.
	(gfc_trans_dummy_array_bias): Likewise. 
	(gfc_get_dataptr_offset): Correcting call of build_array_ref.
	(gfc_conv_expr_descriptor): Set the array's offset to -1 when
	lbound in inner most dim is 1 and symbol non-pointer/assoc.
	* trans-decl.c (gfc_build_qualified_array): Select correct
	gfc_array_spec for regular and class arrays.
	(gfc_build_dummy_array_decl): Likewise.
	(gfc_get_symbol_decl): Get a dummy array for class arrays.
	(gfc_trans_deferred_vars): Tell conv_expr that the descriptor
	is desired.
	* trans-expr.c (gfc_class_vptr_get): Get the class descriptor
	from the correct location for class arrays.
	(gfc_class_len_get): Likewise.
	(gfc_conv_intrinsic_to_class): Add handling of _len component.
	(gfc_conv_class_to_class):  Prevent access to unset array data
	when the array is an optional argument. Add handling of _len
	component.
	(gfc_copy_class_to_class): Check that _def_init is non-NULL
	when used in _vptr->copy()
	(gfc_trans_class_init_assign): Ensure that the rank of
	_def_init is zero.
	(gfc_conv_component_ref): Get the _vptr along with _data refs.
	(gfc_conv_variable): Make sure the temp array descriptor is
	returned for class arrays, too, and that class arrays are
	dereferenced correctly.
	(gfc_conv_procedure_call): For polymorphic type initialization
	the initializer has to be a pointer to _def_init stored in a
	dummy variable, which then needs to be used by value.
	* trans-intrinsic.c (gfc_conv_intrinsic_sizeof): Use the
	temporary array descriptor for class arrays, too.
	(gfc_conv_intrinsic_storage_size): Likewise.
	(gfc_conv_intrinsic_loc): Add ref to _data for BT_CLASS
	expressions.
	* trans-stmt.c (trans_associate_var): Use a temporary array for
	the associate variable of class arrays, too, making the array
	one-based (lbound == 1).
	* trans-types.c (gfc_is_nodesc_array): Use the correct
	array data.
	* trans.c (gfc_build_array_ref): Use the dummy array descriptor
	when present.
	* trans.h: Add class_vptr to gfc_se for storing a class ref's
	vptr.

From-SVN: r222361

gcc/fortran/ChangeLog

+2015-04-23  Andre Vehreschild  <vehre@gmx.de>
+
+	PR fortran/60322
+	* expr.c (gfc_lval_expr_from_sym): Code to select the regular
+	or class array added.
+	* gfortran.h: Add IS_CLASS_ARRAY macro.
+	* trans-array.c (gfc_add_loop_ss_code): Treat class objects
+	to be referenced always.
+	(build_class_array_ref): Adapt retrieval of array descriptor.
+	(build_array_ref): Likewise.
+	(gfc_conv_array_ref): Hand the vptr or the descriptor to 
+	build_array_ref depending whether the sym is class or not.
+	(gfc_trans_array_cobounds):  Select correct gfc_array_spec for
+	regular and class arrays.
+	(gfc_trans_array_bounds): Likewise.
+	(gfc_trans_dummy_array_bias): Likewise. 
+	(gfc_get_dataptr_offset): Correcting call of build_array_ref.
+	(gfc_conv_expr_descriptor): Set the array's offset to -1 when
+	lbound in inner most dim is 1 and symbol non-pointer/assoc.
+	* trans-decl.c (gfc_build_qualified_array): Select correct
+	gfc_array_spec for regular and class arrays.
+	(gfc_build_dummy_array_decl): Likewise.
+	(gfc_get_symbol_decl): Get a dummy array for class arrays.
+	(gfc_trans_deferred_vars): Tell conv_expr that the descriptor
+	is desired.
+	* trans-expr.c (gfc_class_vptr_get): Get the class descriptor
+	from the correct location for class arrays.
+	(gfc_class_len_get): Likewise.
+	(gfc_conv_intrinsic_to_class): Add handling of _len component.
+	(gfc_conv_class_to_class):  Prevent access to unset array data
+	when the array is an optional argument. Add handling of _len
+	component.
+	(gfc_copy_class_to_class): Check that _def_init is non-NULL
+	when used in _vptr->copy()
+	(gfc_trans_class_init_assign): Ensure that the rank of
+	_def_init is zero.
+	(gfc_conv_component_ref): Get the _vptr along with _data refs.
+	(gfc_conv_variable): Make sure the temp array descriptor is
+	returned for class arrays, too, and that class arrays are
+	dereferenced correctly.
+	(gfc_conv_procedure_call): For polymorphic type initialization
+	the initializer has to be a pointer to _def_init stored in a
+	dummy variable, which then needs to be used by value.
+	* trans-intrinsic.c (gfc_conv_intrinsic_sizeof): Use the
+	temporary array descriptor for class arrays, too.
+	(gfc_conv_intrinsic_storage_size): Likewise.
+	(gfc_conv_intrinsic_loc): Add ref to _data for BT_CLASS
+	expressions.
+	* trans-stmt.c (trans_associate_var): Use a temporary array for
+	the associate variable of class arrays, too, making the array
+	one-based (lbound == 1).
+	* trans-types.c (gfc_is_nodesc_array): Use the correct
+	array data.
+	* trans.c (gfc_build_array_ref): Use the dummy array descriptor
+	when present.
+	* trans.h: Add class_vptr to gfc_se for storing a class ref's
+	vptr.
+
 2015-04-22  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/65429

gcc/fortran/expr.c

@@ -4052,6 +4052,7 @@ gfc_expr *
 gfc_lval_expr_from_sym (gfc_symbol *sym)
 {
   gfc_expr *lval;
+  gfc_array_spec *as;
   lval = gfc_get_expr ();
   lval->expr_type = EXPR_VARIABLE;
   lval->where = sym->declared_at;
@@ -4059,10 +4060,10 @@ gfc_lval_expr_from_sym (gfc_symbol *sym)
   lval->symtree = gfc_find_symtree (sym->ns->sym_root, sym->name);
 
   /* It will always be a full array.  */
-  lval->rank = sym->as ? sym->as->rank : 0;
+  as = IS_CLASS_ARRAY (sym) ? CLASS_DATA (sym)->as : sym->as;
+  lval->rank = as ? as->rank : 0;
   if (lval->rank)
-    gfc_add_full_array_ref (lval, sym->ts.type == BT_CLASS ?
-			    CLASS_DATA (sym)->as : sym->as);
+    gfc_add_full_array_ref (lval, as);
   return lval;
 }
 

gcc/fortran/gfortran.h

@@ -3210,6 +3210,11 @@ bool gfc_is_finalizable (gfc_symbol *, gfc_expr **);
 	 && CLASS_DATA (sym) \
 	 && CLASS_DATA (sym)->ts.u.derived \
 	 && CLASS_DATA (sym)->ts.u.derived->attr.unlimited_polymorphic)
+#define IS_CLASS_ARRAY(sym) \
+	(sym->ts.type == BT_CLASS \
+	 && CLASS_DATA (sym) \
+	 && CLASS_DATA (sym)->attr.dimension \
+	 && !CLASS_DATA (sym)->attr.class_pointer)
 
 /* frontend-passes.c */
 

gcc/fortran/trans-intrinsic.c

@@ -5921,8 +5921,17 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
     }
   else if (arg->ts.type == BT_CLASS)
     {
-      if (arg->rank)
+      /* For deferred length arrays, conv_expr_descriptor returns an
+	 indirect_ref to the component.  */
+      if (arg->rank < 0
+	  || (arg->rank > 0 && !VAR_P (argse.expr)
+	      && GFC_DECL_CLASS (TREE_OPERAND (argse.expr, 0))))
 	byte_size = gfc_class_vtab_size_get (TREE_OPERAND (argse.expr, 0));
+      else if (arg->rank > 0)
+	/* The scalarizer added an additional temp.  To get the class' vptr
+	   one has to look at the original backend_decl.  */
+	byte_size = gfc_class_vtab_size_get (
+	      GFC_DECL_SAVED_DESCRIPTOR (arg->symtree->n.sym->backend_decl));
       else
 	byte_size = gfc_class_vtab_size_get (argse.expr);
     }
@@ -6053,7 +6062,11 @@ gfc_conv_intrinsic_storage_size (gfc_se *se, gfc_expr *expr)
       gfc_conv_expr_descriptor (&argse, arg);
       if (arg->ts.type == BT_CLASS)
 	{
-	  tmp = gfc_class_vtab_size_get (TREE_OPERAND (argse.expr, 0));
+	  if (arg->rank > 0)
+	    tmp = gfc_class_vtab_size_get (
+		 GFC_DECL_SAVED_DESCRIPTOR (arg->symtree->n.sym->backend_decl));
+	  else
+	    tmp = gfc_class_vtab_size_get (TREE_OPERAND (argse.expr, 0));
 	  tmp = fold_convert (result_type, tmp);
 	  goto done;
 	}
@@ -7080,7 +7093,11 @@ gfc_conv_intrinsic_loc (gfc_se * se, gfc_expr * expr)
 
   arg_expr = expr->value.function.actual->expr;
   if (arg_expr->rank == 0)
-    gfc_conv_expr_reference (se, arg_expr);
+    {
+      if (arg_expr->ts.type == BT_CLASS)
+	gfc_add_component_ref (arg_expr, "_data");
+      gfc_conv_expr_reference (se, arg_expr);
+    }
   else
     gfc_conv_array_parameter (se, arg_expr, true, NULL, NULL, NULL);
   se->expr = convert (gfc_get_int_type (gfc_index_integer_kind), se->expr);

gcc/fortran/trans-stmt.c

@@ -1390,12 +1390,29 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
 
       gfc_init_se (&se, NULL);
       se.descriptor_only = 1;
-      gfc_conv_expr (&se, e);
+      /* In a select type the (temporary) associate variable shall point to
+	 a standard fortran array (lower bound == 1), but conv_expr ()
+	 just maps to the input array in the class object, whose lbound may
+	 be arbitrary.  conv_expr_descriptor solves this by inserting a
+	 temporary array descriptor.  */
+      gfc_conv_expr_descriptor (&se, e);
 
-      gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)));
+      gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr))
+		  || GFC_ARRAY_TYPE_P (TREE_TYPE (se.expr)));
       gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (sym->backend_decl)));
 
-      gfc_add_modify (&se.pre, sym->backend_decl, se.expr);
+      if (GFC_ARRAY_TYPE_P (TREE_TYPE (se.expr)))
+	{
+	  if (INDIRECT_REF_P (se.expr))
+	    tmp = TREE_OPERAND (se.expr, 0);
+	  else
+	    tmp = se.expr;
+
+	  gfc_add_modify (&se.pre, sym->backend_decl,
+			  gfc_class_data_get (GFC_DECL_SAVED_DESCRIPTOR (tmp)));
+	}
+      else
+	gfc_add_modify (&se.pre, sym->backend_decl, se.expr);
 
       if (unlimited)
 	{
@@ -1406,7 +1423,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
 			  gfc_get_dtype (TREE_TYPE (sym->backend_decl)));
 	}
 
-      gfc_add_init_cleanup (block, gfc_finish_block( &se.pre),
+      gfc_add_init_cleanup (block, gfc_finish_block (&se.pre),
 			    gfc_finish_block (&se.post));
     }
 
@@ -1449,9 +1466,18 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
 	    }
 	  if (need_len_assign)
 	    {
-	      /* Get the _len comp from the target expr by stripping _data
-		 from it and adding component-ref to _len.  */
-	      tmp = gfc_class_len_get (TREE_OPERAND (target_expr, 0));
+	      if (e->symtree
+		  && DECL_LANG_SPECIFIC (e->symtree->n.sym->backend_decl)
+		 && GFC_DECL_SAVED_DESCRIPTOR (e->symtree->n.sym->backend_decl))
+		/* Use the original class descriptor stored in the saved
+		   descriptor to get the target_expr.  */
+		target_expr =
+		    GFC_DECL_SAVED_DESCRIPTOR (e->symtree->n.sym->backend_decl);
+	      else
+		/* Strip the _data component from the target_expr.  */
+		target_expr = TREE_OPERAND (target_expr, 0);
+	      /* Add a reference to the _len comp to the target expr.  */
+	      tmp = gfc_class_len_get (target_expr);
 	      /* Get the component-ref for the temp structure's _len comp.  */
 	      charlen = gfc_class_len_get (se.expr);
 	      /* Add the assign to the beginning of the the block...  */

gcc/fortran/trans-types.c

@@ -1288,25 +1288,35 @@ gfc_get_element_type (tree type)
 int
 gfc_is_nodesc_array (gfc_symbol * sym)
 {
-  gcc_assert (sym->attr.dimension || sym->attr.codimension);
+  symbol_attribute *array_attr;
+  gfc_array_spec *as;
+  bool is_classarray = IS_CLASS_ARRAY (sym);
+
+  array_attr = is_classarray ? &CLASS_DATA (sym)->attr : &sym->attr;
+  as = is_classarray ? CLASS_DATA (sym)->as : sym->as;
+
+  gcc_assert (array_attr->dimension || array_attr->codimension);
 
   /* We only want local arrays.  */
-  if (sym->attr.pointer || sym->attr.allocatable)
+  if ((sym->ts.type != BT_CLASS && sym->attr.pointer)
+      || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.class_pointer)
+      || array_attr->allocatable)
     return 0;
 
   /* We want a descriptor for associate-name arrays that do not have an
-     explicitly known shape already.  */
-  if (sym->assoc && sym->as->type != AS_EXPLICIT)
+	 explicitly known shape already.  */
+  if (sym->assoc && as->type != AS_EXPLICIT)
     return 0;
 
+  /* The dummy is stored in sym and not in the component.  */
   if (sym->attr.dummy)
-    return sym->as->type != AS_ASSUMED_SHAPE
-	   && sym->as->type != AS_ASSUMED_RANK;
+    return as->type != AS_ASSUMED_SHAPE
+	&& as->type != AS_ASSUMED_RANK;
 
   if (sym->attr.result || sym->attr.function)
     return 0;
 
-  gcc_assert (sym->as->type == AS_EXPLICIT || sym->as->cp_was_assumed);
+  gcc_assert (as->type == AS_EXPLICIT || as->cp_was_assumed);
 
   return 1;
 }

gcc/fortran/trans.c

@@ -321,7 +321,7 @@ gfc_build_addr_expr (tree type, tree t)
 /* Build an ARRAY_REF with its natural type.  */
 
 tree
-gfc_build_array_ref (tree base, tree offset, tree decl)
+gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr)
 {
   tree type = TREE_TYPE (base);
   tree tmp;
@@ -353,30 +353,47 @@ gfc_build_array_ref (tree base, tree offset, tree decl)
   /* If the array reference is to a pointer, whose target contains a
      subreference, use the span that is stored with the backend decl
      and reference the element with pointer arithmetic.  */
-  if (decl && (TREE_CODE (decl) == FIELD_DECL
-		 || TREE_CODE (decl) == VAR_DECL
-		 || TREE_CODE (decl) == PARM_DECL)
-	&& ((GFC_DECL_SUBREF_ARRAY_P (decl)
-	      && !integer_zerop (GFC_DECL_SPAN(decl)))
+  if ((decl && (TREE_CODE (decl) == FIELD_DECL
+		|| TREE_CODE (decl) == VAR_DECL
+		|| TREE_CODE (decl) == PARM_DECL)
+       && ((GFC_DECL_SUBREF_ARRAY_P (decl)
+	    && !integer_zerop (GFC_DECL_SPAN (decl)))
 	   || GFC_DECL_CLASS (decl)))
+      || vptr)
     {
-      if (GFC_DECL_CLASS (decl))
+      if (decl)
 	{
-	  /* Allow for dummy arguments and other good things.  */
-	  if (POINTER_TYPE_P (TREE_TYPE (decl)))
-	    decl = build_fold_indirect_ref_loc (input_location, decl);
-
-	  /* Check if '_data' is an array descriptor. If it is not,
-	     the array must be one of the components of the class object,
-	     so return a normal array reference.  */
-	  if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (gfc_class_data_get (decl))))
-	    return build4_loc (input_location, ARRAY_REF, type, base,
-			       offset, NULL_TREE, NULL_TREE);
-
-	  span = gfc_class_vtab_size_get (decl);
+	  if (GFC_DECL_CLASS (decl))
+	    {
+	      /* When a temporary is in place for the class array, then the
+		 original class' declaration is stored in the saved
+		 descriptor.  */
+	      if (DECL_LANG_SPECIFIC (decl) && GFC_DECL_SAVED_DESCRIPTOR (decl))
+		decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
+	      else
+		{
+		  /* Allow for dummy arguments and other good things.  */
+		  if (POINTER_TYPE_P (TREE_TYPE (decl)))
+		    decl = build_fold_indirect_ref_loc (input_location, decl);
+
+		  /* Check if '_data' is an array descriptor.  If it is not,
+		     the array must be one of the components of the class
+		     object, so return a normal array reference.  */
+		  if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (
+						gfc_class_data_get (decl))))
+		    return build4_loc (input_location, ARRAY_REF, type, base,
+				       offset, NULL_TREE, NULL_TREE);
+		}
+
+	      span = gfc_class_vtab_size_get (decl);
+	    }
+	  else if (GFC_DECL_SUBREF_ARRAY_P (decl))
+	    span = GFC_DECL_SPAN (decl);
+	  else
+	    gcc_unreachable ();
 	}
-      else if (GFC_DECL_SUBREF_ARRAY_P (decl))
-	span = GFC_DECL_SPAN(decl);
+      else if (vptr)
+	span = gfc_vptr_size_get (vptr);
       else
 	gcc_unreachable ();
 

gcc/fortran/trans.h

@@ -49,6 +49,10 @@ typedef struct gfc_se
   /* The length of a character string value.  */
   tree string_length;
 
+  /* When expr is a reference to a class object, store its vptr access
+     here.  */
+  tree class_vptr;
+
   /* If set gfc_conv_variable will return an expression for the array
      descriptor. When set, want_pointer should also be set.
      If not set scalarizing variables will be substituted.  */
@@ -528,7 +532,7 @@ tree gfc_get_function_decl (gfc_symbol *);
 tree gfc_build_addr_expr (tree, tree);
 
 /* Build an ARRAY_REF.  */
-tree gfc_build_array_ref (tree, tree, tree);
+tree gfc_build_array_ref (tree, tree, tree, tree vptr = NULL_TREE);
 
 /* Creates a label.  Decl is artificial if label_id == NULL_TREE.  */
 tree gfc_build_label_decl (tree);

gcc/testsuite/ChangeLog

+2015-04-23  Andre Vehreschild  <vehre@gmx.de>
+
+	PR fortran/60322
+	* gfortran.dg/class_allocate_19.f03: New test.
+	* gfortran.dg/class_array_20.f03: New test.
+	* gfortran.dg/class_array_21.f03: New test.
+	* gfortran.dg/finalize_10.f90: Corrected scan-trees.
+	* gfortran.dg/finalize_15.f90: Fixing comparision to model
+	initialization correctly.
+	* gfortran.dg/finalize_29.f08: New test.
+
 2015-04-22  Bill Schmidt  <wschmidt@linux.vnet.ibm.com>
 
 	* gcc.target/powerpc/swaps-p8-18.c: New test.

gcc/testsuite/gfortran.dg/finalize_10.f90

@@ -27,8 +27,8 @@ end subroutine foo
 ! Finalize CLASS + set default init
 ! { dg-final { scan-tree-dump-times "y->_vptr->_final \\(&desc.\[0-9\]+, y->_vptr->_size, 0\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump       "__builtin_memcpy \\(\\(void .\\) y->_data, \\(void .\\) y->_vptr->_def_init, \\((unsigned long|unsigned int|character\\(kind=4\\))\\) y->_vptr->_size\\);" "original" } }
-! { dg-final { scan-tree-dump-times "x->_vptr->_final \\(&x->_data, x->_vptr->_size, 0\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "x->_vptr->_copy \\(x->_vptr->_def_init, &x->_data\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x->_vptr->_final \\(&parm.\[0-9\]+, x->_vptr->_size, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "x->_vptr->_copy \\(" 1 "original" } }
 
 ! FINALIZE TYPE:
 ! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void \\*\\) &\\(\\*aa.\[0-9\]+\\)\\\[0\\\];" 1 "original" } }

gcc/testsuite/gfortran.dg/finalize_15.f90

@@ -9,37 +9,37 @@ module m
   implicit none
 
   type t1
-    integer :: i
+    integer :: i = 1
   contains
     final :: fini_elem
   end type t1
 
   type, extends(t1) :: t1e
-    integer :: j
+    integer :: j = 11
   contains
     final :: fini_elem2
   end type t1e
 
   type t2
-    integer :: i
+    integer :: i = 2
   contains
     final :: fini_shape
   end type t2
 
   type, extends(t2) :: t2e
-    integer :: j
+    integer :: j = 22
   contains
     final :: fini_shape2
   end type t2e
 
   type t3
-    integer :: i
+    integer :: i = 3
   contains
     final :: fini_explicit
   end type t3
 
   type, extends(t3) :: t3e
-    integer :: j
+    integer :: j = 33
   contains
     final :: fini_explicit2
   end type t3e
@@ -204,31 +204,31 @@ program test
 
   select type(x)
     type is (t1e)
-      call check_val(x%i, 1)
-      call check_val(x%j, 100)
+      call check_val(x%i, 1, 1)
+      call check_val(x%j, 100, 11)
   end select
 
   select type(y)
     type is (t2e)
-      call check_val(y%i, 1)
-      call check_val(y%j, 100)
+      call check_val(y%i, 1, 2)
+      call check_val(y%j, 100, 22)
   end select
 
   select type(z)
     type is (t3e)
-      call check_val(z%i, 1)
-      call check_val(z%j, 100)
+      call check_val(z%i, 1, 3)
+      call check_val(z%j, 100, 33)
   end select
 
 contains
-  subroutine check_val(x, factor)
+  subroutine check_val(x, factor, val)
     integer :: x(:,:)
-    integer, value :: factor
+    integer, value :: factor, val
     integer :: i, j
     do i = 1, 10
       do j = 1, 10
         if (mod (j-1, 2) == 0 .and. mod (i-1, 3) == 0) then
-          if (x(j,i) /= (j + 100*i)*factor*(-13)) call abort ()
+          if (x(j,i) /= val) call abort ()
         else
           if (x(j,i) /= (j + 100*i)*factor) call abort ()
         end if