[Patch, Fortran] assumed-rank some bound intrinsics support, fix failures and improve diagnostcs

[Patch, Fortran] assumed-rank some bound intrinsics support, fix failures and improve diagnostcs

[Tobias Burnus]

[-- Attachment #1: Type: text/plain, Size: 904 bytes --]

Dear all,

this patch is a cleanup follow up to the assumed-rank patch. Changes:
* Fix pattern matching for the dump. for some reason, the DTYPE differes 
between i686 and x86-64.
* There was a proper check missing that assumed-rank arrays may not have 
a codimension. (There are now checks in array.c, decl.c and - 
preexisting - resolve.c, all are triggered by the test case _11.)
* I re-added my lbound/ubound patch. It still only works with dim=.

For lbound/ubound without dim= and for shape, one has to modify the 
scalarizer a bit. See discussion at 
http://gcc.gnu.org/ml/fortran/2012-07/msg00032.html


Mikael: I wouldn't mind if you could have a look at the scalarizer - you 
seem to have an idea how one can implement it with minimal effort/code 
cluttering.


Build and regtested on x86-64-linux.
OK for the trunk?

Tobias

PS: Sorry for missing the regression failure before the committal.


[-- Attachment #2: assumed-rank-bounds.diff --]
[-- Type: text/x-patch, Size: 17166 bytes --]

2012-07-20  Tobias Burnus  <burnus@net-b.de>

	PR fortran/48820
	* trans-intrinsic.c (gfc_conv_intrinsic_bound): Support
	lbound/ubound with dim= for assumed-rank arrays.
	* array.c (gfc_set_array_spec): Reject coarrays with
	assumed shape.
	* decl.c (merge_array_spec): Ditto. Return gfc_try.
	(match_attr_spec, match_attr_spec): Update call.

2012-07-20  Tobias Burnus  <burnus@net-b.de>

	PR fortran/48820
	* gfortran.dg/assumed_rank_3.f90: New.
	* gfortran.dg/assumed_rank_11.f90: New.
	* gfortran.dg/assumed_rank_1.f90: Update dg-error.
	* gfortran.dg/assumed_rank_2.f90: Update dg-error.
	* gfortran.dg/assumed_rank_7.f90: Update dg-error.
	* gfortran.dg/assumed_rank_12.f90: Update dg-error.

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index acae59f..1b700b8 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -750,6 +750,14 @@ gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc)
       return SUCCESS;
     }
 
+  if ((sym->as->type == AS_ASSUMED_RANK && as->corank)
+      || (as->type == AS_ASSUMED_RANK && sym->as->corank))
+    {
+      gfc_error ("The assumed-rank array '%s' at %L shall not have a "
+		 "codimension", sym->name, error_loc);
+      return FAILURE;
+    }
+
   if (as->corank)
     {
       /* The "sym" has no corank (checked via gfc_add_codimension). Thus
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 66e2ca8..c836b25 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -589,13 +589,17 @@ cleanup:
 
 /* Auxiliary function to merge DIMENSION and CODIMENSION array specs.  */
 
-static void
+static gfc_try
 merge_array_spec (gfc_array_spec *from, gfc_array_spec *to, bool copy)
 {
   int i;
 
-  gcc_assert (from->rank != -1 || to->corank == 0);
-  gcc_assert (to->rank != -1 || from->corank == 0);
+  if ((from->type == AS_ASSUMED_RANK && to->corank)
+      || (to->type == AS_ASSUMED_RANK && from->corank))
+    {
+      gfc_error ("The assumed-rank array at %C shall not have a codimension");
+      return FAILURE;
+    }
 
   if (to->rank == 0 && from->rank > 0)
     {
@@ -642,6 +646,8 @@ merge_array_spec (gfc_array_spec *from, gfc_array_spec *to, bool copy)
 	    }
 	}
     }
+
+  return SUCCESS;
 }
 
 
@@ -1813,8 +1805,12 @@ variable_decl (int elem)
 
   if (m == MATCH_NO)
     as = gfc_copy_array_spec (current_as);
-  else if (current_as)
-    merge_array_spec (current_as, as, true);
+  else if (current_as
+	   && merge_array_spec (current_as, as, true) == FAILURE)
+    {
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
 
   if (gfc_option.flag_cray_pointer)
     cp_as = gfc_copy_array_spec (as);
@@ -3526,7 +3522,8 @@ match_attr_spec (void)
 	    current_as = as;
 	  else if (m == MATCH_YES)
 	    {
-	      merge_array_spec (as, current_as, false);
+	      if (merge_array_spec (as, current_as, false) == FAILURE)
+		m = MATCH_ERROR;
 	      free (as);
 	    }
 
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index be94219..7bcfda9 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1367,6 +1367,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
   gfc_se argse;
   gfc_ss *ss;
   gfc_array_spec * as;
+  bool assumed_rank_lb_one;
 
   arg = expr->value.function.actual;
   arg2 = arg->next;
@@ -1408,27 +1409,36 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
 
   desc = argse.expr;
 
+  as = gfc_get_full_arrayspec_from_expr (arg->expr);
+
   if (INTEGER_CST_P (bound))
     {
       int hi, low;
 
       hi = TREE_INT_CST_HIGH (bound);
       low = TREE_INT_CST_LOW (bound);
-      if (hi || low < 0 || low >= GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc)))
+      if (hi || low < 0
+	  || ((!as || as->type != AS_ASSUMED_RANK)
+	      && low >= GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc)))
+	  || low > GFC_MAX_DIMENSIONS)
 	gfc_error ("'dim' argument of %s intrinsic at %L is not a valid "
 		   "dimension index", upper ? "UBOUND" : "LBOUND",
 		   &expr->where);
     }
-  else
+
+  if (!INTEGER_CST_P (bound) || (as && as->type == AS_ASSUMED_RANK))
     {
       if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
         {
           bound = gfc_evaluate_now (bound, &se->pre);
           cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
 				  bound, build_int_cst (TREE_TYPE (bound), 0));
-          tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))];
+	  if (as && as->type == AS_ASSUMED_RANK)
+	    tmp = get_rank_from_desc (desc);
+	  else
+	    tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))];
           tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
