Dear all,
PR 50981 is about passing an absent argument to an elemental procedure.
a) Passing an absent optional dummy as actual.
4.4-4.7 Regression, fixed for 4.7; backporting pending.
b) Passing an unallocated allocatable or not associated pointer as actual
F2008/GCC 4.6 feature. Fixed by this patch.
c) Handling polymorphic scalars/arrays with elemental procedures
Some draft patch available, but needs more work. That's a 4.7/4.8 item.
The attached patch solves (b).
Build and regtested on x86-64-linux.
OK for the trunk? (And [together with (a)] for the 4.6 branch?)
Tobias
2012-01-16 Mikael Morin <mik...@gcc.gnu.org>
Tobias Burnus <bur...@net-b.de>
PR fortran/50981
* trans-array.c (gfc_walk_elemental_function_args): Fix
passing of deallocated allocatables/pointers as absent argument.
2012-01-16 Mikael Morin <mik...@gcc.gnu.org>
Tobias Burnus <bur...@net-b.de>
PR fortran/50981
* gfortran.dg/elemental_optional_args_3.f90: New
* gfortran.dg/elemental_optional_args_4.f90: New
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c (revision 183208)
+++ gcc/fortran/trans-array.c (working copy)
@@ -8399,9 +8399,10 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc
if (dummy_arg != NULL
&& dummy_arg->sym->attr.optional
- && arg->expr->symtree
- && arg->expr->symtree->n.sym->attr.optional
- && arg->expr->ref == NULL)
+ && arg->expr->expr_type == EXPR_VARIABLE
+ && (gfc_expr_attr (arg->expr).optional
+ || gfc_expr_attr (arg->expr).allocatable
+ || gfc_expr_attr (arg->expr).pointer))
newss->info->data.scalar.can_be_null_ref = true;
}
else
Index: gcc/testsuite/gfortran.dg/elemental_optional_args_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/elemental_optional_args_3.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/elemental_optional_args_3.f90 (working copy)
@@ -0,0 +1,85 @@
+! { dg-do run }
+!
+! PR fortran/50981
+! The program used to dereference a NULL pointer when trying to access
+! a pointer dummy argument to be passed to an elemental subprocedure.
+!
+! Original testcase from Andriy Kostyuk <kost...@fias.uni-frankfurt.de>
+
+PROGRAM test
+ IMPLICIT NONE
+ REAL(KIND=8), DIMENSION(2) :: aa, rr
+ INTEGER, TARGET :: c
+ INTEGER, POINTER :: b
+
+ aa(1)=10.
+ aa(2)=11.
+
+ b=>c
+ b=1
+
+ ! WRITE(*,*) 'Both f1 and ff work if the optional parameter is present:'
+
+ rr=f1(aa,b)
+ ! WRITE(*,*) ' rr(1)=', rr(1), ' rr(2)=', rr(2)
+ IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT
+
+ rr=0
+ rr=ff(aa,b)
+ ! WRITE(*,*) ' rr(1)=', rr(1), ' rr(2)=', rr(2)
+ IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT
+
+
+ b => NULL()
+ ! WRITE(*,*) 'But only f1 works if the optional parameter is absent:'
+
+ rr=0
+ rr=f1(aa, b)
+ ! WRITE(*,*) ' rr(1)=', rr(1), ' rr(2)=', rr(2)
+ IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT
+
+ rr = 0
+ rr=ff(aa, b)
+ ! WRITE(*,*) ' rr(1)=', rr(1), ' rr(2)=', rr(2)
+ IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT
+
+
+CONTAINS
+
+ FUNCTION ff(a,b)
+ IMPLICIT NONE
+ REAL(KIND=8), INTENT(IN) :: a(:)
+ REAL(KIND=8), DIMENSION(SIZE(a)) :: ff
+ INTEGER, INTENT(IN), POINTER :: b
+ REAL(KIND=8), DIMENSION(2, SIZE(a)) :: ac
+ ac(1,:)=a
+ ac(2,:)=a**2
+ ff=SUM(gg(ac,b), dim=1)
+ END FUNCTION ff
+
+ FUNCTION f1(a,b)
+ IMPLICIT NONE
+ REAL(KIND=8), INTENT(IN) :: a(:)
+ REAL(KIND=8), DIMENSION(SIZE(a)) :: f1
+ INTEGER, INTENT(IN), POINTER :: b
+ REAL(KIND=8), DIMENSION(2, SIZE(a)) :: ac
+ ac(1,:)=a
+ ac(2,:)=a**2
+ f1=gg(ac(1,:),b)+gg(ac(2,:),b) ! This is the same as in ff, but without using the elemental feature of gg
+ END FUNCTION f1
+
+ ELEMENTAL REAL(KIND=8) FUNCTION gg(a,b)
+ IMPLICIT NONE
+ REAL(KIND=8), INTENT(IN) :: a
+ INTEGER, INTENT(IN), OPTIONAL :: b
+ INTEGER ::b1
+ IF(PRESENT(b)) THEN
+ b1=b
+ ELSE
+ b1=1
+ ENDIF
+ gg=a**b1
+ END FUNCTION gg
+
+
+END PROGRAM test
Index: gcc/testsuite/gfortran.dg/elemental_optional_args_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/elemental_optional_args_4.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/elemental_optional_args_4.f90 (working copy)
@@ -0,0 +1,84 @@
+! { dg-do run }
+!
+! PR fortran/50981
+! The program used to dereference a NULL pointer when trying to access
+! an allocatable dummy argument to be passed to an elemental subprocedure.
+!
+! Original testcase from Andriy Kostyuk <kost...@fias.uni-frankfurt.de>
+
+PROGRAM test
+ IMPLICIT NONE
+ REAL(KIND=8), DIMENSION(2) :: aa, rr
+ INTEGER, ALLOCATABLE :: b
+
+ aa(1)=10.
+ aa(2)=11.
+
+ ALLOCATE(b)
+ b=1
+
+ ! WRITE(*,*) 'Both f1 and ff work if the optional parameter is present:'
+
+ rr=f1(aa,b)
+ ! WRITE(*,*) ' rr(1)=', rr(1), ' rr(2)=', rr(2)
+ IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT
+
+ rr=0
+ rr=ff(aa,b)
+ ! WRITE(*,*) ' rr(1)=', rr(1), ' rr(2)=', rr(2)
+ IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT
+
+
+ DEALLOCATE(b)
+ ! WRITE(*,*) 'But only f1 works if the optional parameter is absent:'
+
+ rr=0
+ rr=f1(aa, b)
+ ! WRITE(*,*) ' rr(1)=', rr(1), ' rr(2)=', rr(2)
+ IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT
+
+ rr = 0
+ rr=ff(aa, b)
+ ! WRITE(*,*) ' rr(1)=', rr(1), ' rr(2)=', rr(2)
+ IF (ANY(rr /= (/ 110, 132 /))) CALL ABORT
+
+
+CONTAINS
+
+ FUNCTION ff(a,b)
+ IMPLICIT NONE
+ REAL(KIND=8), INTENT(IN) :: a(:)
+ REAL(KIND=8), DIMENSION(SIZE(a)) :: ff
+ INTEGER, INTENT(IN), ALLOCATABLE :: b
+ REAL(KIND=8), DIMENSION(2, SIZE(a)) :: ac
+ ac(1,:)=a
+ ac(2,:)=a**2
+ ff=SUM(gg(ac,b), dim=1)
+ END FUNCTION ff
+
+ FUNCTION f1(a,b)
+ IMPLICIT NONE
+ REAL(KIND=8), INTENT(IN) :: a(:)
+ REAL(KIND=8), DIMENSION(SIZE(a)) :: f1
+ INTEGER, INTENT(IN), ALLOCATABLE :: b
+ REAL(KIND=8), DIMENSION(2, SIZE(a)) :: ac
+ ac(1,:)=a
+ ac(2,:)=a**2
+ f1=gg(ac(1,:),b)+gg(ac(2,:),b) ! This is the same as in ff, but without using the elemental feature of gg
+ END FUNCTION f1
+
+ ELEMENTAL REAL(KIND=8) FUNCTION gg(a,b)
+ IMPLICIT NONE
+ REAL(KIND=8), INTENT(IN) :: a
+ INTEGER, INTENT(IN), OPTIONAL :: b
+ INTEGER ::b1
+ IF(PRESENT(b)) THEN
+ b1=b
+ ELSE
+ b1=1
+ ENDIF
+ gg=a**b1
+ END FUNCTION gg
+
+
+END PROGRAM test
