diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.c | 40 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.h | 1 | ||||
| -rw-r--r-- | gcc/fortran/iresolve.c | 14 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 3 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90 | 10 |
6 files changed, 40 insertions, 36 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 204e8eb..c0b6d15 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -4,6 +4,14 @@ * iresolve.c (gfc_resolve_pack): Choose function depending if mask is scalar. + PR fortran/17631 + * intrinsic.c (add_sym_5): Remove. + (add_subroutines): Add resolution function for MVBITS. + * intrinsic.h (gfc_resolve_mvbits): Declare resolution function for + MVBITS + * iresolve.c (gfc_resolve_mvbits): New function. + (gfc_resolve_random_number): Remove empty line at end of function. + 2004-10-04 Erik Schnetter <schnetter@aei.mpg.de> * scanner.c (preprocessor_line): Accept preprocessor lines without diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 949f399..2875321 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -600,35 +600,6 @@ static void add_sym_4s (const char *name, int elemental, int actual_ok, } -static void add_sym_5 (const char *name, int elemental, int actual_ok, bt type, - int kind, - try (*check)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *), - gfc_expr *(*simplify)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *), - void (*resolve)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *), - const char* a1, bt type1, int kind1, int optional1, - const char* a2, bt type2, int kind2, int optional2, - const char* a3, bt type3, int kind3, int optional3, - const char* a4, bt type4, int kind4, int optional4, - const char* a5, bt type5, int kind5, int optional5 - ) { - gfc_check_f cf; - gfc_simplify_f sf; - gfc_resolve_f rf; - - cf.f5 = check; - sf.f5 = simplify; - rf.f5 = resolve; - - add_sym (name, elemental, actual_ok, type, kind, cf, sf, rf, - a1, type1, kind1, optional1, - a2, type2, kind2, optional2, - a3, type3, kind3, optional3, - a4, type4, kind4, optional4, - a5, type5, kind5, optional5, - (void*)0); -} - - static void add_sym_5s ( const char *name, int elemental, int actual_ok, bt type, int kind, @@ -1960,12 +1931,11 @@ add_subroutines (void) trim_name, BT_LOGICAL, dl, 1); - /* This needs changing to add_sym_5s if it gets a resolution function. */ - add_sym_5 ("mvbits", 1, 1, BT_UNKNOWN, 0, - gfc_check_mvbits, gfc_simplify_mvbits, NULL, - f, BT_INTEGER, di, 0, fp, BT_INTEGER, di, 0, - ln, BT_INTEGER, di, 0, t, BT_INTEGER, di, 0, - tp, BT_INTEGER, di, 0); + add_sym_5s ("mvbits", 1, 1, BT_UNKNOWN, 0, + gfc_check_mvbits, gfc_simplify_mvbits, gfc_resolve_mvbits, + f, BT_INTEGER, di, 0, fp, BT_INTEGER, di, 0, + ln, BT_INTEGER, di, 0, t, BT_INTEGER, di, 0, + tp, BT_INTEGER, di, 0); add_sym_1s ("random_number", 0, 1, BT_UNKNOWN, 0, gfc_check_random_number, NULL, gfc_resolve_random_number, diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 839f750..ec68828 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -323,6 +323,7 @@ void gfc_resolve_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); /* Intrinsic subroutine resolution. */ void gfc_resolve_cpu_time (gfc_code *); +void gfc_resolve_mvbits (gfc_code *); void gfc_resolve_system_clock(gfc_code *); void gfc_resolve_random_number (gfc_code *); void gfc_resolve_getarg (gfc_code *); diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 36597fa..9ae912ef7 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -1462,6 +1462,19 @@ gfc_resolve_cpu_time (gfc_code * c ATTRIBUTE_UNUSED) void +gfc_resolve_mvbits (gfc_code * c) +{ + const char *name; + int kind; + + kind = c->ext.actual->expr->ts.kind; + name = gfc_get_string (PREFIX("mvbits_i%d"), kind); + + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); +} + + +void gfc_resolve_random_number (gfc_code * c ATTRIBUTE_UNUSED) { const char *name; @@ -1474,7 +1487,6 @@ gfc_resolve_random_number (gfc_code * c ATTRIBUTE_UNUSED) name = gfc_get_string (PREFIX("arandom_r%d"), kind); c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); - } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0587e7f..6bb5309d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -3,6 +3,9 @@ PR fortran/17283 * gfortran.fortran-torture/execute/intrinsic_pack.f90: Add more tests. + PR fortran/17631 + * gfortran.fortran-torture/execute/intrinsic_mvbits.f90: New test. + 2004-10-04 Chao-ying Fu <fu@mips.com> * gcc.dg/vect/pr16105.c: Enable for mipsisa64*-*-*. diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90 new file mode 100644 index 0000000..8aaaf09 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90 @@ -0,0 +1,10 @@ +! Test the MVBITS intrinsic subroutine +INTEGER*4 :: from, to, result + +DATA from / z'0003FFFC' / +DATA to / z'77760000' / +DATA result / z'7777FFFE' / + +CALL mvbits(from, 2, 16, to, 1) +if (to /= result) CALL abort() +end |