-				 bound, tmp);
+				 bound, fold_convert(TREE_TYPE (bound), tmp));
           cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
 				  boolean_type_node, cond, tmp);
           gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where,
@@ -1436,11 +1446,19 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
         }
     }
 
+  /* Take care of the lbound shift for assumed-rank arrays, which are
+     nonallocatable and nonpointers. Those has a lbound of 1.  */
+  assumed_rank_lb_one = as && as->type == AS_ASSUMED_RANK
+			&& ((arg->expr->ts.type != BT_CLASS
+			     && !arg->expr->symtree->n.sym->attr.allocatable
+			     && !arg->expr->symtree->n.sym->attr.pointer)
+			    || (arg->expr->ts.type == BT_CLASS
+			     && !CLASS_DATA (arg->expr)->attr.allocatable
+			     && !CLASS_DATA (arg->expr)->attr.class_pointer));
+
   ubound = gfc_conv_descriptor_ubound_get (desc, bound);
   lbound = gfc_conv_descriptor_lbound_get (desc, bound);
   
-  as = gfc_get_full_arrayspec_from_expr (arg->expr);
-
   /* 13.14.53: Result value for LBOUND
 
      Case (i): For an array section or for an array expression other than a
@@ -1462,7 +1480,9 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
                not have size zero and has value zero if dimension DIM has
                size zero.  */
 
-  if (as)
+  if (!upper && assumed_rank_lb_one)
+    se->expr = gfc_index_one_node;
+  else if (as)
     {
       tree stride = gfc_conv_descriptor_stride_get (desc, bound);
 
@@ -1488,9 +1508,19 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
 	  cond = fold_build2_loc (input_location, TRUTH_OR_EXPR,
 				  boolean_type_node, cond, cond5);
 
+	  if (assumed_rank_lb_one)
+	    {
+	      tmp = fold_build2_loc (input_location, MINUS_EXPR,
+			       gfc_array_index_type, ubound, lbound);
+	      tmp = fold_build2_loc (input_location, PLUS_EXPR,
+			       gfc_array_index_type, tmp, gfc_index_one_node);
+	    }
+          else
+            tmp = ubound;
+
 	  se->expr = fold_build3_loc (input_location, COND_EXPR,
 				      gfc_array_index_type, cond,
-				      ubound, gfc_index_zero_node);
+				      tmp, gfc_index_zero_node);
 	}
       else
 	{
diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_1.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_1.f90
index d68f1f9..44e278c 100644
--- a/gcc/testsuite/gfortran.dg/assumed_rank_1.f90
+++ b/gcc/testsuite/gfortran.dg/assumed_rank_1.f90
@@ -5,8 +5,6 @@
 !
 ! Assumed-rank tests
 !
-! FIXME: The ubound/lbound checks have to be re-enabled when
-! after they are supported
 
 implicit none
 
@@ -106,14 +104,14 @@ contains
     if (size(a) /= product (high - low +1)) call abort()
 
     if (rnk > 0) then
-!      if (1 /= lbound(a,1)) call abort()
-!      if (high(1)-low(1)+1 /= ubound(a,1)) call abort()
+      if (1 /= lbound(a,1)) call abort()
+      if (high(1)-low(1)+1 /= ubound(a,1)) call abort()
       if (size (a,1) /= high(1)-low(1)+1) call abort()
     end if
 
     do i = 1, rnk
-!      if (1 /= lbound(a,i)) call abort()
-!      if (high(i)-low(i)+1 /= ubound(a,i)) call abort()
+      if (1 /= lbound(a,i)) call abort()
+      if (high(i)-low(i)+1 /= ubound(a,i)) call abort()
       if (size (a,i) /= high(i)-low(i)+1) call abort()
     end do
     call check_value (a, rnk, val)
@@ -131,14 +129,14 @@ contains
     if (size(a) /= product (high - low +1)) call abort()
 
     if (rnk > 0) then
-!      if (low(1) /= lbound(a,1)) call abort()
-!      if (high(1) /= ubound(a,1)) call abort()
+      if (low(1) /= lbound(a,1)) call abort()
+      if (high(1) /= ubound(a,1)) call abort()
       if (size (a,1) /= high(1)-low(1)+1) call abort()
     end if
 
     do i = 1, rnk
-!      if (low(i) /= lbound(a,i)) call abort()
-!      if (high(i) /= ubound(a,i)) call abort()
+      if (low(i) /= lbound(a,i)) call abort()
+      if (high(i) /= ubound(a,i)) call abort()
       if (size (a,i) /= high(i)-low(i)+1) call abort()
     end do
     call check_value (a, rnk, val)
diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_12.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_12.f90
index a2abcba..f947f49 100644
--- a/gcc/testsuite/gfortran.dg/assumed_rank_12.f90
+++ b/gcc/testsuite/gfortran.dg/assumed_rank_12.f90
@@ -16,6 +16,6 @@ function f() result(res)
 end function f
 end
 
-! { dg-final { scan-tree-dump " = f \\(\\);.*desc.0.dtype = 600;.*desc.0.data = .void .. D.*;.*sub \\(&desc.0\\);.*D.*= .integer.kind=4. .. desc.0.data;" "original" } }
+! { dg-final { scan-tree-dump " = f \\(\\);.*desc.0.dtype = .*;.*desc.0.data = .void .. D.*;.*sub \\(&desc.0\\);.*D.*= .integer.kind=4. .. desc.0.data;" "original" } }
 ! { dg-final { cleanup-tree-dump "original" } }
 
diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_2.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_2.f90
index 981e5cc2..344278e 100644
--- a/gcc/testsuite/gfortran.dg/assumed_rank_2.f90
+++ b/gcc/testsuite/gfortran.dg/assumed_rank_2.f90
@@ -6,8 +6,6 @@
 ! Assumed-rank tests - same as assumed_rank_1.f90,
 ! but with bounds checks and w/o call to C function
 !
-! FIXME: The ubound/lbound checks have to be re-enabled when
-! after they are supported
 
 implicit none
 
@@ -73,14 +71,14 @@ contains
     if (size(a) /= product (high - low +1)) call abort()
 
     if (rnk > 0) then
-!      if (low(1) /= lbound(a,1)) call abort()
-!      if (high(1) /= ubound(a,1)) call abort()
+      if (low(1) /= lbound(a,1)) call abort()
+      if (high(1) /= ubound(a,1)) call abort()
       if (size (a,1) /= high(1)-low(1)+1) call abort()
     end if
 
     do i = 1, rnk
-!      if (low(i) /= lbound(a,i)) call abort()
-!      if (high(i) /= ubound(a,i)) call abort()
+      if (low(i) /= lbound(a,i)) call abort()
+      if (high(i) /= ubound(a,i)) call abort()
       if (size (a,i) /= high(i)-low(i)+1) call abort()
     end do
     call foo2(a, rnk, low, high, val)
@@ -98,14 +96,14 @@ contains
     if (size(a) /= product (high - low +1)) call abort()
 
     if (rnk > 0) then
-!      if (1 /= lbound(a,1)) call abort()
-!      if (high(1)-low(1)+1 /= ubound(a,1)) call abort()
+      if (1 /= lbound(a,1)) call abort()
+      if (high(1)-low(1)+1 /= ubound(a,1)) call abort()
       if (size (a,1) /= high(1)-low(1)+1) call abort()
     end if
 
     do i = 1, rnk
-!      if (1 /= lbound(a,i)) call abort()
-!      if (high(i)-low(i)+1 /= ubound(a,i)) call abort()
+      if (1 /= lbound(a,i)) call abort()
+      if (high(i)-low(i)+1 /= ubound(a,i)) call abort()
       if (size (a,i) /= high(i)-low(i)+1) call abort()
     end do
   end subroutine foo2
@@ -122,14 +120,14 @@ contains
     if (size(a) /= product (high - low +1)) call abort()
 
     if (rnk > 0) then
-!      if (low(1) /= lbound(a,1)) call abort()
-!      if (high(1) /= ubound(a,1)) call abort()
+      if (low(1) /= lbound(a,1)) call abort()
+      if (high(1) /= ubound(a,1)) call abort()
       if (size (a,1) /= high(1)-low(1)+1) call abort()
     end if
 
     do i = 1, rnk
-!      if (low(i) /= lbound(a,i)) call abort()
-!      if (high(i) /= ubound(a,i)) call abort()
+      if (low(i) /= lbound(a,i)) call abort()
+      if (high(i) /= ubound(a,i)) call abort()
       if (size (a,i) /= high(i)-low(i)+1) call abort()
     end do
     call foo(a, rnk, low, high, val)
diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_6.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_6.f90
index e5071bd..86da3f8 100644
--- a/gcc/testsuite/gfortran.dg/assumed_rank_6.f90
+++ b/gcc/testsuite/gfortran.dg/assumed_rank_6.f90
@@ -30,8 +30,8 @@ contains
   end subroutine
 end subroutine
 
-subroutine foo4(x) ! { dg-error "may not have the VALUE or CODIMENSION attribute" }
-  integer, codimension[*] :: x(..)
+subroutine foo4(x)
+  integer, codimension[*] :: x(..) ! { dg-error "The assumed-rank array at .1. shall not have a codimension" }
 end subroutine
 
 subroutine foo5(y) ! { dg-error "may not have the VALUE or CODIMENSION attribute" }
diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_7.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_7.f90
index 96d4d8f..f9ff3b9 100644
--- a/gcc/testsuite/gfortran.dg/assumed_rank_7.f90
+++ b/gcc/testsuite/gfortran.dg/assumed_rank_7.f90
@@ -4,8 +4,6 @@
 !
 ! Handle type/class for assumed-rank arrays
 !
-! FIXME: The ubound/lbound checks have to be re-enabled when
-! after they are supported.
 ! FIXME: Passing a CLASS to a CLASS has to be re-enabled.
 implicit none
 type t
@@ -29,38 +27,38 @@ if (i /= 12) call abort()
 contains
   subroutine bar(x)
     type(t) :: x(..)
-!    if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) call abort()
+    if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) call abort()
     if (size(x) /= 6) call abort()
     if (size(x,1) /= 2 .or. size(x,2) /= 3) call abort()
