diff mbox

[Fortran] PR fortran/45197: F2008: Allow IMPURE elemental procedures

Message ID 4C5B13C9.10905@domob.eu
State New
Headers show

Commit Message

Daniel Kraft Aug. 5, 2010, 7:40 p.m. UTC 
Hi,

the small patch attached implements the F2008 attribute IMPURE that may
be given to procedures; this may be used to get ELEMENTAL procedures
that are not also PURE (as is the default).

Instead of checking (attr.pure || attr.elemental) in gfc_pure, only
attr.pure is checked -- which seems also cleaner to me.  Instead,
attr.pure is set if ELEMENTAL but not IMPURE was parsed.

No regressions on GNU/Linux-x86-32.  Ok for trunk?

Daniel

Comments

Tobias Burnus Aug. 13, 2010, 9:37 p.m. UTC | #1 
Daniel Kraft wrote:
> No regressions on GNU/Linux-x86-32.  Ok for trunk?

Thanks for the patch, but I think you also should also update 
intrinsic.c; there one has:

       next_sym->elemental = (cl == CLASS_ELEMENTAL);

and does not set PURE. And one has:

enum klass
{ NO_CLASS = 0, CLASS_ELEMENTAL, CLASS_INQUIRY, CLASS_TRANSFORMATIONAL };


I think "NO_CLASS" should now be "CLASS_IMPURE" (S) and "CLASS_PURE" 
(PS) should be added. One should also audit elemental (E, ES / 
CLASS_ELEMENTAL) to make sure that the current list is correct with 
regards to pure/elemental.

Compare, F2008's Table 13.1 on page 319 ff.

Tobias
Tobias Burnus Aug. 14, 2010, 8:58 a.m. UTC | #2 
Tobias Burnus wrote:
>  Daniel Kraft wrote:
>> No regressions on GNU/Linux-x86-32.  Ok for trunk?

Can you also add a check for

C1289 All dummy arguments of an elemental procedure shall be scalar 
noncoarray dummy data objects and shall not have the POINTER or 
ALLOCATABLE attribute.

The ALLOCATABLE part is unchecked (also without your patch):

impure elemental subroutine impEl(a)
   integer, allocatable,intent(in) :: a
end subroutine impel

  * * *

If one looks at the following program

integer :: x(10),y(10)
call impEl(x,y(1))
contains
impure elemental subroutine impEl(a,b)
   integer, intent(inout) :: a
   integer :: b
   ! INTENT(OUT) :: b
end subroutine impel
end

it is unclear what it is supposed to do. If "b" is 
INTENT(OUT)/INTENT(INOUT) the following error is printed:

call impEl(x,y(1))
              1
Error: Actual argument at (1) for INTENT(OUT) dummy 'b' of ELEMENTAL 
subroutine 'impel' is a scalar, but another actual argument is an array


I think an error should be printed - either by including INTENT_UNKNOWN 
in the list of checks or by requiring that the intent is specified.

In the interpretation request F08/0024, cf. 
http://j3-fortran.org/doc/meeting/192/10-174r1.txt, an edit to always 
require INTENTs for ELEMENTAL procedues was proposed. The proposal has 
passed the J3 meeting, cf. 
http://j3-fortran.org/doc/meeting/193/10-199.txt and all 8 results of 
the J3 balloting were "Y"es, if I counted correctly. Note: At the WG5 
meeting, the intepretation could still be changed, but that seems to be 
unlikely in this case.

Thus, can you add a check that ELEMENTAL procedures always have an 
INTENT specified?

Tobias
diff mbox

