This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, Fortran] PR34262 - Fix MVBITS with arrays
- From: Tobias Burnus <burnus at net-b dot de>
- To: gcc-patches <gcc-patches at gcc dot gnu dot org>, "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>
- Date: Wed, 28 Nov 2007 21:03:41 +0100
- Subject: [Patch, Fortran] PR34262 - Fix MVBITS with arrays
:ADDPATCH fortran:
MVBITS is an elemental function, but trans-*.c regarded it as normal,
non-elemental function, which gave wrong results with arrays.
The reason is that the function symbol was created as follows:
/* TO and FROM are guaranteed to have the same kind parameter. */
name = gfc_get_string (PREFIX ("mvbits_i%d"),
c->ext.actual->expr->ts.kind);
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
I added now an argument to gfc_get_intrinsic_sub_symbol to set
optionally the elemental attribute.
I find my method rather clumsy. Has someone a better idea? If not, OK
for the trunk?
(Build and regression tested on x86-64.)
Tobias
2007-11-28 Tobias Burnus <burnus@net-b.de>
PR fortran/34262
* gfortran.h: Add argument to gfc_intrinsic_sub_interface.
* intrinsic.c (gfc_get_intrinsic_sub_symbol): Add elemental argument.
(gfc_intrinsic_sub_interface): Use it.
* iresolve.c (is_elemental_subroutine): Add.
(gfc_resolve_chdir_sub, gfc_resolve_chmod_sub, gfc_resolve_alarm_sub,
gfc_resolve_cpu_time, gfc_resolve_mvbits, gfc_resolve_random_number,
gfc_resolve_random_seed, gfc_resolve_rename_sub, gfc_resolve_kill_sub,
gfc_resolve_link_sub, gfc_resolve_symlnk_sub, gfc_resolve_etime_sub,
gfc_resolve_itime, gfc_resolve_idate, gfc_resolve_ltime,
gfc_resolve_gmtime, gfc_resolve_second_sub, gfc_resolve_sleep_sub,
gfc_resolve_srand, gfc_resolve_getarg, gfc_resolve_getcwd_sub,
gfc_resolve_get_command, gfc_resolve_get_command_argument,
gfc_resolve_get_environment_variable, gfc_resolve_signal_sub,
gfc_resolve_system_sub, gfc_resolve_system_clock, gfc_resolve_exit,
gfc_resolve_flush, gfc_resolve_free, gfc_resolve_ctime_sub,
gfc_resolve_hostnm_sub, gfc_resolve_stat_sub,
gfc_resolve_lstat_sub, gfc_resolve_fstat_sub, gfc_resolve_fgetc_sub,
gfc_resolve_fget_sub, gfc_resolve_fputc_sub, gfc_resolve_fput_sub,
gfc_resolve_fseek_sub, gfc_resolve_ftell_sub, gfc_resolve_ttynam_sub,
gfc_resolve_umask_sub, gfc_resolve_unlink_sub): Use
is_elemental_subroutine for gfc_get_intrinsic_sub_symbol.
2007-11-28 Tobias Burnus <burnus@net-b.de>
PR fortran/34262
* gfortran.dg/mvbits_3.f90: New.
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (Revision 130490)
+++ gcc/fortran/gfortran.h (Arbeitskopie)
@@ -2164,7 +2164,7 @@ void gfc_intrinsic_init_1 (void);
void gfc_intrinsic_done_1 (void);
char gfc_type_letter (bt);
-gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *);
+gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *, int);
try gfc_convert_type (gfc_expr *, gfc_typespec *, int);
try gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int);
int gfc_generic_intrinsic (const char *);
Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c (Revision 130490)
+++ gcc/fortran/intrinsic.c (Arbeitskopie)
@@ -99,13 +99,14 @@ gfc_type_letter (bt type)
/* Get a symbol for a resolved name. */
gfc_symbol *
-gfc_get_intrinsic_sub_symbol (const char *name)
+gfc_get_intrinsic_sub_symbol (const char *name, int elemental)
{
gfc_symbol *sym;
gfc_get_symbol (name, gfc_intrinsic_namespace, &sym);
sym->attr.always_explicit = 1;
sym->attr.subroutine = 1;
+ sym->attr.elemental = elemental;
sym->attr.flavor = FL_PROCEDURE;
sym->attr.proc = PROC_INTRINSIC;
@@ -3501,7 +3502,8 @@ gfc_intrinsic_sub_interface (gfc_code *c
if (isym->resolve.s1 != NULL)
isym->resolve.s1 (c);
else
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name,
+ isym->elemental);
if (gfc_pure (NULL) && !isym->elemental)
{
Index: gcc/fortran/iresolve.c
===================================================================
--- gcc/fortran/iresolve.c (Revision 130490)
+++ gcc/fortran/iresolve.c (Arbeitskopie)
@@ -34,6 +34,18 @@ along with GCC; see the file COPYING3.
#include "gfortran.h"
#include "intrinsic.h"
+
+int is_elemental_subroutine (const char *name);
+
+int
+is_elemental_subroutine (const char *name)
+{
+ gfc_intrinsic_sym *isym;
+ isym = gfc_find_subroutine (name);
+ gcc_assert (isym);
+ return isym->elemental;
+}
+
/* Given printf-like arguments, return a stable version of the result string.
We already have a working, optimized string hashing table in the form of
@@ -422,7 +434,8 @@ gfc_resolve_chdir_sub (gfc_code *c)
kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX ("chdir_i%d_sub"), kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("chdir"));
}
@@ -448,7 +461,8 @@ gfc_resolve_chmod_sub (gfc_code *c)
kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX ("chmod_i%d_sub"), kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("chmod"));
}
@@ -2548,7 +2562,8 @@ gfc_resolve_alarm_sub (gfc_code *c)
if (seconds->ts.kind != gfc_c_int_kind)
gfc_convert_type (seconds, &ts, 2);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("alarm"));
}
void
@@ -2556,7 +2571,8 @@ gfc_resolve_cpu_time (gfc_code *c)
{
const char *name;
name = gfc_get_string (PREFIX ("cpu_time_%d"), c->ext.actual->expr->ts.kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("cpu_time"));
}
@@ -2580,7 +2596,8 @@ gfc_resolve_mvbits (gfc_code *c)
/* TO and FROM are guaranteed to have the same kind parameter. */
name = gfc_get_string (PREFIX ("mvbits_i%d"),
c->ext.actual->expr->ts.kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("mvbits"));
}
@@ -2596,7 +2613,8 @@ gfc_resolve_random_number (gfc_code *c)
else
name = gfc_get_string (PREFIX ("arandom_r%d"), kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("random_number"));
}
@@ -2606,7 +2624,8 @@ gfc_resolve_random_seed (gfc_code *c)
const char *name;
name = gfc_get_string (PREFIX ("random_seed_i%d"), gfc_default_integer_kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("random_seed"));
}
@@ -2622,7 +2641,8 @@ gfc_resolve_rename_sub (gfc_code *c)
kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX ("rename_i%d_sub"), kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("rename"));
}
@@ -2638,7 +2658,8 @@ gfc_resolve_kill_sub (gfc_code *c)
kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX ("kill_i%d_sub"), kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("kill"));
}
@@ -2654,7 +2675,8 @@ gfc_resolve_link_sub (gfc_code *c)
kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX ("link_i%d_sub"), kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("link"));
}
@@ -2670,7 +2692,8 @@ gfc_resolve_symlnk_sub (gfc_code *c)
kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX ("symlnk_i%d_sub"), kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("symlnk"));
}
@@ -2681,7 +2704,8 @@ gfc_resolve_etime_sub (gfc_code *c)
{
const char *name;
name = gfc_get_string (PREFIX ("etime_sub"));
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("etime"));
}
@@ -2692,7 +2716,8 @@ gfc_resolve_itime (gfc_code *c)
{
c->resolved_sym
= gfc_get_intrinsic_sub_symbol (gfc_get_string (PREFIX ("itime_i%d"),
- gfc_default_integer_kind));
+ gfc_default_integer_kind),
+ is_elemental_subroutine ("itime"));
}
void
@@ -2700,7 +2725,8 @@ gfc_resolve_idate (gfc_code *c)
{
c->resolved_sym
= gfc_get_intrinsic_sub_symbol (gfc_get_string (PREFIX ("idate_i%d"),
- gfc_default_integer_kind));
+ gfc_default_integer_kind),
+ is_elemental_subroutine ("idate"));
}
void
@@ -2708,7 +2734,8 @@ gfc_resolve_ltime (gfc_code *c)
{
c->resolved_sym
= gfc_get_intrinsic_sub_symbol (gfc_get_string (PREFIX ("ltime_i%d"),
- gfc_default_integer_kind));
+ gfc_default_integer_kind),
+ is_elemental_subroutine ("ltime"));
}
void
@@ -2716,7 +2743,8 @@ gfc_resolve_gmtime (gfc_code *c)
{
c->resolved_sym
= gfc_get_intrinsic_sub_symbol (gfc_get_string (PREFIX ("gmtime_i%d"),
- gfc_default_integer_kind));
+ gfc_default_integer_kind),
+ is_elemental_subroutine ("gmtime"));
}
@@ -2727,7 +2755,8 @@ gfc_resolve_second_sub (gfc_code *c)
{
const char *name;
name = gfc_get_string (PREFIX ("second_sub"));
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("second"));
}
@@ -2743,7 +2772,8 @@ gfc_resolve_sleep_sub (gfc_code *c)
kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX ("sleep_i%d_sub"), kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("sleep"));
}
@@ -2754,7 +2784,8 @@ gfc_resolve_srand (gfc_code *c)
{
const char *name;
name = gfc_get_string (PREFIX ("srand"));
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("srand"));
}
@@ -2776,7 +2807,8 @@ gfc_resolve_getarg (gfc_code *c)
}
name = gfc_get_string (PREFIX ("getarg_i%d"), gfc_default_integer_kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("getarg"));
}
@@ -2794,7 +2826,8 @@ gfc_resolve_getcwd_sub (gfc_code *c)
kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX ("getcwd_i%d_sub"), kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("getcwd"));
}
@@ -2807,7 +2840,8 @@ gfc_resolve_get_command (gfc_code *c)
int kind;
kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX ("get_command_i%d"), kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("get_command"));
}
@@ -2820,7 +2854,8 @@ gfc_resolve_get_command_argument (gfc_co
int kind;
kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX ("get_command_argument_i%d"), kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("get_command_argument"));
}
@@ -2833,7 +2868,8 @@ gfc_resolve_get_environment_variable (gf
int kind;
kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX ("get_environment_variable_i%d"), kind);
- code->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ code->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("get_environment_variable"));
}
@@ -2865,7 +2901,8 @@ gfc_resolve_signal_sub (gfc_code *c)
if (status != NULL && status->ts.kind != gfc_c_int_kind)
gfc_convert_type (status, &ts, 2);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("signal"));
}
@@ -2876,7 +2913,8 @@ gfc_resolve_system_sub (gfc_code *c)
{
const char *name;
name = gfc_get_string (PREFIX ("system_sub"));
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("system"));
}
@@ -2898,7 +2936,8 @@ gfc_resolve_system_clock (gfc_code *c)
kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX ("system_clock_%d"), kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("system_clock"));
}
@@ -2920,7 +2959,8 @@ gfc_resolve_exit (gfc_code *c)
gfc_convert_type (n, &ts, 2);
name = gfc_get_string (PREFIX ("exit_i%d"), ts.kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("exit"));
}
@@ -2940,7 +2980,8 @@ gfc_resolve_flush (gfc_code *c)
gfc_convert_type (n, &ts, 2);
name = gfc_get_string (PREFIX ("flush_i%d"), ts.kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("flush"));
}
@@ -2956,7 +2997,8 @@ gfc_resolve_free (gfc_code *c)
if (n->ts.kind != ts.kind)
gfc_convert_type (n, &ts, 2);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("free"));
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("free"),
+ is_elemental_subroutine ("free"));
}
@@ -2975,28 +3017,32 @@ gfc_resolve_ctime_sub (gfc_code *c)
gfc_convert_type (c->ext.actual->expr, &ts, 2);
}
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("ctime_sub"));
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("ctime_sub"),
+ is_elemental_subroutine ("ctime"));
}
void
gfc_resolve_fdate_sub (gfc_code *c)
{
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("fdate_sub"));
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("fdate_sub"),
+ is_elemental_subroutine ("fdate"));
}
void
gfc_resolve_gerror (gfc_code *c)
{
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("gerror"));
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("gerror"),
+ is_elemental_subroutine ("gerror"));
}
void
gfc_resolve_getlog (gfc_code *c)
{
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("getlog"));
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("getlog"),
+ is_elemental_subroutine ("getlog"));
}
@@ -3012,14 +3058,16 @@ gfc_resolve_hostnm_sub (gfc_code *c)
kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX ("hostnm_i%d_sub"), kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("hostnm"));
}
void
gfc_resolve_perror (gfc_code *c)
{
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("perror_sub"));
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("perror_sub"),
+ is_elemental_subroutine ("perror"));
}
/* Resolve the STAT and FSTAT intrinsic subroutines. */
@@ -3029,7 +3077,8 @@ gfc_resolve_stat_sub (gfc_code *c)
{
const char *name;
name = gfc_get_string (PREFIX ("stat_i%d_sub"), gfc_default_integer_kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("stat"));
}
@@ -3038,7 +3087,8 @@ gfc_resolve_lstat_sub (gfc_code *c)
{
const char *name;
name = gfc_get_string (PREFIX ("lstat_i%d_sub"), gfc_default_integer_kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("lstat"));
}
@@ -3054,7 +3104,8 @@ gfc_resolve_fstat_sub (gfc_code *c)
if (u->ts.kind != ts->kind)
gfc_convert_type (u, ts, 2);
name = gfc_get_string (PREFIX ("fstat_i%d_sub"), ts->kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("fstat"));
}
@@ -3082,7 +3133,8 @@ gfc_resolve_fgetc_sub (gfc_code *c)
else
name = gfc_get_string (PREFIX ("fgetc_i%d_sub"), gfc_default_integer_kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("fgetc"));
}
@@ -3098,7 +3150,8 @@ gfc_resolve_fget_sub (gfc_code *c)
else
name = gfc_get_string (PREFIX ("fget_i%d_sub"), gfc_default_integer_kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("fget"));
}
@@ -3126,7 +3179,8 @@ gfc_resolve_fputc_sub (gfc_code *c)
else
name = gfc_get_string (PREFIX ("fputc_i%d_sub"), gfc_default_integer_kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("fputc"));
}
@@ -3142,7 +3196,8 @@ gfc_resolve_fput_sub (gfc_code *c)
else
name = gfc_get_string (PREFIX ("fput_i%d_sub"), gfc_default_integer_kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("fput"));
}
@@ -3187,7 +3242,8 @@ gfc_resolve_fseek_sub (gfc_code *c)
gfc_convert_type (whence, &ts, 2);
}
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("fseek_sub"));
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("fseek_sub"),
+ is_elemental_subroutine ("fseek"));
}
void
@@ -3211,7 +3267,8 @@ gfc_resolve_ftell_sub (gfc_code *c)
}
name = gfc_get_string (PREFIX ("ftell_i%d_sub"), offset->ts.kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("ftell"));
}
@@ -3229,7 +3286,8 @@ gfc_resolve_ttynam_sub (gfc_code *c)
gfc_convert_type (c->ext.actual->expr, &ts, 2);
}
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("ttynam_sub"));
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("ttynam_sub"),
+ is_elemental_subroutine ("ttynam"));
}
@@ -3247,7 +3305,8 @@ gfc_resolve_umask_sub (gfc_code *c)
kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX ("umask_i%d_sub"), kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("umask"));
}
/* Resolve the UNLINK intrinsic subroutine. */
@@ -3264,5 +3323,6 @@ gfc_resolve_unlink_sub (gfc_code *c)
kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX ("unlink_i%d_sub"), kind);
- c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name,
+ is_elemental_subroutine ("unlink"));
}
Index: gcc/testsuite/gfortran.dg/mvbits_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/mvbits_3.f90 (Revision 0)
+++ gcc/testsuite/gfortran.dg/mvbits_3.f90 (Revision 0)
@@ -0,0 +1,31 @@
+! { dg-do run }
+!
+! PR fortran/
+!
+! The trans-*.c part of the compiler did no know
+! that mvbits is an elemental function.
+!
+! Test case contributed by P.H. Lundow.
+!
+program main
+ implicit none
+ integer :: a( 2 ), b( 2 )
+ integer :: x, y
+
+ a = 1
+ b = 0
+ x = 1
+ y = 0
+
+ call mvbits (a, 0, 1, b, 1)
+ call mvbits (x, 0, 1, y, 1)
+
+! write (*, *) 'a: ', a
+! write (*, *) 'x: ', x
+! write (*, *)
+! write (*, *) 'b: ', b
+! write (*, *) 'y: ', y
+! write (*, *)
+
+ if ( any (b /= y) ) call abort()
+end program main