re PR fortran/50981 ([OOP] Wrong-code for scalarizing ELEMENTAL call with absent OPTIONAL argument)

2012-01-16  Mikael Morin  <mikael@gcc.gnu.org>
            Tobias Burnus  <burnus@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  <mikael@gcc.gnu.org>
            Tobias Burnus  <burnus@net-b.de>

        PR fortran/50981
        * gfortran.dg/elemental_optional_args_3.f90: New
        * gfortran.dg/elemental_optional_args_4.f90: New


Co-Authored-By: Tobias Burnus <burnus@net-b.de>

From-SVN: r183220

5 files changed, 187 insertions, 3 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4fd3138..a4838ab 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2012-01-16  Mikael Morin  <mikael@gcc.gnu.org>
+	    Tobias Burnus  <burnus@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  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/51809
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 6dcd531..b4ed58f 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -8423,9 +8423,10 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
 
 	  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
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b905453..82f9dd3 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2012-01-16  Mikael Morin  <mikael@gcc.gnu.org>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/50981
+	* gfortran.dg/elemental_optional_args_3.f90: New
+	* gfortran.dg/elemental_optional_args_4.f90: New
+
 2012-01-16  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/51809
diff --git a/gcc/testsuite/gfortran.dg/elemental_optional_args_3.f90 b/gcc/testsuite/gfortran.dg/elemental_optional_args_3.f90
new file mode 100644
index 0000000..c1098b3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_optional_args_3.f90
@@ -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 <kostyuk@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
diff --git a/gcc/testsuite/gfortran.dg/elemental_optional_args_4.f90 b/gcc/testsuite/gfortran.dg/elemental_optional_args_4.f90
new file mode 100644
index 0000000..fa359fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_optional_args_4.f90
@@ -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 <kostyuk@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