aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJanus Weil <janus@gcc.gnu.org>2011-08-14 09:37:25 +0000
committerJanus Weil <janus@gcc.gnu.org>2011-08-14 09:37:25 +0000
commit5684bdd82875262c9835dff7754a1958b07f3b9b (patch)
tree1e9dc32daee9818eb7ad634080d221d442ceaf43
parent68c794f2de025f5ddc2ccfff88a005d44d5f4acc (diff)
2011-08-14 Janus Weil <janus@gcc.gnu.org>
PR fortran/50073 * decl.c (check_function_name): New function, separated off from 'variable_decl' and slightly extended. (variable_decl,attr_decl1): Call it. 2011-08-14 Janus Weil <janus@gcc.gnu.org> PR fortran/50073 * gfortran.dg/func_result_7.f90: New. git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@177745 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r--gcc/fortran/ChangeLog7
-rw-r--r--gcc/fortran/decl.c42
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/func_result_7.f9011
4 files changed, 55 insertions, 10 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2ead4fadebb..780eee57689 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2011-08-14 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/50073
+ * decl.c (check_function_name): New function, separated off from
+ 'variable_decl' and slightly extended.
+ (variable_decl,attr_decl1): Call it.
+
2011-08-08 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
* Make-lang.in (gfortran$(exeext)): Add $(EXTRA_GCC_LIBS).
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 661bb14486f..18e2651c81d 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1729,6 +1729,30 @@ match_pointer_init (gfc_expr **init, int procptr)
}
+static gfc_try
+check_function_name (char *name)
+{
+ /* In functions that have a RESULT variable defined, the function name always
+ refers to function calls. Therefore, the name is not allowed to appear in
+ specification statements. When checking this, be careful about
+ 'hidden' procedure pointer results ('ppr@'). */
+
+ if (gfc_current_state () == COMP_FUNCTION)
+ {
+ gfc_symbol *block = gfc_current_block ();
+ if (block && block->result && block->result != block
+ && strcmp (block->result->name, "ppr@") != 0
+ && strcmp (block->name, name) == 0)
+ {
+ gfc_error ("Function name '%s' not allowed at %C", name);
+ return FAILURE;
+ }
+ }
+
+ return SUCCESS;
+}
+
+
/* Match a variable name with an optional initializer. When this
subroutine is called, a variable is expected to be parsed next.
Depending on what is happening at the moment, updates either the
@@ -1935,17 +1959,9 @@ variable_decl (int elem)
goto cleanup;
}
}
-
- /* In functions that have a RESULT variable defined, the function
- name always refers to function calls. Therefore, the name is
- not allowed to appear in specification statements. */
- if (gfc_current_state () == COMP_FUNCTION
- && gfc_current_block () != NULL
- && gfc_current_block ()->result != NULL
- && gfc_current_block ()->result != gfc_current_block ()
- && strcmp (gfc_current_block ()->name, name) == 0)
+
+ if (check_function_name (name) == FAILURE)
{
- gfc_error ("Function name '%s' not allowed at %C", name);
m = MATCH_ERROR;
goto cleanup;
}
@@ -5995,6 +6011,12 @@ attr_decl1 (void)
if (find_special (name, &sym, false))
return MATCH_ERROR;
+ if (check_function_name (name) == FAILURE)
+ {
+ m = MATCH_ERROR;
+ goto cleanup;
+ }
+
var_locus = gfc_current_locus;
/* Deal with possible array specification for certain attributes. */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a14be3d00d4..c85c4baa822 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2011-08-14 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/50073
+ * gfortran.dg/func_result_7.f90: New.
+
2011-08-13 Jason Merrill <jason@redhat.com>
PR c++/50075
diff --git a/gcc/testsuite/gfortran.dg/func_result_7.f90 b/gcc/testsuite/gfortran.dg/func_result_7.f90
new file mode 100644
index 00000000000..9a982f1e6fd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_result_7.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! PR 50073: gfortran must not accept function name when result name is present
+!
+! Contributed by Vittorio Zecca <zeccav@gmail.com>
+
+function fun() result(f)
+ pointer fun ! { dg-error "not allowed" }
+ dimension fun(1) ! { dg-error "not allowed" }
+ f=0
+end