[fortran, patch] Fix conflict detesction for VOLATILE attribute (PR30520)

[Tobias Burnus <burnus at net-b dot de>]

:ADDPATCH fortran:

The following patch fixes the problems found by Steven Correll,
http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/6ec0a526ea59aa94

The first one is an accepts-invalid. We didn't honour:

C1232 (R1221) If an actual argument is an array section or an
assumed-shape array, and the corresponding dummy argument has either the
VOLATILE or ASYNCHRONOUS attribute, that dummy argument shall be an
assumed-shape array.

C1233 (R1221) If an actual argument is a pointer array, and the
corresponding dummy argument has either the VOLATILE or ASYNCHRONOUS
attribute, that dummy argument shall be an assumed-shape array or a
pointer array.


The second one is an ifort bug, only.


The third one is an rejects-valid bug, which I only partially fixed.
(PR30522 contains the missing bits.)

Section 11.2.1 of the Fortran 2003 contains:
"The local identifier of an entity made accessible by a USE statement
... may be given the ASYNCHRONOUS or VOLATILE attribute."


The missing bits are:

- Using "volatile :: foo; volatile :: foo" gives no error for
use-associated variables
- For host associated variables, which are marked as volatile in the
host, using a VOLATILE statement (in the subroutine) gives an error.
- I didn't check the scope of the volatile attribute for host-associated
variables (the subroutine only [as expected] or the whole module/program
including all subroutines?)

Build and regression tested on x86_64-unknown-linux-gnu.
Ok for the trunk? (4.2 does not make sense as there is no VOLATILE.)

Tobias


2007-01-21  Tobias Burnus  <burnus@net-b.de>

    PR fortran/30520
    * interface.c (compare_actual_formal): Check conformance between
    actual and VOLATILE dummy arguments.
    * symbol.c (gfc_add_volatile): Allow setting of VOLATILE
    multiple times in different scopes.
    * decl.c (gfc_match_volatile): Search symbol in host association.

2007-01-21  Tobias Burnus  <burnus@net-b.de>

    PR fortran/30520
    * gfortran.dg/volatile8.f90: New argument conformance test.
    * gfortran.dg/volatile9.f90: New scope test.

Index: gcc/fortran/interface.c
===================================================================
*** gcc/fortran/interface.c	(Revision 121020)
--- gcc/fortran/interface.c	(Arbeitskopie)
*************** compare_actual_formal (gfc_actual_arglis
*** 1417,1422 ****
--- 1417,1458 ----
  	  return 0;
  	}
  
