public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* Re: [Patch, fortran] [0/5] PR 45586: restrict vs. non-restrict type compatibility hell
@ 2012-08-25 18:01 Dominique Dhumieres
  2012-08-25 20:04 ` Mikael Morin
  0 siblings, 1 reply; 6+ messages in thread
From: Dominique Dhumieres @ 2012-08-25 18:01 UTC (permalink / raw)
  To: fortran; +Cc: gcc-patches, mikael.morin

Dear Mikael,

Your set of patches works as defined, i.e., it fixes pr45586 without 
regression on the test suite. However, If the test suite is run with 
-flto, there are still some failures depending on the way gcc is 
configured.

Configured with: ../p_work/configure --prefix=/opt/gcc/gcc4.8p-190641p1 
--enable-languages=c,c++,lto,fortran,ada,objc,obj-c++ --with-gmp=/opt/mp 
--with-system-zlib --enable-checking=release --with-isl=/opt/mp --enable-lto 
--enable-plugin --enable-build-with-cxx

=== gfortran Summary for unix/-m64/-flto ===

# of expected passes		42057
# of unexpected failures	40
# of expected failures		56
# of unsupported tests		72

=== gfortran Summary ===

# of expected passes		83827
# of unexpected failures	80
# of expected failures		112
# of unsupported tests		282

The failing tests are:

FAIL: gfortran.dg/debug/pr35154-dwarf2.f -gdwarf-2  scan-assembler (DW_AT_name: "label"|"label[^\n]*"[^\n]*DW_AT_name)
FAIL: gfortran.dg/debug/pr35154-dwarf2.f -gdwarf-2 -g3  scan-assembler (DW_AT_name: "label"|"label[^\n]*"[^\n]*DW_AT_name)
FAIL: gfortran.dg/bind_c_array_params_2.f90  -O   scan-assembler-times myBindC 1
FAIL: gfortran.dg/bind_c_vars.f90  -O0  (test for excess errors)
FAIL: gfortran.dg/class_array_7.f03  -O1  (internal compiler error)
FAIL: gfortran.dg/pr52835.f90  -O   scan-tree-dump optimized "bar "
FAIL: gfortran.dg/typebound_proc_27.f03  -O1  (internal compiler error)
...

The ICEs and excess errors are

[macbook] f90/bug% gfc /opt/gcc/work/gcc/testsuite/gfortran.dg/class_array_7.f03 -flto -O1
In file included from :0:0:
/opt/gcc/work/gcc/testsuite/gfortran.dg/class_array_7.f03: In function 'main':
/opt/gcc/work/gcc/testsuite/gfortran.dg/class_array_7.f03:49:0: internal compiler error: in fold_convert_loc, at fold-const.c:2008
   use realloc
 ^
Please submit a full bug report,
with preprocessed source if appropriate.
See <http://gcc.gnu.org/bugs.html> for instructions.
lto-wrapper: gfc returned 1 exit status
collect2: error: lto-wrapper returned 1 exit status

[macbook] f90/bug% gfc /opt/gcc/work/gcc/testsuite/gfortran.dg/typebound_proc_27.f03 -flto -O1
In file included from :0:0:
/opt/gcc/work/gcc/testsuite/gfortran.dg/typebound_proc_27.f03: In function 'main':
/opt/gcc/work/gcc/testsuite/gfortran.dg/typebound_proc_27.f03:34:0: internal compiler error: in fold_convert_loc, at fold-const.c:2008
   use m
 ^
Please submit a full bug report,
with preprocessed source if appropriate.
See <http://gcc.gnu.org/bugs.html> for instructions.
lto-wrapper: gfc returned 1 exit status
collect2: error: lto-wrapper returned 1 exit status

[macbook] f90/bug% gfc /opt/gcc/work/gcc/testsuite/gfortran.dg/bind_c_vars.f90 /opt/gcc/work/gcc/testsuite/gfortran.dg/bind_c_vars_driver.c -flto
In file included from :0:0:
/opt/gcc/work/gcc/testsuite/gfortran.dg/bind_c_vars.f90:16:0: warning: type of 'b' does not match original declaration [enabled by default]
   integer(c_int), bind(c, name="myF90Array2D") :: B(3, 2)
 ^
In file included from /opt/gcc/work/gcc/testsuite/gfortran.dg/bind_c_vars.f90:16:0,
		 from :0:
/opt/gcc/work/gcc/testsuite/gfortran.dg/bind_c_vars_driver.c:12:5: note: previously declared here
 int myF90Array2D[2][3];      /* B in bind_c_vars */
     ^
In file included from :0:0:
/opt/gcc/work/gcc/testsuite/gfortran.dg/bind_c_vars.f90:15:0: warning: type of 'a' does not match original declaration [enabled by default]
   integer(c_int), bind(c, name="myF90Array3D") :: A(18, 3:7, 10)
 ^
In file included from /opt/gcc/work/gcc/testsuite/gfortran.dg/bind_c_vars.f90:16:0,
		 from :0:
/opt/gcc/work/gcc/testsuite/gfortran.dg/bind_c_vars_driver.c:11:5: note: previously declared here
 int myF90Array3D[10][5][18]; /* A in bind_c_vars */
     ^
Note that despite the warnings, executing the test succeeds.

Configured with: ../p_work/configure --prefix=/opt/gcc/gcc4.8x-190641p1 
--enable-languages=c,c++,lto,fortran --with-gmp=/opt/mp --with-system-zlib 
--with-isl=/opt/mp --enable-lto --enable-plugin --enable-build-with-cxx

=== gfortran Summary for unix/-m64/-flto ===

# of expected passes		41905
# of unexpected failures	193
# of expected failures		56
# of unsupported tests		72

=== gfortran Summary ===

# of expected passes		83523
# of unexpected failures	386
# of expected failures		112
# of unsupported tests		282

The additional failing tests are:

FAIL: gfortran.dg/alloc_comp_assign_2.f90  -O0  (internal compiler error)
FAIL: gfortran.dg/alloc_comp_assign_3.f90  -O0  (internal compiler error)
FAIL: gfortran.dg/alloc_comp_assign_4.f90  -O0  (internal compiler error)
FAIL: gfortran.dg/alloc_comp_auto_array_2.f90  -O0  (internal compiler error)
FAIL: gfortran.dg/alloc_comp_bounds_1.f90  -O0  (internal compiler error)
FAIL: gfortran.dg/alloc_comp_constructor_1.f90  -O0  (internal compiler error)
FAIL: gfortran.dg/alloc_comp_constructor_2.f90  -O0  (internal compiler error)
FAIL: gfortran.dg/alloc_comp_constructor_3.f90  -O0  (internal compiler error)
FAIL: gfortran.dg/alloc_comp_constructor_4.f90  -O0  (internal compiler error)
FAIL: gfortran.dg/alloc_comp_initializer_1.f90  -O0  (internal compiler error)
FAIL: gfortran.dg/alloc_comp_result_2.f90  -O0  (internal compiler error)
FAIL: gfortran.dg/assumed_rank_7.f90  -O0  (internal compiler error)
FAIL: gfortran.dg/assumed_rank_9.f90  -O0  (internal compiler error)
FAIL: gfortran.dg/class_to_type_1.f03  -O0  (internal compiler error)
FAIL: gfortran.dg/extends_4.f03  -O0  (internal compiler error)
FAIL: gfortran.dg/pr43808.f90  -O0  (internal compiler error)
FAIL: gfortran.dg/select_type_26.f03  -O0  (internal compiler error)
FAIL: gfortran.dg/select_type_27.f03  -O0  (internal compiler error)
FAIL: gfortran.dg/type_to_class_1.f03  -O0  (internal compiler error)
FAIL: gfortran.dg/typebound_operator_13.f03  -O0  (internal compiler error)
FAIL: gfortran.dg/typebound_proc_20.f90  -O0  (internal compiler error)
FAIL: gfortran.fortran-torture/execute/forall_5.f90,  -O0  (internal compiler error)

If I am not mistaken, all the failures are of the kind:

FAIL: gfortran.dg/alloc_comp_assign_2.f90  -O0  (internal compiler error)
FAIL: gfortran.dg/alloc_comp_assign_2.f90  -O0  (test for excess errors)
Excess errors:
/opt/gcc/p_work/gcc/testsuite/gfortran.dg/alloc_comp_assign_2.f90:7:0:0: error: non-trivial conversion at assignment
struct array1_integer(kind=4)
struct array1_integer(kind=4)
a.0.i = parm.2;
/opt/gcc/p_work/gcc/testsuite/gfortran.dg/alloc_comp_assign_2.f90:7:0:0: error: non-trivial conversion at assignment
struct array1_integer(kind=4)
struct array1_integer(kind=4)
a.3.i = parm.5;
/opt/gcc/p_work/gcc/testsuite/gfortran.dg/alloc_comp_assign_2.f90:7:0:0: error: non-trivial conversion at assignment
struct array1_integer(kind=4)
struct array1_integer(kind=4)
a.65.i = parm.67;
/opt/gcc/p_work/gcc/testsuite/gfortran.dg/alloc_comp_assign_2.f90:7:0:0: error: non-trivial conversion at assignment
struct array1_integer(kind=4)
struct array1_integer(kind=4)
a.68.i = parm.70;
/opt/gcc/p_work/gcc/testsuite/gfortran.dg/alloc_comp_assign_2.f90:7:0:0: error: non-trivial conversion at assignment
struct b
struct b
temp.74[count1.73_47] = b.75;
/opt/gcc/p_work/gcc/testsuite/gfortran.dg/alloc_comp_assign_2.f90:7:0:0: internal compiler error: verify_gimple failed
lto-wrapper: /opt/gcc/p_xbuild/gcc/testsuite/gfortran/../../gfortran returned 1 exit status
collect2: error: lto-wrapper returned 1 exit status

Thanks for working on this annoying PR.

Dominique

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: [Patch, fortran] [0/5] PR 45586: restrict vs. non-restrict type compatibility hell
  2012-08-25 18:01 [Patch, fortran] [0/5] PR 45586: restrict vs. non-restrict type compatibility hell Dominique Dhumieres
@ 2012-08-25 20:04 ` Mikael Morin
  2012-08-26  7:12   ` Dominique Dhumieres
  2012-08-26 11:24   ` Dominique Dhumieres
  0 siblings, 2 replies; 6+ messages in thread
