Patchwork [fortran] PR50981 (elemental/optional interaction) follow-up fix

login
register
mail settings
Submitter Mikael Morin
Date Feb. 7, 2012, 11:25 p.m.
Message ID <4F31B2E7.5020908@sfr.fr>
Download mbox | patch
Permalink /patch/140035/
State New
Headers show

Comments

Mikael Morin - Feb. 7, 2012, 11:25 p.m.
Hello,

this fixes the fairly recent PR50981 patch
[http://gcc.gnu.org/ml/fortran/2011-12/msg00170.html] which didn't work 
for subroutine calls, as they use code->resolved_sym instead of 
code->expr1 to store the procedure symbol.


The first patch moves gfc_walk_elemental_function_args's code to get the 
procedure interface into a new procedure.

The second patch moves the procedure call out of 
gfc_walk_elemental_function_args.

The third patch changes the function called in gfc_trans_call so that 
code->resolved_sym is used if code->expr1 fails to give the interface.
I choose to try code->expr1 first for fear that in typebound calls, 
code->resolved_sym may point to the base object, which is obviously not 
the procedure interface.

The testcase is Tobias' comment #13
[http://gcc.gnu.org/bugzilla/show_bug.cgi?id=50981#c13] stripped down to 
the working part.

Regression tested on x86_64-unknown-freebsd9.0. OK for trunk?

Mikael
2012-02-07  Mikael Morin  <mikael@gcc.gnu.org>

	* trans-array.c (gfc_get_proc_ifc_for_expr): New function.
	(gfc_walk_elemental_function_args): Move code to
	gfc_get_proc_ifc_for_expr and call it.
2012-02-07  Mikael Morin  <mikael@gcc.gnu.org>

	* trans-array.c (gfc_walk_elemental_function_args,
	gfc_walk_function_expr): Move call to gfc_get_proc_ifc_for_expr out
	of gfc_walk_elemental_function_args.
	* trans-stmt.c (gfc_trans_call): Ditto.
	* trans-array.h (gfc_get_proc_ifc_for_expr): New prototype.
	(gfc_walk_elemental_function_args): Update prototype.
2012-02-07  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/50981
	* trans-stmt.c (gfc_get_proc_ifc_for_call): New function.
	(gfc_trans_call): Use gfc_get_proc_ifc_for_call.
2012-02-07  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/50981
	* gfortran.dg/elemental_optional_args_5.f90: New test.
! { dg-do run }
!
! PR fortran/50981
! Test the handling of optional, polymorphic and non-polymorphic arguments
! to elemental procedures. 
!
! Original testcase by Tobias Burnus <burnus@net-b.de>

implicit none
type t
  integer :: a
end type t

type t2
  integer, allocatable :: a
  integer, allocatable :: a2(:)
  integer, pointer :: p => null()
  integer, pointer :: p2(:) => null()
end type t2

type(t), allocatable :: ta, taa(:)
type(t), pointer :: tp, tpa(:)
class(t), allocatable :: ca, caa(:)
class(t), pointer :: cp, cpa(:)

type(t2) :: x

integer :: s, v(2)

tp => null()
tpa => null()
cp => null()
cpa => null()

! =============== sub1 ==================
! SCALAR COMPONENTS: Non alloc/assoc

s = 3
v = [9, 33]

call sub1 (s, x%a, .false.)
call sub1 (v, x%a, .false.)
!print *, s, v
if (s /= 3) call abort()
if (any (v /= [9, 33])) call abort()

call sub1 (s, x%p, .false.)
call sub1 (v, x%p, .false.)
!print *, s, v
if (s /= 3) call abort()
if (any (v /= [9, 33])) call abort()


! SCALAR COMPONENTS: alloc/assoc

allocate (x%a, x%p)
x%a = 4
x%p = 5
call sub1 (s, x%a, .true.)
call sub1 (v, x%a, .true.)
!print *, s, v
if (s /= 4*2) call abort()
if (any (v /= [4*2, 4*2])) call abort()

call sub1 (s, x%p, .true.)
call sub1 (v, x%p, .true.)
!print *, s, v
if (s /= 5*2) call abort()
if (any (v /= [5*2, 5*2])) call abort()



contains

  elemental subroutine sub1 (x, y, alloc)
    integer, intent(inout) :: x
    integer, intent(in), optional :: y
    logical, intent(in) :: alloc
    if (alloc .neqv. present (y)) &
      x = -99
    if (present(y)) &
      x = y*2
  end subroutine sub1

end
Tobias Burnus - Feb. 9, 2012, 8:39 a.m.
Dear Mikael,

On 02/08/2012 12:25 AM, Mikael Morin wrote:
> Regression tested on x86_64-unknown-freebsd9.0. OK for trunk?

OK and thanks for the patch!

Tobias

Patch

diff --git a/trans-stmt.c b/trans-stmt.c
index ddbf35e..9b116d3 100644
--- a/trans-stmt.c
+++ b/trans-stmt.c
@@ -348,6 +348,27 @@  gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
 }
 
 
+/* Get the interface symbol for the procedure corresponding to the given call.
+   We can't get the procedure symbol directly as we have to handle the case
+   of (deferred) type-bound procedures.  */
+
+static gfc_symbol *
+get_proc_ifc_for_call (gfc_code *c)
+{
+  gfc_symbol *sym;
+
+  gcc_assert (c->op == EXEC_ASSIGN_CALL || c->op == EXEC_CALL);
+
+  sym = gfc_get_proc_ifc_for_expr (c->expr1);
+
+  /* Fall back/last resort try.  */
+  if (sym == NULL)
+    sym = c->resolved_sym;
+
+  return sym;
+}
+
+
 /* Translate the CALL statement.  Builds a call to an F95 subroutine.  */
 
 tree
@@ -372,7 +393,7 @@  gfc_trans_call (gfc_code * code, bool dependency_check,
   ss = gfc_ss_terminator;
   if (code->resolved_sym->attr.elemental)
     ss = gfc_walk_elemental_function_args (ss, code->ext.actual,
-					   gfc_get_proc_ifc_for_expr (code->expr1),
+					   get_proc_ifc_for_call (code),
 					   GFC_SS_REFERENCE);
 
   /* Is not an elemental subroutine call with array valued arguments.  */