+       /* C1232 (R1221) For an actual argument which is an array sections or
+ 	 an assumed-shaped array, the dummy argument shall be an assumed-
+ 	 shaped array, if the dummy argument has the VOLATILE attribute.  */
+ 
+       if (f->sym->attr.volatile_
+ 	  && ((a->expr->symtree->n.sym->as
+ 	       && a->expr->symtree->n.sym->as->type == AS_ASSUMED_SHAPE)
+ 	      ||(a->expr->ref && a->expr->ref->u.ar.type == AR_SECTION))
+           && !(f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
+ 	{
+ 	  if (where)
+ 	    gfc_error ("Assumed-shaped or array-section actual argument at "
+ 		       "%L is incompatible with the non-assumed-shaped "
+ 		       "dummy argument '%s' due to VOLATILE attribute",
+ 		       &a->expr->where,f->sym->name);
+ 	  return 0;
+ 	}
+ 
+       /* C1233 (R1221) For an actual argument which is a pointer array, the
+ 	 dummy argument shall be an assumed-shaped or pointer array, if the
+ 	 dummy argument has the VOLATILE attribute.  */
+ 
+       if (f->sym->attr.volatile_
+ 	  && (a->expr->symtree->n.sym->attr.pointer
+ 	      && a->expr->symtree->n.sym->as)
+           && !(f->sym->as && (f->sym->as->type == AS_ASSUMED_SHAPE
+                || f->sym->attr.pointer)))
+ 	{
+        	  if (where)
+ 	    gfc_error ("Pointer-array actual argument at %L is incompatible "
+ 		       "with the neither assumed-shaped nor pointer array "
+ 		       "dummy argument '%s' due to VOLATILE attribute",
+ 		       &a->expr->where,f->sym->name);
+ 	  return 0;
+ 	}
+ 
      match:
        if (a == actual)
  	na = i;
Index: gcc/fortran/symbol.c
===================================================================
*** gcc/fortran/symbol.c	(Revision 121020)
--- gcc/fortran/symbol.c	(Arbeitskopie)
*************** try
*** 877,886 ****
  gfc_add_volatile (symbol_attribute * attr, const char *name, locus * where)
  {
  
!   if (check_used (attr, name, where))
!     return FAILURE;
! 
!   if (attr->volatile_)
      {
  	if (gfc_notify_std (GFC_STD_LEGACY, 
  			    "Duplicate VOLATILE attribute specified at %L",
--- 877,890 ----
  gfc_add_volatile (symbol_attribute * attr, const char *name, locus * where)
  {
  
!   /* No check_used needed as 11.2.1 of the F2003 standard allows
!      that the local identifier, made accessible by a use statment, can be
!      given a VOLATILE attribute.  */
! 
!   /* TODO: The following allows multiple VOLATILE statements for
!      use-associated variables and it prevents to set VOLATILE for a host-
!      associated variable which is already marked as VOLATILE in the host.  */
!   if (attr->volatile_ && !attr->use_assoc)
      {
  	if (gfc_notify_std (GFC_STD_LEGACY, 
  			    "Duplicate VOLATILE attribute specified at %L",
Index: gcc/fortran/decl.c
===================================================================
*** gcc/fortran/decl.c	(Revision 121020)
--- gcc/fortran/decl.c	(Arbeitskopie)
*************** gfc_match_volatile (void)
*** 4221,4227 ****
  
    for(;;)
      {
!       m = gfc_match_symbol (&sym, 0);
        switch (m)
  	{
  	case MATCH_YES:
--- 4221,4229 ----
  
    for(;;)
      {
!       /* VOLATILE is special by allowing to locally overwrite the attribute
!          of host-associated symbols.  */
!       m = gfc_match_symbol (&sym, 1);
        switch (m)
  	{
  	case MATCH_YES:
Index: gcc/testsuite/gfortran.dg/volatile8.f90
===================================================================
*** gcc/testsuite/gfortran.dg/volatile8.f90	(Revision 0)
--- gcc/testsuite/gfortran.dg/volatile8.f90	(Revision 0)
***************
*** 0 ****
--- 1,58 ----
+ ! Check for compatibily of actual arguments
+ ! with dummy arguments marked as volatile
+ ! 
+ ! Contributed by Steven Correll.
+ !
+ ! PR fortran/30520
+ 
+ ! { dg-do compile }
+ 
+    subroutine s8()
+     implicit none
+     interface
+       subroutine sub8(dummy8)
+         integer, volatile, dimension(3) :: dummy8
+       end subroutine sub8
+       subroutine sub8a(dummy8a)
+         integer, volatile, dimension(:) :: dummy8a
+       end subroutine sub8a
+     end interface
+     integer, dimension(8) :: a
+     call sub8 (a(1:5:2)) ! { dg-error "Assumed-shaped or array-section" }
+     call sub8a(a(1:5:2))
+   end subroutine s8 
+ 
+   subroutine s9(s9dummy)
+     implicit none
+     integer, dimension(:) :: s9dummy
+     interface
+       subroutine sub9(dummy9)
+         integer, volatile, dimension(3) :: dummy9
+       end subroutine sub9
+       subroutine sub9a(dummy9a)
+         integer, volatile, dimension(:) :: dummy9a
+       end subroutine sub9a
+     end interface
+     integer, dimension(9) :: a
+     call sub9 (s9dummy) ! { dg-error "Assumed-shaped or array-section" }
+     call sub9a(s9dummy)
+   end subroutine s9 
+ 
+   subroutine s10()
+     implicit none
+     interface
+       subroutine sub10(dummy10)
+         integer, volatile, dimension(3) :: dummy10
+       end subroutine sub10
+       subroutine sub10a(dummy10a)
+         integer, volatile, dimension(:) :: dummy10a
+       end subroutine sub10a
+       subroutine sub10b(dummy10b)
+         integer, volatile, dimension(:), pointer :: dummy10b
+       end subroutine sub10b
+     end interface
+     integer, dimension(:), pointer :: a
+     call sub10 (a) ! { dg-error "Pointer-array actual argument" }
+     call sub10a(a)
+     call sub10b(a)
+   end subroutine s10 
Index: gcc/testsuite/gfortran.dg/volatile9.f90
===================================================================
*** gcc/testsuite/gfortran.dg/volatile9.f90	(Revision 0)
--- gcc/testsuite/gfortran.dg/volatile9.f90	(Revision 0)
***************
*** 0 ****
--- 1,44 ----
+ ! Check for valid VOLATILE uses
+ !
+ ! Contributed by Steven Correll.
+ !
+ ! PR fortran/30520
+ 
+ ! { dg-do compile }
+  
+   function f() result(fr)
+     integer, volatile :: fr
+     fr = 5
+   end function f 
+ 
+   module mod13
+     implicit none
+     integer :: v13
+   end module mod13 
+ 
+   module mod13a
+    use mod13
+    implicit none
+    volatile :: v13
+    real :: v14
+   contains
+    subroutine s13()
+      volatile :: v13
+      volatile :: v14
+    end subroutine s13 
+   end module mod13a 
+ 
+   module mod13b
+    use mod13a
+    implicit none
+    volatile :: v13
+   end module mod13b 
+ 
+ 
+   subroutine s14()
+     use mod13a
+     implicit none
+     volatile :: v13
+   end subroutine s14 
+ 
+ ! { dg-final { cleanup-modules "mod13 mod13a mod13b" } }