diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 84e250544f6669fe8b4200aeeeec73e8ddc902fb..1592d8b6091261d04b6faac43b8caf371443f0d3 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 1d20a0d1eeeeda1e8c677f90448fa50d48e7660f..91e5820031e59457093e815271381283d271ed70 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 (¤t_attr);
- gfc_add_external (¤t_attr, NULL);
+ current_attr.external = 1;
return attr_decl ();
}
@@ -3378,7 +3384,7 @@ gfc_match_intent (void)
return MATCH_ERROR;
gfc_clear_attr (¤t_attr);
- gfc_add_intent (¤t_attr, intent, NULL); /* Can't fail */
+ current_attr.intent = intent;
return attr_decl ();
}
@@ -3389,7 +3395,7 @@ gfc_match_intrinsic (void)
{
gfc_clear_attr (¤t_attr);
- gfc_add_intrinsic (¤t_attr, NULL);
+ current_attr.intrinsic = 1;
return attr_decl ();
}
@@ -3400,7 +3406,7 @@ gfc_match_optional (void)
{
gfc_clear_attr (¤t_attr);
- gfc_add_optional (¤t_attr, NULL);
+ current_attr.optional = 1;
return attr_decl ();
}
@@ -3423,7 +3429,7 @@ gfc_match_pointer (void)
else
{
gfc_clear_attr (¤t_attr);
- gfc_add_pointer (¤t_attr, NULL);
+ current_attr.pointer = 1;
return attr_decl ();
}
@@ -3435,7 +3441,7 @@ gfc_match_allocatable (void)
{
gfc_clear_attr (¤t_attr);
- gfc_add_allocatable (¤t_attr, NULL);
+ current_attr.allocatable = 1;
return attr_decl ();
}
@@ -3446,7 +3452,7 @@ gfc_match_dimension (void)
{
gfc_clear_attr (¤t_attr);
- gfc_add_dimension (¤t_attr, NULL, NULL);
+ current_attr.dimension = 1;
return attr_decl ();
}
@@ -3457,7 +3463,7 @@ gfc_match_target (void)
{
gfc_clear_attr (¤t_attr);
- gfc_add_target (¤t_attr, NULL);
+ current_attr.target = 1;
return attr_decl ();
}
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 2f1ddf14f196af1fd8d8c7454bdac9dcbe04a2fc..66db8d804f12b9001bea98333df622c83ab56996 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 1169842a5711f780fcd57874e3b16b6f08892e06..f51fcf8bcc4b93bb0f9a1d4dad22adc85be0c1b9 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 6eec85308ec3a09d0bf29735eb3e3a28c5ced6b6..c3e15f2d1dd945a1c401ab71804a2836f521f026 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. */
@@ -584,6 +593,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)
{
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 61145bc640d65db113332000931555aebe65166f..81f21e490586c82667b6e3e2cb8c609c16d73563 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,18 @@
+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.
+
2006-01-18 Jakub Jelinek <jakub@redhat.com>
* g++.dg/parse/lookup5.C: New test.
diff --git a/gcc/testsuite/gfortran.dg/assumed_present.f90 b/gcc/testsuite/gfortran.dg/assumed_present.f90
new file mode 100644
index 0000000000000000000000000000000000000000..dd9f85ca88fe0e9804275e2ecc7b6859bf00e0d1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_present.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! This tests the fix for the regression PR25785, where line 7 started
+! generating an assumed size error.
+! Contributed by Dale Ranta <dir@lanl.gov>
+ subroutine my_sio_file_write_common(data_c1)
+ character, intent(in), optional :: data_c1(*)
+ if (present(data_c1)) then
+ endif
+ end subroutine my_sio_file_write_common
diff --git a/gcc/testsuite/gfortran.dg/elemental_pointer_1.f90 b/gcc/testsuite/gfortran.dg/elemental_pointer_1.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b5d99611c78fa7aa33b0a85b312d4121e67ee1b8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_pointer_1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! Tests the fix for pr20875.
+! Note 12.7.1 "For a function, the result shall be scalar and shall not have the POINTER attribute."
+MODULE Test
+CONTAINS
+ ELEMENTAL FUNCTION LL(I)
+ INTEGER, INTENT(IN) :: I
+ INTEGER :: LL
+ POINTER :: LL ! { dg-error " POINTER attribute conflicts with ELEMENTAL attribute" }
+ END FUNCTION LL
+END MODULE Test
diff --git a/gcc/testsuite/gfortran.dg/external_procedures_1.f90 b/gcc/testsuite/gfortran.dg/external_procedures_1.f90
new file mode 100644
index 0000000000000000000000000000000000000000..95d0212353e6cddb08bda7ab02c741c7aa6dc28f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/external_procedures_1.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+! This tests the patch for PR25024.
+
+! PR25024 - The external attribute for subroutine a would cause an ICE.
+ subroutine A ()
+ EXTERNAL A ! { dg-error "EXTERNAL attribute conflicts with SUBROUTINE" }
+ END
+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 ! OK no conflict
+ ext1 = y * y
+end function ext1
+
+program main
+ real ext, inval
+ external ext ! OK, valid external reference.
+ 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
+
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_external_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_external_1.f90
new file mode 100644
index 0000000000000000000000000000000000000000..7d590126f527bbc562cdb2e03b967c60a06190e4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_external_1.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! PR fortran/20869
+! Note 12.11 "A name shall not appear in both an EXTERNAL and an
+! INTRINSIC statement in the same scoping unit.
+program u
+ intrinsic :: nint
+ external :: nint ! { dg-error "EXTERNAL attribute conflicts with INTRINSIC attribute" }
+end program u