[Patch, Fortran] Fix OPTIONAL, esp. with polymorphism

[Dominique Dhumieres]

Hi Tobias,

I have tested your patch, mostly the added test cases.
I think the test gfortran.dg/class_optional_2.f90 should be split:
it has too much tests lumped together. In addition
the test gfortran.dg/class_optional_1.f90 does not compile
because "symbol 'i' at (1) has no IMPLICIT type" (three times),
this is fixed with something such as

   elemental subroutine sub_ct2(y)
+    integer :: i
     class(t), intent(in), optional :: y
     if (present(y)) i = 5
   end subroutine sub_ct2

but the code seems weird.

The code gfortran.dg/class_optional_2.f90 compiles, but
the runtime does not exit (at least after more than 30s).
Finally I have applied the following changes in order
to make it works:

--- /opt/gcc/p_work/gcc/testsuite/gfortran.dg/class_optional_2.f90	2012-10-06 19:10:08.000000000 +0200
+++ class_optional_2_db_2.f90	2012-10-05 22:11:23.000000000 +0200
@@ -69,14 +69,14 @@
   if (allocated (xa)) call abort ()
 
   call suba2(alloc=.false., prsnt=.false.)
-  call suba2(xa2, alloc=.false., prsnt=.true.)
-  if (.not. allocated (xa2)) call abort ()
-  if (size (xa2) /= 1) call abort ()
-  if (.not. allocated (xa2(1)%i)) call abort ()
-  if (xa2(1)%i /= 5) call abort ()
-  xa2(1)%i = -3
-  call suba2(xa2, alloc=.true., prsnt=.true.)
-  if (allocated (xa2)) call abort ()
+!  call suba2(xa2, alloc=.false., prsnt=.true.)
+!  if (.not. allocated (xa2)) call abort ()
+!  if (size (xa2) /= 1) call abort ()
+!  if (.not. allocated (xa2(1)%i)) call abort ()
+!  if (xa2(1)%i /= 5) call abort ()
+!  xa2(1)%i = -3
+!  call suba2(xa2, alloc=.true., prsnt=.true.)
+!  if (allocated (xa2)) call abort ()
 
   call subp(alloc=.false., prsnt=.false.)
   call subp(xp, alloc=.false., prsnt=.true.)
@@ -88,14 +88,14 @@
   if (associated (xp)) call abort ()
 
   call subp2(alloc=.false., prsnt=.false.)
-  call subp2(xp2, alloc=.false., prsnt=.true.)
-  if (.not. associated (xp2)) call abort ()
-  if (size (xp2) /= 1) call abort ()
-  if (.not. allocated (xp2(1)%i)) call abort ()
-  if (xp2(1)%i /= 5) call abort ()
-  xp2(1)%i = -3
-  call subp2(xp2, alloc=.true., prsnt=.true.)
-  if (associated (xp2)) call abort ()
+!  call subp2(xp2, alloc=.false., prsnt=.true.)
+!  if (.not. associated (xp2)) call abort ()
+!  if (size (xp2) /= 1) call abort ()
+!  if (.not. allocated (xp2(1)%i)) call abort ()
+!  if (xp2(1)%i /= 5) call abort ()
+!  xp2(1)%i = -3
+!  call subp2(xp2, alloc=.true., prsnt=.true.)
+!  if (associated (xp2)) call abort ()
 
   call subac(alloc=.false., prsnt=.false.)
   call subac(xac, alloc=.false., prsnt=.true.)
@@ -107,14 +107,14 @@
   if (allocated (xac)) call abort ()
 
   call suba2c(alloc=.false., prsnt=.false.)