Patch

Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 162915)
+++ gcc/fortran/decl.c	(working copy)
@@ -3979,45 +3979,81 @@  match
 gfc_match_prefix (gfc_typespec *ts)
 {
   bool seen_type;
+  bool seen_impure;
+  bool found_prefix;
 
   gfc_clear_attr (&current_attr);
-  seen_type = 0;
+  seen_type = false;
+  seen_impure = false;
 
   gcc_assert (!gfc_matching_prefix);
   gfc_matching_prefix = true;
 
-loop:
-  if (!seen_type && ts != NULL
-      && gfc_match_decl_type_spec (ts, 0) == MATCH_YES
-      && gfc_match_space () == MATCH_YES)
+  do
     {
+      found_prefix = false;
 
-      seen_type = 1;
-      goto loop;
-    }
+      if (!seen_type && ts != NULL
+	  && gfc_match_decl_type_spec (ts, 0) == MATCH_YES
+	  && gfc_match_space () == MATCH_YES)
+	{
 
-  if (gfc_match ("elemental% ") == MATCH_YES)
-    {
-      if (gfc_add_elemental (&current_attr, NULL) == FAILURE)
-	goto error;
+	  seen_type = true;
+	  found_prefix = true;
+	}
+
+      if (gfc_match ("elemental% ") == MATCH_YES)
+	{
+	  if (gfc_add_elemental (&current_attr, NULL) == FAILURE)
+	    goto error;
+
+	  found_prefix = true;
+	}
+
+      if (gfc_match ("pure% ") == MATCH_YES)
+	{
+	  if (gfc_add_pure (&current_attr, NULL) == FAILURE)
+	    goto error;
+
+	  found_prefix = true;
+	}
 
-      goto loop;
+      if (gfc_match ("recursive% ") == MATCH_YES)
+	{
+	  if (gfc_add_recursive (&current_attr, NULL) == FAILURE)
+	    goto error;
+
+	  found_prefix = true;
+	}
+
+      /* IMPURE is a somewhat special case, as it needs not set an actual
+	 attribute but rather only prevents ELEMENTAL routines from being
+	 automatically PURE.  */
+      if (gfc_match ("impure% ") == MATCH_YES)
+	{
+	  if (gfc_notify_std (GFC_STD_F2008,
+			      "Fortran 2008: IMPURE procedure at %C")
+		== FAILURE)
+	    goto error;
+
+	  seen_impure = true;
+	  found_prefix = true;
+	}
     }
+  while (found_prefix);
 
-  if (gfc_match ("pure% ") == MATCH_YES)
+  /* IMPURE and PURE must not both appear, of course.  */
+  if (seen_impure && current_attr.pure)
     {
-      if (gfc_add_pure (&current_attr, NULL) == FAILURE)
-	goto error;
-
-      goto loop;
+      gfc_error ("PURE and IMPURE must not appear both at %C");
+      goto error;
     }
 
-  if (gfc_match ("recursive% ") == MATCH_YES)
+  /* If IMPURE it not seen but the procedure is ELEMENTAL, mark it as PURE.  */
+  if (!seen_impure && current_attr.elemental && !current_attr.pure)
     {
-      if (gfc_add_recursive (&current_attr, NULL) == FAILURE)
+      if (gfc_add_pure (&current_attr, NULL) == FAILURE)
 	goto error;
-
-      goto loop;
     }
 
   /* At this point, the next item is not a prefix.  */
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 162915)
+++ gcc/fortran/resolve.c	(working copy)
@@ -12438,7 +12438,7 @@  gfc_pure (gfc_symbol *sym)
 	  if (sym == NULL)
 	    return 0;
 	  attr = sym->attr;
-	  if (attr.flavor == FL_PROCEDURE && (attr.pure || attr.elemental))
+	  if (attr.flavor == FL_PROCEDURE && attr.pure)
 	    return 1;
 	}
       return 0;
@@ -12446,7 +12446,7 @@  gfc_pure (gfc_symbol *sym)
 
   attr = sym->attr;
 
-  return attr.flavor == FL_PROCEDURE && (attr.pure || attr.elemental);
+  return attr.flavor == FL_PROCEDURE && attr.pure;
 }
 
 