-!    if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort()
+    if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort()
     i = i + 1
     call foo(x)
     call bar2(x)
   end subroutine
   subroutine bar2(x)
     type(t) :: x(..)
-!    if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) call abort()
+    if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) call abort()
     if (size(x) /= 6) call abort()
     if (size(x,1) /= 2 .or. size(x,2) /= 3) call abort()
-!    if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort()
+    if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort()
     i = i + 1
   end subroutine
   subroutine foo(x)
     class(t) :: x(..)
-!    if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) call abort()
+    if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) call abort()
     if (size(x) /= 6) call abort()
     if (size(x,1) /= 2 .or. size(x,2) /= 3) call abort()
-!    if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort()
+    if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort()
     i = i + 1
     call foo2(x)
 !    call bar2(x) ! Passing a CLASS to a TYPE does not yet work
   end subroutine
   subroutine foo2(x)
     class(t) :: x(..)
-!    if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) call abort()
+    if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) call abort()
     if (size(x) /= 6) call abort()
     if (size(x,1) /= 2 .or. size(x,2) /= 3) call abort()
-!    if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort()
+    if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort()
     i = i + 1
   end subroutine
 end 
--- /dev/null	2012-07-18 07:03:52.759757921 +0200
+++ gcc/gcc/testsuite/gfortran.dg/assumed_rank_3.f90	2012-06-24 15:17:43.000000000 +0200
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-options "-fcheck=bounds" }
+! { dg-shouldfail "Array reference out of bounds" }
+!
+! PR fortran/48820
+!
+! Do assumed-rank bound checking
+
+implicit none
+integer :: a(4,4)
+call bar(a)
+contains
+  subroutine bar(x)
+    integer :: x(..)
+    print *, ubound(x,dim=3)  ! << wrong dim
+  end subroutine
+end
+
+! { dg-output "Fortran runtime error: Array reference out of bounds" }
--- /dev/null	2012-07-18 07:03:52.759757921 +0200
+++ gcc/gcc/testsuite/gfortran.dg/assumed_rank_11.f90	2012-07-20 10:35:39.000000000 +0200
@@ -0,0 +1,52 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/48820
+!
+! Assumed-rank tests
+subroutine foo(X)
+ integer :: x(..)
+ codimension :: x[*] ! { dg-error "The assumed-rank array 'x' at .1. shall not have a codimension" }
+end
+
+subroutine foo2(X)
+ integer, dimension(..) :: x[*] ! { dg-error "The assumed-rank array at .1. shall not have a codimension" }
+end
+
+subroutine foo3(X)
+ integer, codimension[*] :: x(..) ! { dg-error "The assumed-rank array at .1. shall not have a codimension" }
+end
+
+subroutine foo4(X)
+ integer, codimension[*], dimension(..) :: x ! { dg-error "The assumed-rank array at .1. shall not have a codimension" }
+end
+
+subroutine bar(X)
+ integer :: x[*]
+ dimension :: x(..) ! { dg-error "The assumed-rank array 'x' at .1. shall not have a codimension" }
+end
+
+subroutine foobar(X)
+ integer :: x
+ codimension :: x[*]
+ dimension :: x(..) ! { dg-error "The assumed-rank array 'x' at .1. shall not have a codimension" }
+end
+
+subroutine barfoo(X)
+ integer :: x
+ dimension :: x(..)
+ codimension :: x[*] ! { dg-error "The assumed-rank array 'x' at .1. shall not have a codimension" }
+end
+
+subroutine orig(X) ! { dg-error "may not have the VALUE or CODIMENSION attribute" }
+ integer :: x(..)[*]
+end
+
+subroutine val1(X)
+ integer, value :: x(..)  ! { dg-error "VALUE attribute conflicts with DIMENSION attribute" }
+end
+
+subroutine val2(X)
+ integer, value :: x
+ dimension :: x(..)  ! { dg-error "VALUE attribute conflicts with DIMENSION attribute" }
+end