From: Mikael Morin @ 2012-08-25 20:04 UTC (permalink / raw)
  To: Dominique Dhumieres; +Cc: fortran, gcc-patches

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

On 25/08/2012 20:00, Dominique Dhumieres wrote:
> Dear Mikael,
> 
> Your set of patches works as defined, i.e., it fixes pr45586 without 
> regression on the test suite. However, If the test suite is run with 
> -flto, there are still some failures depending on the way gcc is 
> configured.
Thanks for testing. All right, I'll have to master the LTO beast too. In
the meantime is it by any chance better if the first patch in the serie
is replaced by the attached one?

Mikael


[-- Attachment #2: pr45586_lto.diff --]
[-- Type: text/x-patch, Size: 5351 bytes --]

diff --git a/trans-expr.c b/trans-expr.c
index ebaa238..37dfb5a 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -6306,6 +6332,127 @@ gfc_conv_string_parameter (gfc_se * se)
 }
 
 
+static void
+whole_struct_copy (gfc_se *lse, gfc_se *rse, gfc_typespec ts,
+		   stmtblock_t *block)
+{
+  gfc_ref ref;
+  gfc_component *comp;
+  tree old_lhs, old_rhs, tmp;
+  gfc_symbol *derived;
+
+#if 0
+  if ((ts.type != BT_CLASS && ts.type != BT_DERIVED)
+      || !ts.u.derived->attr.alloc_comp)
+    {
+      gfc_add_modify (block, lse->expr,
+		      fold_convert (TREE_TYPE (lse->expr), rse->expr));
+      return;
+    }
+#endif
+
+  derived = ts.u.derived;
+  old_lhs = lse->expr;
+  old_rhs = gfc_evaluate_now (rse->expr, block);
+
+  ref.type = REF_COMPONENT;
+  ref.next = NULL;
+  ref.u.c.sym = derived;
+  for (comp = derived->components; comp; comp = comp->next)
+    {
+      ref.u.c.component = comp;
+      gfc_conv_component_ref (lse, &ref);
+      gfc_conv_component_ref (rse, &ref);
+      if ((comp->attr.pointer
+           && !comp->attr.dimension
+	   && !comp->attr.codimension)
+          || comp->attr.proc_pointer)
+	{
+	  /* Undereference pointers.  */
+	  if (TREE_CODE (lse->expr) == INDIRECT_REF)
+	    lse->expr = TREE_OPERAND (lse->expr, 0);
+	  if (TREE_CODE (rse->expr) == INDIRECT_REF)
+	    rse->expr = TREE_OPERAND (rse->expr, 0);
+	  gfc_add_modify (block, lse->expr, rse->expr);
+	}
+
+      else if (!comp->attr.allocatable || !comp->attr.dimension)
+	{
+	  bool deep_copy;
+
+	  if (comp->attr.dimension)
+	    {
+	      lse->expr = build4_loc (input_location, ARRAY_RANGE_REF,
+				      TREE_TYPE (lse->expr), lse->expr,
+				      gfc_index_zero_node, NULL_TREE,
+				      NULL_TREE);
+	      rse->expr = build4_loc (input_location, ARRAY_RANGE_REF,
+				      TREE_TYPE (rse->expr), rse->expr,
+				      gfc_index_zero_node, NULL_TREE,
+				      NULL_TREE);
+	      /* Disable subreferences after the array range.  */
+	      deep_copy = false;
+	    }
+	  else
+	    deep_copy = true;
+
+	  tmp = gfc_trans_scalar_assign (lse, rse, comp->ts, true, deep_copy,					    false);
+	  gfc_add_expr_to_block (block, tmp);
+	}
+      else
+	{
+	  tree l_base_expr, r_base_expr;
+	  tree l_field, r_field;
+	
+	  l_base_expr = lse->expr;
+	  r_base_expr = rse->expr;
+	  gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (l_base_expr))
+		      && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (r_base_expr)));
+	  /* copy all but the data pointer in the descriptor.  */
+	  for (l_field = TYPE_FIELDS (TREE_TYPE (l_base_expr)),
+	       r_field = TYPE_FIELDS (TREE_TYPE (r_base_expr));
+	       l_field != NULL_TREE && r_field != NULL_TREE;
+	       l_field = DECL_CHAIN (l_field),
+	       r_field = DECL_CHAIN (r_field))
+	    {
+	      gcc_assert (TREE_CODE (l_field) == FIELD_DECL
+			  && TREE_CODE (r_field) == FIELD_DECL
+			  && DECL_NAME (l_field) == DECL_NAME (r_field));
+	      if (strcmp (IDENTIFIER_POINTER (DECL_NAME (l_field)),
+			  "data") == 0)
+		continue;
+	
+	      lse->expr = fold_build3_loc (input_location, COMPONENT_REF,
+					   TREE_TYPE (l_field),
+					   l_base_expr,
+					   l_field, NULL_TREE);
+	      rse->expr = fold_build3_loc (input_location, COMPONENT_REF,
+					   TREE_TYPE (r_field), r_base_expr,
+					   r_field, NULL_TREE);
+	      if (TREE_CODE (TREE_TYPE (lse->expr)) == ARRAY_TYPE)
+		{
+		  gcc_assert (TREE_CODE (TREE_TYPE (rse->expr)) == ARRAY_TYPE);
+		  lse->expr = build4_loc (input_location, ARRAY_RANGE_REF,
+					  TREE_TYPE (lse->expr),
+					  lse->expr, gfc_index_zero_node,
+					  NULL_TREE, NULL_TREE);
+		  rse->expr = build4_loc (input_location, ARRAY_RANGE_REF,
+					  TREE_TYPE (rse->expr),
+					  rse->expr, gfc_index_zero_node,
+					  NULL_TREE, NULL_TREE);
+	
+	
+		}
+	      gfc_add_modify (block, lse->expr, rse->expr);
+	    }
+	}
+  
+      lse->expr = old_lhs;
+      rse->expr = old_rhs;
+    }
+}
+
+
 /* Generate code for assignment of scalar variables.  Includes character
    strings and derived types with allocatable components.
    If you know that the LHS has no allocations, set dealloc to false.
@@ -6396,8 +6543,30 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
       gfc_add_block_to_block (&block, &rse->pre);
       gfc_add_block_to_block (&block, &lse->pre);
 
-      gfc_add_modify (&block, lse->expr,
-			   fold_convert (TREE_TYPE (lse->expr), rse->expr));
+      if (deep_copy)
+	whole_struct_copy (lse, rse, ts, &block);
+      else
+	{
+	  tree converted;
+
+	  if (TYPE_MAIN_VARIANT (TREE_TYPE (lse->expr))
+	       != TYPE_MAIN_VARIANT (TREE_TYPE (rse->expr))
+	      && !POINTER_TYPE_P (TREE_TYPE (lse->expr))
+	      && !POINTER_TYPE_P (TREE_TYPE (rse->expr)))
+	    {
+	      gcc_assert (TYPE_CANONICAL (TREE_TYPE (lse->expr))
+			  == TYPE_CANONICAL (TREE_TYPE (rse->expr))
+			  && gfc_nonrestricted_type (TREE_TYPE (lse->expr))
+			     == gfc_nonrestricted_type (TREE_TYPE (rse->expr)));
+	      /* fold_convert won't like this.  Let's bypass it.  */
+	      converted = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
+					   TREE_TYPE (lse->expr), rse->expr);
+	    }
+	  else
+	    converted = fold_convert (TREE_TYPE (lse->expr), rse->expr);
+
+	  gfc_add_modify (&block, lse->expr, converted);
+	}
 
       /* Do a deep copy if the rhs is a variable, if it is not the
 	 same as the lhs.  */

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: [Patch, fortran] [0/5] PR 45586: restrict vs. non-restrict type compatibility hell
  2012-08-25 20:04 ` Mikael Morin
@ 2012-08-26  7:12   ` Dominique Dhumieres
  2012-08-26 11:24   ` Dominique Dhumieres
  1 sibling, 0 replies; 6+ messages in thread
From: Dominique Dhumieres @ 2012-08-26  7:12 UTC (permalink / raw)
  To: mikael.morin, dominiq; +Cc: gcc-patches, fortran

> ... In the meantime is it by any chance better if the first patch in the serie
> is replaced by the attached one?

With the new patch for trans-expr.c (keeping those for
trans-types.c and trans.h), typebound_proc_27.f03 -flto -O
now works, but not class_array_7.f03 nor the other tests
I have tried so far.

Dominique

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: [Patch, fortran] [0/5] PR 45586: restrict vs. non-restrict type compatibility hell
  2012-08-25 20:04 ` Mikael Morin
  2012-08-26  7:12   ` Dominique Dhumieres
@ 2012-08-26 11:24   ` Dominique Dhumieres
  2012-08-26 12:18     ` Mikael Morin
  1 sibling, 1 reply; 6+ messages in thread
From: Dominique Dhumieres @ 2012-08-26 11:24 UTC (permalink / raw)
  To: mikael.morin, dominiq; +Cc: gcc-patches, fortran

With the modified patch, gfortran.dg/restrict_type_compat_1.f90 fails
for a regular test:

FAIL: gfortran.dg/restrict_type_compat_1.f90  -O   scan-tree-dump-times original "VIEW_CONVERT_EXPR" 13

A manual check shows only 6 instances of VIEW_CONVERT_EXPR.

Cheers,

Dominique

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: [Patch, fortran] [0/5] PR 45586: restrict vs. non-restrict type compatibility hell
  2012-08-26 11:24   ` Dominique Dhumieres
