diff options
| author | bstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-07-08 16:18:49 +0000 |
|---|---|---|
| committer | bstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-07-08 16:18:49 +0000 |
| commit | 71fd77c9b4b3398097c48d6c1d3be7296d670f89 (patch) | |
| tree | ca77b69e8b4f032f1066c6a31847233f9db7f8e5 /gcc/fortran/primary.c | |
| parent | 313793ac30b7208dfb273ab1823bed6b0c20deb4 (diff) | |
| download | gcc-71fd77c9b4b3398097c48d6c1d3be7296d670f89.tar.gz | |
2008-07-08 Basile Starynkevitch <basile@starynkevitch.net>
MELT branch merged with trunk r137620
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@137632 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran/primary.c')
| -rw-r--r-- | gcc/fortran/primary.c | 27 |
1 files changed, 27 insertions, 0 deletions
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index d7236e1be01..c67f2bd1873 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -2323,6 +2323,9 @@ gfc_match_rvalue (gfc_expr **result) } } + if (gfc_matching_procptr_assignment) + goto procptr0; + if (sym->attr.function || sym->attr.external || sym->attr.intrinsic) goto function0; @@ -2399,6 +2402,27 @@ gfc_match_rvalue (gfc_expr **result) /* If we're here, then the name is known to be the name of a procedure, yet it is not sure to be the name of a function. */ case FL_PROCEDURE: + + /* Procedure Pointer Assignments. */ + procptr0: + if (gfc_matching_procptr_assignment) + { + gfc_gobble_whitespace (); + if (sym->attr.function && gfc_peek_ascii_char () == '(') + /* Parse functions returning a procptr. */ + goto function0; + + if (sym->attr.flavor == FL_UNKNOWN) sym->attr.flavor = FL_PROCEDURE; + if (gfc_intrinsic_name (sym->name, 0) + || gfc_intrinsic_name (sym->name, 1)) + sym->attr.intrinsic = 1; + e = gfc_get_expr (); + e->expr_type = EXPR_VARIABLE; + e->symtree = symtree; + m = match_varspec (e, 0); + break; + } + if (sym->attr.subroutine) { gfc_error ("Unexpected use of subroutine name '%s' at %C", @@ -2780,6 +2804,9 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag) break; } + if (sym->attr.proc_pointer) + break; + /* Fall through to error */ default: |