Re: [Patch, Fortran] assumed-rank some bound intrinsics support, fix failures and improve diagnostcs

[Mikael Morin]

On 20/07/2012 12:19, Tobias Burnus wrote:
> Mikael: I wouldn't mind if you could have a look at the scalarizer - you
> seem to have an idea how one can implement it with minimal effort/code
> cluttering.
This is exaggerated. I just said that the scalarizer can't generate a
variable number of loops.
I can have a look next week. Could you post what is left from your
initial {l,u}bound patch? It has been raining assumed rank patches and
I'm lost now.

> 
> 
> Build and regtested on x86-64-linux.
> OK for the trunk?
> 
OK.

Mikael

Re: [Patch, Fortran] assumed-rank some bound intrinsics support, fix failures and improve diagnostcs

[Tobias Burnus]

Mikael Morin wrote:
> On 20/07/2012 12:19, Tobias Burnus wrote:
>> Build and regtested on x86-64-linux.
>> OK for the trunk?
>>
> OK.

Thanks! Committed as Rev. 189743.

>> Mikael: I wouldn't mind if you could have a look at the scalarizer - you
>> seem to have an idea how one can implement it with minimal effort/code
>> cluttering.
> This is exaggerated. I just said that the scalarizer can't generate a variable number of loops. I can have a look next week. Could you post what is left from your initial {l,u}bound patch? It has been raining assumed rank patches and I'm lost now.

Well, the good news is that the just approved/committed patch contains 
everything which I had before. It turned out that I don't need the 
scalarizer change for the current implementation.

Thus, lbound(x, dim=i) works now; as do ubound(x, dim=i) and 
size(x)/size(x,dim=i).

Only failing are:
   lbound(x) / ubound(x) / shape(x)

Thanks for offering to take a look!


In terms of pending patches, I currently only have one: The just posted 
C_PTRDIFF_T patch.

Tobias

Re: [Patch, Fortran] assumed-rank some bound intrinsics support, fix failures and improve diagnostcs

[Mikael Morin]

[-- Attachment #1: Type: text/plain, Size: 171 bytes --]

On 21/07/2012 13:08, Tobias Burnus wrote:
> Only failing are:
>   lbound(x) / ubound(x) / shape(x)
> 
Here is a draft for those.
Lightly tested with print *, ...

Mikael


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: assumed_rank.diff --]
[-- Type: text/x-patch; name="assumed_rank.diff", Size: 7098 bytes --]

Index: trans-array.c
===================================================================
--- trans-array.c	(révision 189883)
+++ trans-array.c	(copie de travail)
@@ -249,6 +249,20 @@ gfc_conv_descriptor_dtype (tree desc)
 
 
 tree
+gfc_conv_descriptor_rank (tree desc)
+{
+  tree tmp;
+  tree dtype;
+
+  dtype = gfc_conv_descriptor_dtype (desc);
+  tmp = build_int_cst (TREE_TYPE (dtype), GFC_DTYPE_RANK_MASK);
+  tmp = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (dtype),
+			 dtype, tmp);
+  return fold_convert (gfc_get_int_type (gfc_default_integer_kind), tmp);
+}
+
+
+tree
 gfc_get_descriptor_dimension (tree desc)
 {
   tree type, field;
@@ -3794,6 +3808,40 @@ done:
 	    /* Fall through to supply start and stride.  */
 	    case GFC_ISYM_LBOUND:
 	    case GFC_ISYM_UBOUND:
+	      {
+		gfc_expr *arg;
+
+		/* This is the variant without DIM=...  */
+		gcc_assert (expr->value.function.actual->next->expr == NULL);
+
+		arg = expr->value.function.actual->expr;
+		if (arg->rank == -1)
+		  {
+		    gfc_se se;
+		    tree rank, tmp;
+
+		    /* The rank (hence the return value's shape) is unknown,
+		       we have to retrieve it.  */
+		    gfc_init_se (&se, NULL);
+		    se.descriptor_only = 1;
+		    gfc_conv_expr (&se, arg);
+		    /* This is a bare variable, so there is no preliminary
+		       or cleanup code.  */
+		    gcc_assert (se.pre.head == NULL_TREE
+				&& se.post.head == NULL_TREE);
+		    rank = gfc_conv_descriptor_rank (se.expr);
+		    tmp = fold_build2_loc (input_location, MINUS_EXPR,
+					   gfc_array_index_type,
+					   fold_convert (gfc_array_index_type,
+							 rank),
+					   gfc_index_one_node);
+		    info->end[0] = gfc_evaluate_now (tmp, &loop->pre);
+		    info->start[0] = gfc_index_zero_node;
+		    info->stride[0] = gfc_index_one_node;
+		    continue;
+		  }
+		  /* Otherwise fall through GFC_SS_FUNCTION.  */
+	      }
 	    case GFC_ISYM_LCOBOUND:
 	    case GFC_ISYM_UCOBOUND:
 	    case GFC_ISYM_THIS_IMAGE:
@@ -4430,22 +4478,11 @@ set_loop_bounds (gfc_loopinfo *loop)
 	      continue;
 	    }
 