@ 2012-08-26 12:18     ` Mikael Morin
  0 siblings, 0 replies; 6+ messages in thread
From: Mikael Morin @ 2012-08-26 12:18 UTC (permalink / raw)
  To: Dominique Dhumieres; +Cc: gcc-patches, fortran

On 26/08/2012 13:23, Dominique Dhumieres wrote:
> With the modified patch, gfortran.dg/restrict_type_compat_1.f90 fails
> for a regular test:
> 
> FAIL: gfortran.dg/restrict_type_compat_1.f90  -O   scan-tree-dump-times original "VIEW_CONVERT_EXPR" 13
> 
> A manual check shows only 6 instances of VIEW_CONVERT_EXPR.
> 
Yes, this is expected.
It doesn't fix all the failures anyway, so something else is needed.

Mikael

^ permalink raw reply	[flat|nested] 6+ messages in thread

* [Patch, fortran] [0/5] PR 45586: restrict vs. non-restrict type compatibility hell
@ 2012-08-24 15:12 Mikael Morin
  0 siblings, 0 replies; 6+ messages in thread
From: Mikael Morin @ 2012-08-24 15:12 UTC (permalink / raw)
  To: gfortran, GCC patches

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


Hello, 
here come several patches to fix the infamous PR 45586.  The main issue is
the middle-end expecting variant types to share the fields, thus one field
cannot be restrict qualified in one type, and not restrict qualified in one
of its variants.
The fix, as per Richi's suggestion, makes the types not be variants of each
other, but this raises type compatibility problems, as fold_convert triggers an
assertion if the types are not variants of the same base type.
The fix for that (suggested by Richi again) wraps the expression in a
VIEW_CONVERT_EXPR.
The above is not enough to make LTO happy.  There are problems with structure
constructors, where we use the restricted type, but the variable to assign to
is a target, thus has a non-restrict type.  The fix for that propagates the
information that we don't want restrict qualification from gfc_trans_assignment
down to gfc_conv_structure.  The same applies to array constructors.

The patch is split as follows:
[1/5]: Add the VIEW_CONVERT_EXPR wrapping.
[2/5]: Make target vs. non-target variant types distinct.
[3/5]: Use the target information to assign from structure constructors.
[4/5]: Use the target information to assign from array constructors.
[5/5]: Use the target information to assign a scalar structure to an array.

More details in the follow-up mails.


Regression tested on amd64-linux. OK for trunk?

Mikael

[-- Attachment #2: pr45586-test.CL --]
[-- Type: text/plain, Size: 119 bytes --]

2012-08-18  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/45586
	* gfortran.dg/restrict_type_compat_1.f90: New test.

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

! { dg-do compile }
! { dg-options "-fdump-tree-original" }
!
! PR fortran/45586
! Test restricted vs. non-restricted (or target vs. non-target) type
! compatibility in assignments

  type :: t
    integer :: i
    integer, allocatable :: a(:)
    real :: r
  end type t

  type(t), target :: x, xx(1)
  type(t)         :: y, yy(1)

  x = t( 1, null(), -1.0)
  y = t(-1, null(),  1.0)
  x = y                        ! VIEW_CONVERT_EXPR
  y = x                        ! VIEW_CONVERT_EXPR
  x = t( 1, (/3/), -1.0)
  y = t(-1, (/4/),  1.0)
  x = func()                   ! VIEW_CONVERT_EXPR
  y = func()
  xx = x
  yy = y
  xx = t(1,  null(), -1.0)
  yy = t(-1, null(), 1.0)
  xx = y                        ! VIEW_CONVERT_EXPR
  yy = x                        ! VIEW_CONVERT_EXPR
  xx = yy                       ! VIEW_CONVERT_EXPR
  yy = xx                       ! VIEW_CONVERT_EXPR
  xx = t( 1, (/3/), -1.0)
  yy = t(-1, (/4/),  1.0)
  xx = (/x/)
  yy = (/y/)
  xx = (/t( 1, null(), -1.0)/)
  yy = (/t(-1, null(),  1.0)/)
  xx = (/y/)                    ! VIEW_CONVERT_EXPR
  yy = (/x/)                    ! VIEW_CONVERT_EXPR
  xx = (/yy/)                   ! VIEW_CONVERT_EXPR
  yy = (/xx/)                   ! VIEW_CONVERT_EXPR
  xx = (/t( 1, (/3/), -1.0)/)
  yy = (/t(-1, (/4/),  1.0)/)
  xx = func()                   ! VIEW_CONVERT_EXPR
  yy = func()
  xx = (/func()/)               ! VIEW_CONVERT_EXPR
  yy = (/func()/)

 contains
  
  function func() result(res)
    type(t) :: res
    res = t(2, (/5/), -2.0)
  end function func
end

! { dg-final { scan-tree-dump-times "VIEW_CONVERT_EXPR" 13 "original" } }
! { dg-final { cleanup-tree-dump "original" } }

^ permalink raw reply	[flat|nested] 6+ messages in thread

end of thread, other threads:[~2012-08-26 12:18 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2012-08-25 18:01 [Patch, fortran] [0/5] PR 45586: restrict vs. non-restrict type compatibility hell Dominique Dhumieres
2012-08-25 20:04 ` Mikael Morin
2012-08-26  7:12   ` Dominique Dhumieres
2012-08-26 11:24   ` Dominique Dhumieres
2012-08-26 12:18     ` Mikael Morin
  -- strict thread matches above, loose matches on Subject: below --
2012-08-24 15:12 Mikael Morin

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).