OSDN Git Service

2008-08-14 Janus Weil <janus@gcc.gnu.org>
authorjanus <janus@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 14 Aug 2008 21:15:59 +0000 (21:15 +0000)
committerjanus <janus@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 14 Aug 2008 21:15:59 +0000 (21:15 +0000)
PR fortran/36705
* symbol.c (check_conflict): Move conflict checks for (procedure,save)
and (procedure,intent) to resolve_fl_procedure.
* resolve.c (resolve_fl_procedure): Ditto.

2008-08-14  Janus Weil  <janus@gcc.gnu.org>

PR fortran/36705
* gfortran.dg/argument_checking_7.f90: Modified.
* gfortran.dg/conflicts.f90: Modified.
* gfortran.dg/proc_decl_1.f90: Modified.
* gfortran.dg/proc_ptr_9.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@139116 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/resolve.c
gcc/fortran/symbol.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/argument_checking_7.f90
gcc/testsuite/gfortran.dg/conflicts.f90
gcc/testsuite/gfortran.dg/proc_decl_1.f90
gcc/testsuite/gfortran.dg/proc_ptr_9.f90 [new file with mode: 0644]

index 3bdfb52..3ea6c32 100644 (file)
@@ -1,3 +1,10 @@
+2008-08-14  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/36705
+       * symbol.c (check_conflict): Move conflict checks for (procedure,save)
+       and (procedure,intent) to resolve_fl_procedure.
+       * resolve.c (resolve_fl_procedure): Ditto.
+
 2008-08-09  Manuel Lopez-Ibanez  <manu@gcc.gnu.org>
 
        PR 36901
index c6a241a..994cb71 100644 (file)
@@ -7443,6 +7443,20 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
        }
     }
   
+  if (sym->attr.save == SAVE_EXPLICIT && !sym->attr.proc_pointer)
+    {
+      gfc_error ("PROCEDURE attribute conflicts with SAVE attribute "
+                "in '%s' at %L", sym->name, &sym->declared_at);
+      return FAILURE;
+    }
+
+  if (sym->attr.intent && !sym->attr.proc_pointer)
+    {
+      gfc_error ("PROCEDURE attribute conflicts with INTENT attribute "
+                "in '%s' at %L", sym->name, &sym->declared_at);
+      return FAILURE;
+    }
+
   return SUCCESS;
 }
 
index 6b64bcf..d564dd7 100644 (file)
@@ -417,12 +417,8 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
            goto conflict;
 
          case FL_PROCEDURE:
-           if (attr->proc_pointer)
-             break;
-           a1 = gfc_code2string (flavors, attr->flavor);
-           a2 = save;
-           goto conflict;
-
+           /* Conflicts between SAVE and PROCEDURE will be checked at
+              resolution stage, see "resolve_fl_procedure".  */
          case FL_VARIABLE:
          case FL_NAMELIST:
          default:
@@ -618,8 +614,8 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
       break;
 
     case FL_PROCEDURE:
-      if (!attr->proc_pointer)
-        conf2 (intent);
+      /* Conflicts with INTENT will be checked at resolution stage,
+        see "resolve_fl_procedure".  */
 
       if (attr->subroutine)
        {
index 9a8f5f5..94bde48 100644 (file)
@@ -1,3 +1,11 @@
+2008-08-14  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/36705
+       * gfortran.dg/argument_checking_7.f90: Modified.
+       * gfortran.dg/conflicts.f90: Modified.
+       * gfortran.dg/proc_decl_1.f90: Modified.
+       * gfortran.dg/proc_ptr_9.f90: New.
+
 2008-08-14  Paolo Carlini  <paolo.carlini@oracle.com>
 
        PR c++/34485
index 17f043a..1c74fc5 100644 (file)
@@ -12,7 +12,7 @@ module cyclic
       character(len(y)-1) ouch
       integer i
       do i = 1, len(ouch)
-        ouch(i:i) = achar(ieor(iachar(x(i:i)),iachar(y(i:i)))) ! { dg-error " PROCEDURE attribute conflicts" }
+        ouch(i:i) = achar(ieor(iachar(x(i:i)),iachar(y(i:i)))) ! { dg-error "Syntax error in argument list" }
       end do
       end function ouch
 end module cyclic
index b1b59f4..1f10a65 100644 (file)
@@ -2,16 +2,16 @@
 ! Check for conflicts
 ! PR fortran/29657
 
-function f1() ! { dg-error "has no IMPLICIT type" }
+function f1() ! { dg-error "PROCEDURE attribute conflicts with SAVE attribute" }
   implicit none
-  real, save :: f1 ! { dg-error "PROCEDURE attribute conflicts with SAVE attribute" }
+  real, save :: f1
   f1 = 1.0
 end function f1
 
-function f2()
+function f2() ! { dg-error "PROCEDURE attribute conflicts with SAVE attribute" }
   implicit none
   real :: f2
-  save f2 ! { dg-error "PROCEDURE attribute conflicts with SAVE attribute" }
+  save f2
   f2 = 1.0
 end function f2
 
index 3e7a3d1..219722f 100644 (file)
@@ -53,13 +53,13 @@ program prog
 
 contains
 
-  subroutine foo(a,c)
+  subroutine foo(a,c)  ! { dg-error "PROCEDURE attribute conflicts with INTENT attribute" }
     abstract interface
       subroutine b() bind(C)
       end subroutine b
     end interface
     procedure(b), bind(c,name="hjj") :: a  ! { dg-error "may not have BIND.C. attribute with NAME" }
-    procedure(c),intent(in):: c  ! { dg-error "PROCEDURE attribute conflicts with INTENT attribute" }
+    procedure(b),intent(in):: c
   end subroutine foo 
 
 end program
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_9.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_9.f90
new file mode 100644 (file)
index 0000000..22708b8
--- /dev/null
@@ -0,0 +1,18 @@
+! { dg-do compile }
+!
+! PR fortran/36705
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+save :: p
+procedure() :: p
+pointer :: p
+
+contains
+
+subroutine bar(x)
+  procedure(), intent(in) :: x
+  pointer :: x
+end subroutine bar 
+
+end