-	  /* TODO: Pick the best bound if we have a choice between a
-	     function and something else.  */
-	  if (ss_type == GFC_SS_FUNCTION)
-	    {
-	      loopspec[n] = ss;
-	      continue;
-	    }
-
 	  /* Avoid using an allocatable lhs in an assignment, since
 	     there might be a reallocation coming.  */
 	  if (loopspec[n] && ss->is_alloc_lhs)
 	    continue;
 
-	  if (ss_type != GFC_SS_SECTION)
-	    continue;
-
 	  if (!loopspec[n])
 	    loopspec[n] = ss;
 	  /* Criteria for choosing a loop specifier (most important first):
@@ -4520,6 +4557,20 @@ set_loop_bounds (gfc_loopinfo *loop)
 	      gcc_assert (loop->to[n] == NULL_TREE);
 	      break;
 
+	    case GFC_SS_INTRINSIC:
+	      {
+		gfc_expr *expr = loopspec[n]->info->expr;
+
+		/* The {l,u}bound of an assumed rank.  */
+		gcc_assert ((expr->value.function.isym->id == GFC_ISYM_LBOUND
+			     || expr->value.function.isym->id == GFC_ISYM_UBOUND)
+			     && expr->value.function.actual->next->expr == NULL
+			     && expr->value.function.actual->expr->rank == -1);
+
+		loop->to[n] = info->end[dim];
+		break;
+	      }
+
 	    default:
 	      gcc_unreachable ();
 	    }
Index: trans-array.h
===================================================================
--- trans-array.h	(révision 189881)
+++ trans-array.h	(copie de travail)
@@ -154,6 +154,7 @@ tree gfc_conv_descriptor_data_get (tree);
 tree gfc_conv_descriptor_data_addr (tree);
 tree gfc_conv_descriptor_offset_get (tree);
 tree gfc_conv_descriptor_dtype (tree);
+tree gfc_conv_descriptor_rank (tree);
 tree gfc_get_descriptor_dimension (tree);
 tree gfc_conv_descriptor_stride_get (tree, tree);
 tree gfc_conv_descriptor_lbound_get (tree, tree);
Index: iresolve.c
===================================================================
--- iresolve.c	(révision 189881)
+++ iresolve.c	(copie de travail)
@@ -134,9 +134,12 @@ resolve_bound (gfc_expr *f, gfc_expr *array, gfc_e
   if (dim == NULL)
     {
       f->rank = 1;
-      f->shape = gfc_get_shape (1);
-      mpz_init_set_ui (f->shape[0], coarray ? gfc_get_corank (array)
-					    : array->rank);
+      if (array->rank != -1)
+	{
+	  f->shape = gfc_get_shape (1);
+	  mpz_init_set_ui (f->shape[0], coarray ? gfc_get_corank (array)
+						: array->rank);
+	}
     }
 
   f->value.function.name = xstrdup (name);
@@ -2225,8 +2228,12 @@ gfc_resolve_shape (gfc_expr *f, gfc_expr *array, g
     f->ts.kind = gfc_default_integer_kind;
 
   f->rank = 1;
-  f->shape = gfc_get_shape (1);
-  mpz_init_set_ui (f->shape[0], array->rank);
+  if (array->rank != -1)
+    {
+      f->shape = gfc_get_shape (1);
+      mpz_init_set_ui (f->shape[0], array->rank);
+    }
+ 
   f->value.function.name = gfc_get_string (PREFIX ("shape_%d"), f->ts.kind);
 }
 
Index: trans-intrinsic.c
===================================================================
--- trans-intrinsic.c	(révision 189881)
+++ trans-intrinsic.c	(copie de travail)
@@ -1315,20 +1315,6 @@ trans_num_images (gfc_se * se)
 }
 
 
-static tree
-get_rank_from_desc (tree desc)
-{
-  tree tmp;
-  tree dtype;
-
-  dtype = gfc_conv_descriptor_dtype (desc);
-  tmp = build_int_cst (TREE_TYPE (dtype), GFC_DTYPE_RANK_MASK);
-  tmp = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (dtype),
-			 dtype, tmp);
-  return fold_convert (gfc_get_int_type (gfc_default_integer_kind), tmp);
-}
-
-
 static void
 gfc_conv_intrinsic_rank (gfc_se *se, gfc_expr *expr)
 {
@@ -1345,7 +1331,7 @@ gfc_conv_intrinsic_rank (gfc_se *se, gfc_expr *exp
   gfc_add_block_to_block (&se->pre, &argse.pre);
   gfc_add_block_to_block (&se->post, &argse.post);
 
-  se->expr = get_rank_from_desc (argse.expr);
+  se->expr = gfc_conv_descriptor_rank (argse.expr);
 }
 
 
@@ -1434,7 +1420,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr *
           cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
 				  bound, build_int_cst (TREE_TYPE (bound), 0));
 	  if (as && as->type == AS_ASSUMED_RANK)
