Re: [PATCH] fortran/20869 -- INTRINSIC and EXTERNAL conflict

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

Steve,

> This patch looks better than mine, and think you can commit it.
> You'll need a ChangeLog entry and of course one or more testcases.
It so happens that I was sensitive to using resolve_symbol for this 
purpose because I had just done so myself, in 
http://gcc.gnu.org/ml/fortran/2006-01/msg00209.html to fix PR25024:

 subroutine A ()    ! { dg-error "cannot be declared EXTERNAL" }
   EXTERNAL A
 END

The enclosed version of the patch fixes this one too; in a much more hygenic fashion.  I will run through the bug database tonight to see if there are any more that it fixes - I am sure that there must be some amongst Joost's PRs.

It regtests OK on Cygwin_NT and FC3.

I will commit it, with the requisite testcases and ChangeLog entries, tomorrow evening or Thursday morning, unless there are any objections.  In the mean time, could you please give it a spin with your testsuite?  I am just a little concerned that I might not have exercised all the conditions where procedures are or are not acceptably declared external.  I think that if_source != 0 and contained != 0 cover them all but......

Take it that the modification to resolve.c and the test for PR25024 have been removed from http://gcc.gnu.org/ml/fortran/2006-01/msg00209.html. 

Best regards

Paul


Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c	(révision 109761)
+++ gcc/fortran/symbol.c	(copie de travail)
@@ -316,6 +316,13 @@
   conf (external, dimension);   /* See Fortran 95's R504.  */
 
   conf (external, intrinsic);
+    
+  if (attr->if_source || attr->contained)
+    {
+      conf (external, subroutine);
+      conf (external, function);
+    }
+
   conf (allocatable, pointer);
   conf (allocatable, dummy);	/* TODO: Allowed in Fortran 200x.  */
   conf (allocatable, function);	/* TODO: Allowed in Fortran 200x.  */
@@ -585,6 +592,16 @@
 
 
 try
+gfc_add_attribute (symbol_attribute * attr, locus * where)
+{
+
+  if (check_used (attr, NULL, where) || check_done (attr, where))
+    return FAILURE;
+
+  return check_conflict (attr, NULL, where);
+}
+
+try
 gfc_add_allocatable (symbol_attribute * attr, locus * where)
 {
 
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(révision 109761)
+++ gcc/fortran/decl.c	(copie de travail)
@@ -3154,6 +3154,12 @@
 	goto cleanup;
     }
 
+  if (gfc_add_attribute (&sym->attr, &var_locus) == FAILURE)
+    {
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
   if ((current_attr.external || current_attr.intrinsic)
       && sym->attr.flavor != FL_PROCEDURE
       && gfc_add_flavor (&sym->attr, FL_PROCEDURE, sym->name, NULL) == FAILURE)
@@ -3361,7 +3367,7 @@
 {
 
   gfc_clear_attr (&current_attr);
-  gfc_add_external (&current_attr, NULL);
+  current_attr.external = 1;
 
   return attr_decl ();
 }
@@ -3378,7 +3384,7 @@
     return MATCH_ERROR;
 
   gfc_clear_attr (&current_attr);
-  gfc_add_intent (&current_attr, intent, NULL);	/* Can't fail */
+  current_attr.intent = intent;
 
   return attr_decl ();
 }
@@ -3389,7 +3395,7 @@
 {
 
   gfc_clear_attr (&current_attr);
-  gfc_add_intrinsic (&current_attr, NULL);
+  current_attr.intrinsic = 1;
 
   return attr_decl ();
 }
@@ -3400,7 +3406,7 @@
 {
 
   gfc_clear_attr (&current_attr);
-  gfc_add_optional (&current_attr, NULL);
+  current_attr.optional = 1;
 
   return attr_decl ();
 }
@@ -3423,7 +3429,7 @@
   else
     {
       gfc_clear_attr (&current_attr);
-      gfc_add_pointer (&current_attr, NULL);
+      current_attr.pointer = 1;
     
       return attr_decl ();
     }
@@ -3435,7 +3441,7 @@
 {
 
   gfc_clear_attr (&current_attr);
-  gfc_add_allocatable (&current_attr, NULL);
+  current_attr.allocatable = 1;
 
   return attr_decl ();
 }
@@ -3446,7 +3452,7 @@
 {
 
   gfc_clear_attr (&current_attr);
-  gfc_add_dimension (&current_attr, NULL, NULL);
+  current_attr.dimension = 1;
 
   return attr_decl ();
 }
@@ -3457,7 +3463,7 @@
 {
 
   gfc_clear_attr (&current_attr);
-  gfc_add_target (&current_attr, NULL);
+  current_attr.target = 1;
 
   return attr_decl ();
 }
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(révision 109761)
+++ gcc/fortran/gfortran.h	(copie de travail)
@@ -1700,6 +1700,7 @@
 
 void gfc_set_sym_referenced (gfc_symbol * sym);
 
+try gfc_add_attribute (symbol_attribute *, locus *);
 try gfc_add_allocatable (symbol_attribute *, locus *);
 try gfc_add_dimension (symbol_attribute *, const char *, locus *);
 try gfc_add_external (symbol_attribute *, locus *);

! { dg-do compile }
! This tests the patch for PRs .....
!
!
function ext (y)
  real ext, y
  external ext  ! { dg-error "EXTERNAL attribute conflicts with FUNCTION" }
  ext = y * y
end function ext

function ext1 (y)
  real ext1, y
  external z
  ext1 = y * y
end function ext1

program main
  real ext, inval
  external ext
  external main  ! { dg-error "PROGRAM attribute conflicts with EXTERNAL" }
  interface
    function ext1 (y)
      real ext1, y
      external ext1  ! { dg-error "EXTERNAL attribute conflicts with FUNCTION" }
    end function ext1
  end interface
  inval = 1.0
  print *, ext(inval)
  print *, ext1(inval)
  print *, inv(inval)
contains
  function inv (y)
    real inv, y
    external inv  ! { dg-error "EXTERNAL attribute conflicts with FUNCTION" }
    inv = y * y * y
  end function inv
end program main

! Lahey gives
!Compiling program unit ext at line 1:
!  1723-S: "SOURCE.F90", line 7, column 12: 'ext' already used as a variable name.
!Compiling program unit ext1 at line 10:
!Compiling program unit main at line 16:
!  1710-S: "SOURCE.F90", line 20, column 12: 'main' already used as a program name.
! Interface body name(ext1)
!  1723-S: "SOURCE.F90", line 24, column 16: 'ext1' already used as a variable name.
! Internal subprogram name(inv)
!  1723-S: "SOURCE.F90", line 34, column 14: 'inv' already used as a variable name.
!Encountered 4 errors, 0 warnings, 0 informations in file SOURCE.F90.
!Compiling file SOURCE.F90.