Index: gcc/testsuite/gfortran.dg/impure_2.f08
===================================================================
--- gcc/testsuite/gfortran.dg/impure_2.f08	(revision 0)
+++ gcc/testsuite/gfortran.dg/impure_2.f08	(revision 0)
@@ -0,0 +1,27 @@ 
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+
+! PR fortran/45197
+! Check for errors with IMPURE.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+MODULE m
+  IMPLICIT NONE
+
+CONTAINS
+
+  IMPURE PURE SUBROUTINE foobar () ! { dg-error "must not appear both" }
+
+  PURE ELEMENTAL IMPURE FUNCTION xyz () ! { dg-error "must not appear both" }
+
+  IMPURE ELEMENTAL SUBROUTINE mysub ()
+  END SUBROUTINE mysub
+
+  PURE SUBROUTINE purified ()
+    CALL mysub () ! { dg-error "is not PURE" }
+  END SUBROUTINE purified
+
+END MODULE m
+
+! { dg-final { cleanup-modules "m" } }
Index: gcc/testsuite/gfortran.dg/impure_1.f08
===================================================================
--- gcc/testsuite/gfortran.dg/impure_1.f08	(revision 0)
+++ gcc/testsuite/gfortran.dg/impure_1.f08	(revision 0)
@@ -0,0 +1,71 @@ 
+! { dg-do run }
+! { dg-options "-std=f2008 -fall-intrinsics" }
+
+! PR fortran/45197
+! Check that IMPURE and IMPURE ELEMENTAL in particular works.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+MODULE m
+  IMPLICIT NONE
+
+  INTEGER, PARAMETER :: n = 5
+
+  INTEGER :: i
+  INTEGER :: arr(n)
+
+CONTAINS
+
+  ! This ought to work (without any effect).
+  IMPURE SUBROUTINE foobar ()
+  END SUBROUTINE foobar
+
+  IMPURE ELEMENTAL SUBROUTINE impureSub (a)
+    INTEGER, INTENT(IN) :: a
+
+    arr(i) = a
+    i = i + 1
+
+    PRINT *, a
+  END SUBROUTINE impureSub
+
+END MODULE m
+
+PROGRAM main
+  USE :: m
+  IMPLICIT NONE
+
+  INTEGER :: a(n), b(n), s
+
+  a = (/ (i, i = 1, n) /)
+
+  ! Traverse in forward order.
+  s = 0
+  b = accumulate (a, s)
+  IF (ANY (b /= (/ 1, 3, 6, 10, 15 /))) CALL abort ()
+
+  ! And now backward.
+  s = 0
+  b = accumulate (a(n:1:-1), s)
+  IF (ANY (b /= (/ 5, 9, 12, 14, 15 /))) CALL abort ()
+
+  ! Use subroutine.
+  i = 1
+  arr = 0
+  CALL impureSub (a)
+  IF (ANY (arr /= a)) CALL abort ()
+
+CONTAINS
+
+  IMPURE ELEMENTAL FUNCTION accumulate (a, s)
+    INTEGER, INTENT(IN) :: a
+    INTEGER, INTENT(INOUT) :: s
+    INTEGER :: accumulate
+    
+    s = s + a
+    accumulate = s
+  END FUNCTION accumulate
+
+END PROGRAM main
+
+! { dg-final { cleanup-modules "m" } }
Index: gcc/testsuite/gfortran.dg/impure_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/impure_3.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/impure_3.f90	(revision 0)
@@ -0,0 +1,11 @@ 
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! PR fortran/45197
+! Check that IMPURE gets rejected without F2008.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+IMPURE SUBROUTINE foobar () ! { dg-error "Fortran 2008" }
+
+IMPURE ELEMENTAL FUNCTION xyz () ! { dg-error "Fortran 2008" }
Index: gcc/testsuite/gfortran.dg/typebound_proc_6.f03
===================================================================
--- gcc/testsuite/gfortran.dg/typebound_proc_6.f03	(revision 162915)
+++ gcc/testsuite/gfortran.dg/typebound_proc_6.f03	(working copy)
@@ -59,7 +59,7 @@  MODULE testmod
     PROCEDURE, NOPASS :: pure2 => proc_sub ! { dg-error "must also be PURE" }
     PROCEDURE, NOPASS :: nonpure => proc_pure ! Ok, overridden not pure.
     PROCEDURE, NOPASS :: elemental1 => proc_elemental ! Ok, both elemental.
-    PROCEDURE, NOPASS :: elemental2 => proc_nonelem ! { dg-error "must also be ELEMENTAL" }
+    PROCEDURE, NOPASS :: elemental2 => proc_nonelem ! { dg-error "must also be" }
     PROCEDURE, NOPASS :: nonelem1 => proc_nonelem ! Ok, non elemental.
     PROCEDURE, NOPASS :: nonelem2 => proc_elemental ! { dg-error "must not be ELEMENTAL" }