-	    tmp = get_rank_from_desc (desc);
+	    tmp = gfc_conv_descriptor_rank (desc);
 	  else
 	    tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))];
           tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
@@ -5895,7 +5881,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
 	  gfc_conv_expr_lhs (&arg1se, arg1->expr);
 	  if (arg1->expr->rank == -1)
 	    {
-	      tmp = get_rank_from_desc (arg1se.expr);
+	      tmp = gfc_conv_descriptor_rank (arg1se.expr);
 	      tmp = fold_build2_loc (input_location, MINUS_EXPR,
 				     TREE_TYPE (tmp), tmp, gfc_index_one_node);
 	    }
Index: simplify.c
===================================================================
--- simplify.c	(révision 189881)
+++ simplify.c	(copie de travail)
@@ -5470,6 +5470,9 @@ gfc_simplify_shape (gfc_expr *source, gfc_expr *ki
   gfc_try t;
   int k = get_kind (BT_INTEGER, kind, "SHAPE", gfc_default_integer_kind);
 
+  if (source->rank == -1)
+    return NULL;
+
   result = gfc_get_array_expr (BT_INTEGER, k, &source->where);
 
   if (source->rank == 0)

Re: [Patch, Fortran] assumed-rank some bound intrinsics support, fix failures and improve diagnostcs

[Mikael Morin]

[-- Attachment #1: Type: text/plain, Size: 412 bytes --]

On 26/07/2012 16:53, Mikael Morin wrote:
> On 21/07/2012 13:08, Tobias Burnus wrote:
>> Only failing are:
>>   lbound(x) / ubound(x) / shape(x)
>>
> Here is a draft for those.
> Lightly tested with print *, ...
> 
Better with the tests.


$ ./test1
           1           1
           3           8
           3           8

$ ./test2
          11         101
          13         108
           3           8



[-- Attachment #2: test1.f90 --]
[-- Type: text/x-fortran, Size: 224 bytes --]


program test

  integer :: a(1:3,-2:5)

  call foo(a)

contains
  subroutine foo(arg)
    integer :: arg(..)

    print *, lbound(arg)
    print *, ubound(arg)
    print *, shape(arg)
  end subroutine foo
end program test


[-- Attachment #3: test2.f90 --]
[-- Type: text/x-fortran, Size: 434 bytes --]



program test

  integer :: a(1:3,-2:5)
  integer, allocatable :: b(:,:)

  b = foo(a)
  print *,b(:,1)
  print *,b(:,2)
  print *,b(:,3)

contains
  function foo(arg) result(res)
    integer :: arg(..)
    integer, allocatable :: res(:,:)

    allocate(res(rank(arg), 3))
    
    res(:,1) = lbound(arg) + (/ 10, 100 /)
    res(:,2) = (/ 10, 100 /) + ubound(arg) 
    res(:,3) = shape(arg)
    
  end function foo
end program test

Re: [Patch, Fortran] assumed-rank some bound intrinsics support, fix failures and improve diagnostcs

[Tobias Burnus]

On 07/26/2012 05:12 PM, Mikael Morin wrote:
> On 26/07/2012 16:53, Mikael Morin wrote:
>> Here is a draft for those. Lightly tested with print *, ... 

Looks rather nice. The output for test1 is also  good:

   integer :: a(1:3,-2:5)
gives
   lbound(arg) == [1, 1]
   ubound(arg) == [3, 8]
   shape(arg) == [3, 8]

However, if the dummy is allocatable or a pointer, the result should be:

   lbound(arg) == [1, -2]
   ubound(arg) == [3, 5]
   shape(arg) == [3, 8]

which your second test case doesn't give. (At least that's how I understand TS and F2008.)

Except for that issue, I like your patch. Thanks!

Tobias

Re: [Patch, Fortran] assumed-rank some bound intrinsics support, fix failures and improve diagnostcs

[Mikael Morin]

[-- Attachment #1: Type: text/plain, Size: 1205 bytes --]

On 26/07/2012 17:32, Tobias Burnus wrote:
> On 07/26/2012 05:12 PM, Mikael Morin wrote:
>> On 26/07/2012 16:53, Mikael Morin wrote:
>>> Here is a draft for those. Lightly tested with print *, ... 
> 
> Looks rather nice. The output for test1 is also  good:
> 
>   integer :: a(1:3,-2:5)
> gives
>   lbound(arg) == [1, 1]
>   ubound(arg) == [3, 8]
>   shape(arg) == [3, 8]
> 
> However, if the dummy is allocatable or a pointer, the result should be:
> 
>   lbound(arg) == [1, -2]
>   ubound(arg) == [3, 5]
>   shape(arg) == [3, 8]
> 
> which your second test case doesn't give.

Hello,

do you have a test case exhibiting the problem?
It seems fine to me.

$ ./test1
           1           1
           3           8
           3           8
           1           1
           3           8
           3           8
           1          -2
           3           5
           3           8
           1          -2
           3           5
           3           8

./test2
          11         101
          13         108
           3           8
          11          97
          12         106
           2          10
          13          99
          15         110
           3          12





[-- Attachment #2: test1.f90 --]
[-- Type: text/x-fortran, Size: 632 bytes --]


program test

  integer :: a(1:3,-2:5)
  integer, allocatable :: b(:,:)

  call foo(a)

  allocate(b(1:3,-2:5))
  call foo(b)
  call bar(b)
  call baz(b)

contains
  subroutine foo(arg)
    integer :: arg(..)

    print *, lbound(arg)
    print *, ubound(arg)
    print *, shape(arg)
  end subroutine foo
  subroutine bar(arg)
    integer, allocatable :: arg(:,:)

    print *, lbound(arg)
    print *, ubound(arg)
    print *, shape(arg)
  end subroutine bar
  subroutine baz(arg)
    integer, allocatable :: arg(..)

    print *, lbound(arg)
    print *, ubound(arg)
    print *, shape(arg)
  end subroutine baz
end program test

[-- Attachment #3: test2.f90 --]
[-- Type: text/x-fortran, Size: 1239 bytes --]



program test

  integer              :: a(1:3,-2:5)
  integer, allocatable :: b(:,:)
  integer, allocatable :: c(:,:)
  integer, pointer     :: d(:,:)

  b = foo(a)
  print *,b(:,1)
  print *,b(:,2)
  print *,b(:,3)

  allocate(c(1:2,-3:6))
  b = bar(c)
  print *,b(:,1)
  print *,b(:,2)
  print *,b(:,3)

  allocate(d(3:5,-1:10))
  b = baz(d)
  print *,b(:,1)
  print *,b(:,2)
  print *,b(:,3)

contains
  function foo(arg) result(res)
    integer :: arg(..)
    integer, allocatable :: res(:,:)

    allocate(res(rank(arg), 3))
    
    res(:,1) = lbound(arg) + (/ 10, 100 /)
    res(:,2) = (/ 10, 100 /) + ubound(arg) 
    res(:,3) = shape(arg)

  end function foo
  function bar(arg) result(res)
    integer, allocatable :: arg(..)
    integer, allocatable :: res(:,:)

    allocate(res(rank(arg), 3))
    
    res(:,1) = lbound(arg) + (/ 10, 100 /)
    res(:,2) = (/ 10, 100 /) + ubound(arg) 
    res(:,3) = shape(arg)

  end function bar
  function baz(arg) result(res)
    integer, pointer     :: arg(..)
    integer, allocatable :: res(:,:)

    allocate(res(rank(arg), 3))
    
    res(:,1) = lbound(arg) + (/ 10, 100 /)
    res(:,2) = (/ 10, 100 /) + ubound(arg) 
    res(:,3) = shape(arg)

  end function baz
end program test

Re: [Patch, Fortran] assumed-rank some bound intrinsics support, fix failures and improve diagnostcs

[Tobias Burnus]

On 07/27/2012 07:26 PM, Mikael Morin wrote:
> do you have a test case exhibiting the problem? It seems fine to me.

Your second test case was too convoluted for me - and as I wasn't at 
home, I couldn't test it. I now believe that your patch is okay; I will 
later formally review  it.

Do you intent to wrap it for final inclusion? I think it only lacks a 
dejaGNUified test case and a changelog.

  * * *

However, I found another spot where one needs to have a scalarizer; 
possibly a poor man's version is enough. Namely INTENT(OUT) handling. Do 
you have an idea how to best handle that case?

program test
   implicit none
   type t
     integer, allocatable :: a
   end type t
   type(t) :: b(4,6)
   integer :: i, j

   do j = 1, 6
     do i = 1, 4
       allocate (b(i,j)%a)
     end do
   end do

   call sub (b(::2,::3))
   do j = 1, 6
     do i = 1, 4
       print *, i, j, allocated (b(i,j)%a)
!      if (allocated (b(i,j)%a) .neqv. (mod (i-1,2) /= 0 .or. mod 
(j-1,3) /= 0))&
!        call abort ()
     end do
   end do
contains
   subroutine sub (x)
     type(t), intent(out) :: x(..)
   end subroutine sub
end program test


Tobias

PS: Note to self: Reject passing an assumed-size array to an INTENT(OUT) 
assumed-rank array, at least if it is "polymorphic, finalizable, of a 
type with an allocatable ultimate component, or of a type for which 
default initialization is specified." [TS29113 seems to allow it, but 
one needs some check similar to F2008's C534. A constraint is not enough 
as it doesn't cover all cases, but the rest is the user's responsibility.]

Re: [Patch, Fortran] assumed-rank some bound intrinsics support, fix failures and improve diagnostcs

[Mikael Morin]

On 01/08/2012 12:00, Tobias Burnus wrote:
> On 07/27/2012 07:26 PM, Mikael Morin wrote:
>> do you have a test case exhibiting the problem? It seems fine to me.
> 
> Your second test case was too convoluted for me - and as I wasn't at
> home, I couldn't test it. I now believe that your patch is okay; I will
> later formally review  it.
I will formally ask for it. ;-)
> 
> Do you intent to wrap it for final inclusion? I think it only lacks a
> dejaGNUified test case and a changelog.
Will do.
> 
>  * * *
> 
> However, I found another spot where one needs to have a scalarizer;
> possibly a poor man's version is enough. Namely INTENT(OUT) handling.
Indeed.
> Do you have an idea how to best handle that case?
It seems some new code is necessary. I don't know how well it will
fit/reuse the existing though.

I have been thinking about rewriting the scalarizer in a way that would
need less bookkeeping to make things work. Nothing near a patch though,
and it's not something for 4.8. Anyway, here is the interface I had in mind:

gfc_init_loopinfo (loopinfo);
/* generate the code.  */
gfc_conv_expr (loopinfo, expr1);
gfc_conv_expr (loopinfo, expr2);
/* etc, do something, putting loopinfo every time as parameter so that
it is populated appropriately... and then: */
loopblock = gfc_scalarize (loopinfo);

the gfc_scalarize could have a big `if' in it distinguishing known rank
from assumed rank.
Maybe we could take the opportunity to make a seed for a new scalarizer.

Mikael

Re: [Patch, Fortran] assumed-rank some bound intrinsics support, fix failures and improve diagnostcs

[Tobias Burnus]

On 08/01/2012 01:37 PM, Mikael Morin wrote:
>> However, I found another spot where one needs to have a scalarizer;
>> possibly a poor man's version is enough. Namely INTENT(OUT) handling.
> Indeed.
>> Do you have an idea how to best handle that case?
> It seems some new code is necessary. I don't know how well it will
> fit/reuse the existing though.

I think we should try to get this working in some way for 4.8 as 
assumed-rank arrays will be used for the finalization wrapper - and it 
would be awesome to have FINAL support in 4.8.

Background: As it is unknown (at compile time) whether a polymorphic 
variable has no final subroutines or one for that rank or an elemental 
one (or some but no suitable ones) - and as there could be a different 
combination for the parent type, the current plan is to add a _final 
proc-pointer to the vtable, which points to a final wrapper procedure 
for that type. It takes (at least for arrays) an assumed-rank array and 
dispatches the calls based on the rank; for an elemental final 
subroutine, it has to "scalarize it". [It's simple to add a special case 
as the array is contiguous - one just needs to "call 
elemental(base_address + i*elem_size)", where i = 
1,size(assumed-size-array).]

And for finalization, it would be great if one could use the INTENT(OUT) 
support. One could alternatively implement it manually on the gfortran 
AST level (gfc_code/gfc_expr) by walking through the derived type or one 
could implement a simplified version, making use of the contiguity of 
the finalized variable.


> I have been thinking about rewriting the scalarizer in a way that would
> need less bookkeeping to make things work. Nothing near a patch though,
> and it's not something for 4.8.

I think it would be good to base it on the new array descriptor, which 
we hopefully have by that time. Additionally, we should consider to support:

a) ARRAY_RANGE_REF: That's probably somewhat independent of 
scalarization, but replaces it in some cases:
   A(:,:,5) = B(:)
can be implemented as ARRAY_RANGE_REF, if the memory is contiguous; one 
just passes an offset and (via the decl) the size of the array 
(section). See trans-expr.c for one example. A range ref is better than 
a memcpy/memmove or a loop - as the first looses the data type and some 
alias information and the second represents the structure in a more 
convoluted way. Either could be recovered by the middle end, but it 
currently isn't and doing it correctly from the beginning makes the ME 
life easier.

b) Middle-end arrays. Richard made an initial patch, cf. 
http://gcc.gnu.org/wiki/GCCGathering2011Fortran . It probably needs some 
polishing and some optimizations have to be implemented, but then it 
should work and allow for further optimizations. [Description in the 
wiki might be partially wrong; blame me - and correct it, if you find 
something.]

I think the latter requires also some thinking about how to handle 
arrays internally: In that case, the array has - at least for the 
scalarization - more than one rank (for the ME) while gfortran normally 
folds everything to rank-1 arrays. Additionally, one needs to think 
about the case where the array has nonunit strides, i.e. where the 
leftmost stride is not sizeof(declared type) but larger by a noninteger 
amount. (e.g. passing a polymorphic array to a TYPE.)

Tobias

Re: [Patch, Fortran] assumed-rank some bound intrinsics support, fix failures and improve diagnostcs

[Richard Guenther]

On Wed, Aug 1, 2012 at 2:37 PM, Tobias Burnus <burnus@net-b.de> wrote:
> On 08/01/2012 01:37 PM, Mikael Morin wrote:
>>>
>>> However, I found another spot where one needs to have a scalarizer;
>>> possibly a poor man's version is enough. Namely INTENT(OUT) handling.
>>
>> Indeed.
>>>
>>> Do you have an idea how to best handle that case?
>>
>> It seems some new code is necessary. I don't know how well it will
>> fit/reuse the existing though.
>
>
> I think we should try to get this working in some way for 4.8 as
> assumed-rank arrays will be used for the finalization wrapper - and it would
> be awesome to have FINAL support in 4.8.
>
> Background: As it is unknown (at compile time) whether a polymorphic
> variable has no final subroutines or one for that rank or an elemental one
> (or some but no suitable ones) - and as there could be a different
> combination for the parent type, the current plan is to add a _final
> proc-pointer to the vtable, which points to a final wrapper procedure for
> that type. It takes (at least for arrays) an assumed-rank array and
> dispatches the calls based on the rank; for an elemental final subroutine,
> it has to "scalarize it". [It's simple to add a special case as the array is
> contiguous - one just needs to "call elemental(base_address + i*elem_size)",
> where i = 1,size(assumed-size-array).]
>
> And for finalization, it would be great if one could use the INTENT(OUT)
> support. One could alternatively implement it manually on the gfortran AST
> level (gfc_code/gfc_expr) by walking through the derived type or one could
> implement a simplified version, making use of the contiguity of the
> finalized variable.
>
>
>
>> I have been thinking about rewriting the scalarizer in a way that would
>> need less bookkeeping to make things work. Nothing near a patch though,
>> and it's not something for 4.8.
>
>
> I think it would be good to base it on the new array descriptor, which we
> hopefully have by that time. Additionally, we should consider to support:
>
> a) ARRAY_RANGE_REF: That's probably somewhat independent of scalarization,
> but replaces it in some cases:
>   A(:,:,5) = B(:)
> can be implemented as ARRAY_RANGE_REF, if the memory is contiguous; one just
> passes an offset and (via the decl) the size of the array (section). See
> trans-expr.c for one example. A range ref is better than a memcpy/memmove or
> a loop - as the first looses the data type and some alias information and
> the second represents the structure in a more convoluted way. Either could
> be recovered by the middle end, but it currently isn't and doing it
> correctly from the beginning makes the ME life easier.
>
> b) Middle-end arrays. Richard made an initial patch, cf.
> http://gcc.gnu.org/wiki/GCCGathering2011Fortran . It probably needs some
> polishing and some optimizations have to be implemented, but then it should
> work and allow for further optimizations. [Description in the wiki might be
> partially wrong; blame me - and correct it, if you find something.]

Well, I wouldn't concentrate on this one ;)

> I think the latter requires also some thinking about how to handle arrays
> internally: In that case, the array has - at least for the scalarization -
> more than one rank (for the ME) while gfortran normally folds everything to
> rank-1 arrays. Additionally, one needs to think about the case where the
> array has nonunit strides, i.e. where the leftmost stride is not
> sizeof(declared type) but larger by a noninteger amount. (e.g. passing a
> polymorphic array to a TYPE.)

c) Do _not_ fold everything to rank-1 arrays (this makes data
dependence analysis
harder).  If you know the rank of an array use an intermediate array
pointer type
to access the data, like the following C example:

void foo (void *data, int n, int m)
{
  int (*a)[n][m] = (int (*)[n][m]) data;
  int i, j;
  for (i = 0; i < n; ++i)
    for (j = 0; j < m; ++j)
      (*a)[i][j] = 0;
}


d) Think about Frontend optimizations again - using the ISL part of GRAPHITE
on the GFortran IL, possibly driving the scalarizer with the result.

Richard.

> Tobias