re PR fortran/20869 (EXTERNAL and INTRINSIC cannot be used together)

2006-01-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/20869
	PR fortran/20875
	PR fortran/25024
	* symbol.c (check_conflict): Add pointer valued elemental
	functions and internal procedures with the external attribute
	to the list of conflicts.
	(gfc_add_attribute): New catch-all function to perform the
	checking of symbol attributes for attribute declaration
	statements.
	* decl.c (attr_decl1): Call gfc_add_attribute for each of -
	(gfc_match_external, gfc_match_intent, gfc_match_intrinsic,
	gfc_match_pointer, gfc_match_dimension, gfc_match_target):
	Remove spurious calls to checks in symbol.c.  Set the
	attribute directly and use the call to attr_decl() for
	checking.
	* gfortran.h:  Add prototype for gfc_add_attribute.

	PR fortran/25785
	* resolve.c (resolve_function): Exclude PRESENT from assumed size
	argument checking. Replace strcmp's with comparisons with generic
	codes.

2006-01-18  Paul Thomas  <pault@gcc.gnu.org>
	    Steven G. Kargl  <kargls@comcast.net>

	PR fortran/20869
	* gfortran.dg/intrinsic_external_1.f90: New test.

	PR fortran/20875.
	* gfortran.dg/elemental_pointer_1.f90: New test.

	PR fortran/25024
	* gfortran.dg/external_procedures_1.f90: New test.

	PR fortran/25785
	gfortran.dg/assumed_present.f90: New test.

Co-Authored-By: Steven G. Kargl <kargls@comcast.net>

From-SVN: r109899

5 files changed, 63 insertions, 12 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 84e2505..1592d8b 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,27 @@
+2006-01-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/20869
+	PR fortran/20875
+	PR fortran/25024
+	* symbol.c (check_conflict): Add pointer valued elemental
+	functions and internal procedures with the external attribute
+	to the list of conflicts.
+	(gfc_add_attribute): New catch-all function to perform the
+	checking of symbol attributes for attribute declaration
+	statements.
+	* decl.c (attr_decl1): Call gfc_add_attribute for each of -
+	(gfc_match_external, gfc_match_intent, gfc_match_intrinsic,
+	gfc_match_pointer, gfc_match_dimension, gfc_match_target):
+	Remove spurious calls to checks in symbol.c.  Set the
+	attribute directly and use the call to attr_decl() for
+	checking.
+	* gfortran.h:  Add prototype for gfc_add_attribute.
+
+	PR fortran/25785
+	* resolve.c (resolve_function): Exclude PRESENT from assumed size
+	argument checking. Replace strcmp's with comparisons with generic
+	codes.
+
 2006-01-16  Rafael Ávila de Espíndola  <rafael.espindola@gmail.com>
 
 	* gfortranspec.c (lang_specific_spec_functions): Remove.
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 1d20a0d..91e5820 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -3154,6 +3154,12 @@ attr_decl1 (void)
 	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_match_external (void)
 {
 
   gfc_clear_attr (&current_attr);
-  gfc_add_external (&current_attr, NULL);
+  current_attr.external = 1;
 
   return attr_decl ();
 }
@@ -3378,7 +3384,7 @@ gfc_match_intent (void)
     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_match_intrinsic (void)
 {
 
   gfc_clear_attr (&current_attr);
-  gfc_add_intrinsic (&current_attr, NULL);
+  current_attr.intrinsic = 1;
 
   return attr_decl ();
 }
@@ -3400,7 +3406,7 @@ gfc_match_optional (void)
 {
 
   gfc_clear_attr (&current_attr);
-  gfc_add_optional (&current_attr, NULL);
+  current_attr.optional = 1;
 
   return attr_decl ();
 }
@@ -3423,7 +3429,7 @@ gfc_match_pointer (void)
   else
     {
       gfc_clear_attr (&current_attr);
-      gfc_add_pointer (&current_attr, NULL);
+      current_attr.pointer = 1;
     
       return attr_decl ();
     }
@@ -3435,7 +3441,7 @@ gfc_match_allocatable (void)
 {
 
   gfc_clear_attr (&current_attr);
-  gfc_add_allocatable (&current_attr, NULL);
+  current_attr.allocatable = 1;
 
   return attr_decl ();
 }
@@ -3446,7 +3452,7 @@ gfc_match_dimension (void)
 {
 
   gfc_clear_attr (&current_attr);
-  gfc_add_dimension (&current_attr, NULL, NULL);
+  current_attr.dimension = 1;
 
   return attr_decl ();
 }
@@ -3457,7 +3463,7 @@ gfc_match_target (void)
 {
 
   gfc_clear_attr (&current_attr);
-  gfc_add_target (&current_attr, NULL);
+  current_attr.target = 1;
 
   return attr_decl ();
 }
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 2f1ddf1..66db8d8 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1700,6 +1700,7 @@ void gfc_get_component_attr (symbol_attribute *, gfc_component *);
 
 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 *);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 1169842..f51fcf8 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1235,16 +1235,17 @@ resolve_function (gfc_expr * expr)
     }
 
   else if (expr->value.function.actual != NULL
-      && expr->value.function.isym != NULL
-      && strcmp (expr->value.function.isym->name, "lbound"))
+	     && expr->value.function.isym != NULL
+	     && expr->value.function.isym->generic_id != GFC_ISYM_LBOUND
+	     && expr->value.function.isym->generic_id != GFC_ISYM_PRESENT)
     {
       /* Array instrinsics must also have the last upper bound of an
 	 asumed size array argument.  UBOUND and SIZE have to be
 	 excluded from the check if the second argument is anything
 	 than a constant.  */
       int inquiry;
-      inquiry = strcmp (expr->value.function.isym->name, "ubound") == 0
-		  || strcmp (expr->value.function.isym->name, "size") == 0;
+      inquiry = expr->value.function.isym->generic_id == GFC_ISYM_UBOUND
+		  || expr->value.function.isym->generic_id == GFC_ISYM_SIZE;
 	    
       for (arg = expr->value.function.actual; arg; arg = arg->next)
 	{
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 6eec853..c3e15f2 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -311,11 +311,20 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
   conf (pointer, target);
   conf (pointer, external);
   conf (pointer, intrinsic);
+  conf (pointer, elemental);
+
   conf (target, external);
   conf (target, intrinsic);
   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 +594,16 @@ duplicate_attr (const char *attr, locus * where)
 
 
 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)
 {