-  call suba2c(xa2c, alloc=.false., prsnt=.true.)
-  if (.not. allocated (xa2c)) call abort ()
-  if (size (xa2c) /= 1) call abort ()
-  if (.not. allocated (xa2c(1)%i)) call abort ()
-  if (xa2c(1)%i /= 5) call abort ()
-  xa2c(1)%i = -3
-  call suba2c(xa2c, alloc=.true., prsnt=.true.)
-  if (allocated (xa2c)) call abort ()
+!  call suba2c(xa2c, alloc=.false., prsnt=.true.)
+!  if (.not. allocated (xa2c)) call abort ()
+!  if (size (xa2c) /= 1) call abort ()
+!  if (.not. allocated (xa2c(1)%i)) call abort ()
+!  if (xa2c(1)%i /= 5) call abort ()
+!  xa2c(1)%i = -3
+!  call suba2c(xa2c, alloc=.true., prsnt=.true.)
+!  if (allocated (xa2c)) call abort ()
 
 contains
  subroutine suba2c(x, prsnt, alloc)
@@ -508,9 +508,9 @@ contains
 !   call s2elem(z3) ! FIXME: Segfault
 !   call s2elem(z4) ! FIXME: Segfault
 !   call s2elem(z5) ! FIXME: Segfault
-   call s2elem_t(x)
-   call s2elem_t(y)
-   call s2elem_t(z)
+!   call s2elem_t(x)
+!   call s2elem_t(y)
+!   call s2elem_t(z)
 !   call s2elem_t(z2) ! FIXME: Segfault
 !   call s2elem_t(z3) ! FIXME: Segfault
 !   call s2elem_t(z4) ! FIXME: Segfault
@@ -550,9 +550,9 @@ contains
 !   call s2elem(z3) ! FIXME: Segfault
 !   call s2elem(z4) ! FIXME: Segfault
 !   call s2elem(z5) ! FIXME: Segfault
-   call s2elem_t2(x)
-   call s2elem_t2(y)
-   call s2elem_t2(z)
+!   call s2elem_t2(x)
+!   call s2elem_t2(y)
+!   call s2elem_t2(z)
 !   call s2elem_t2(z2) ! FIXME: Segfault
 !   call s2elem_t2(z3) ! FIXME: Segfault
 !   call s2elem_t2(z4) ! FIXME: Segfault
@@ -704,9 +704,9 @@ contains
 !   call s2elem(z3) ! FIXME: Segfault
 !   call s2elem(z4) ! FIXME: Segfault
 !   call s2elem(z5) ! FIXME: Segfault
-   call s2elem_t(x)
-   call s2elem_t(y)
-   call s2elem_t(z)
+!   call s2elem_t(x)
+!   call s2elem_t(y)
+!   call s2elem_t(z)
 !   call s2elem_t(z2) ! FIXME: Segfault
 !   call s2elem_t(z3) ! FIXME: Segfault
 !   call s2elem_t(z4) ! FIXME: Segfault
@@ -747,9 +747,9 @@ contains
 !   call s2elem(z3) ! FIXME: Segfault
 !   call s2elem(z4) ! FIXME: Segfault
 !   call s2elem(z5) ! FIXME: Segfault
-   call s2elem_t2(x)
-   call s2elem_t2(y)
-   call s2elem_t2(z)
+!   call s2elem_t2(x)
+!   call s2elem_t2(y)
+!   call s2elem_t2(z)
 !   call s2elem_t2(z2) ! FIXME: Segfault
 !   call s2elem_t2(z3) ! FIXME: Segfault
 !   call s2elem_t2(z4) ! FIXME: Segfault
@@ -798,8 +798,8 @@ contains
 !   call s2elem(z3) ! FIXME: Segfault
 !   call s2elem(z4) ! FIXME: Segfault
 !   call s2elem(z5) ! FIXME: Segfault
-   call s2elem_t(x)
-   call s2elem_t(y)
+!   call s2elem_t(x)
+!   call s2elem_t(y)
 !   call s2elem_t(z) ! FIXME: Segfault
 !   call s2elem_t(z2) ! FIXME: Segfault
 !   call s2elem_t(z3) ! FIXME: Segfault

Thanks for the work,

Dominique