Tobias Burnus - Re: [Patch, fortran] PR30887 and PR30888 (original) (raw)

This is the mail archive of the gcc-patches@gcc.gnu.orgmailing list for the GCC project.

Re: [Patch, fortran] PR30887 and PR30888 - overdone constraints on %VAL

• From: Tobias Burnus
• Cc: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
• Date: Tue, 27 Feb 2007 16:21:15 +0100
• Subject: Re: [Patch, fortran] PR30887 and PR30888 - overdone constraints on %VAL
• References: <339c37f20702221217m7de1f72fnd5223f0958349443@mail.gmail.com> <45DE05D7.20601@net-b.de>

ping

Fixes:

• %VAL( ) with non-default kinds now supported
• The following program gave a compile-time error:

•  CALL DOIT( %VAL( P ) )

•  CALL DOIT( I )

•  CALL DOIT( %VAL( P ) )

Tobias Burnus wrote:

Paul Thomas wrote:

The attached are completely self explanatory fixes for the above to %VAL problems.

[...] regtested on x86_64-unknown-linux-gnu.

---

2007-02-22 Tobias Burnus burnus@net-b.de Paul Thomas pault@gcc.gnu.org

PR fortran/30888
PR fortran/30887
* resolve.c (resolve_actual_arglist): Allow by-value
arguments and non-default-kind for %VAL().
* trans-expr.c (conv_arglist_function): Allow
non-default-kind for %VAL().

2007-02-22 Tobias Burnus burnus@net-b.de Paul Thomas pault@gcc.gnu.org

PR fortran/30888
PR fortran/30887
* c_by_val_1.f: Test %VAL() with non-default kind.
* c_by_val.c: Ditto.
* c_by_val_4.f: New test.

Index: gcc/testsuite/gfortran.dg/c_by_val_1.f

--- gcc/testsuite/gfortran.dg/c_by_val_1.f (Revision 122226) +++ gcc/testsuite/gfortran.dg/c_by_val_1.f (Arbeitskopie) @@ -4,9 +4,13 @@ program c_by_val_1 external f_to_f, i_to_i, c_to_c + external f_to_f8, i_to_i8, c_to_c8 real a, b, c - integer*4 i, j, k + real(8) a8, b8, c8 + integer(4) i, j, k + integer(8) i8, j8, k8 complex u, v, w, c_to_c + complex(8) u8, v8, w8, c_to_c8 a = 42.0 b = 0.0 @@ -14,18 +18,36 @@ call f_to_f (b, %VAL (a), %REF (c), %LOC (c)) if ((2.0 * a).ne.b) call abort () + a8 = 43.0 + b8 = 1.0 + c8 = a8 + call f_to_f8 (b8, %VAL (a8), %REF (c8), %LOC (c8)) + if ((2.0 * a8).ne.b8) call abort () + i = 99 j = 0 k = i call i_to_i (j, %VAL (i), %REF (k), %LOC (k)) if ((3 * i).ne.j) call abort () + i8 = 199 + j8 = 10 + k8 = i8 + call i_to_i8 (j8, %VAL (i8), %REF (k8), %LOC (k8)) + if ((3 * i8).ne.j8) call abort () + u = (-1.0, 2.0) v = (1.0, -2.0) w = u v = c_to_c (%VAL (u), %REF (w), %LOC (w)) if ((4.0 * u).ne.v) call abort () + u8 = (-1.0, 2.0) + v8 = (1.0, -2.0) + w8 = u8 + v8 = c_to_c8 (%VAL (u8), %REF (w8), %LOC (w8)) + if ((4.0 * u8).ne.v8) call abort () + stop end Index: gcc/testsuite/gfortran.dg/c_by_val_4.f

--- gcc/testsuite/gfortran.dg/c_by_val_4.f (Revision 0) +++ gcc/testsuite/gfortran.dg/c_by_val_4.f (Revision 0) @@ -0,0 +1,17 @@ +C { dg-do compile } +C Tests the fix for PR30888, in which the dummy procedure would +C generate an error with the %VAL argument, even though it is +C declared EXTERNAL. +C +C Contributed by Peter W. Draper p.w.draper@durham.ac.uk +C + SUBROUTINE VALTEST( DOIT ) + EXTERNAL DOIT + INTEGER P + INTEGER I + I = 0 + P = 0 + CALL DOIT( %VAL( P ) ) ! { dg-warning "Extension: argument list function" } + CALL DOIT( I ) + CALL DOIT( %VAL( P ) ) ! { dg-warning "Extension: argument list function" } + END Index: gcc/testsuite/gfortran.dg/c_by_val.c

--- gcc/testsuite/gfortran.dg/c_by_val.c (Revision 122226) +++ gcc/testsuite/gfortran.dg/c_by_val.c (Arbeitskopie) @@ -1,9 +1,13 @@ /* Passing from fortran to C by value, using %VAL. / typedef struct { float r, i; } complex; +typedef struct { double r, i; } complex8; extern void f_to_f__ (float, float, float*, float**); +extern void f_to_f8__ (double*, double, double*, double**); extern void i_to_i__ (int*, int, int*, int**); +extern void i_to_i8__ (long*, long, long*, long**); extern void c_to_c__ (complex*, complex, complex*, complex**); +extern void c_to_c8__ (complex8*, complex8, complex8*, complex8**); extern void abort (void); void @@ -17,6 +21,16 @@ } void +f_to_f8__(double *retval, double a1, double *a2, double **a3) +{ + if ( a1 != *a2 ) abort(); + if ( a1 != **a3 ) abort(); + a1 = 0.0; + *retval = *a2 * 2.0; + return; +} + +void i_to_i__(int *retval, int i1, int *i2, int **i3) { if ( i1 != *i2 ) abort(); @@ -27,6 +41,16 @@ } void +i_to_i8__(long *retval, long i1, long *i2, long **i3) +{ + if ( i1 != *i2 ) abort(); + if ( i1 != **i3 ) abort(); + i1 = 0; + *retval = *i2 * 3; + return; +} + +void c_to_c__(complex *retval, complex c1, complex *c2, complex **c3) { if ( c1.r != c2->r ) abort(); @@ -39,3 +63,17 @@ retval->i = c2->i * 4.0; return; } + +void +c_to_c8__(complex8 *retval, complex8 c1, complex8 *c2, complex8 **c3) +{ + if ( c1.r != c2->r ) abort(); + if ( c1.i != c2->i ) abort(); + if ( c1.r != (*c3)->r ) abort(); + if ( c1.i != (*c3)->i ) abort(); + c1.r = 0.0; + c1.i = 0.0; + retval->r = c2->r * 4.0; + retval->i = c2->i * 4.0; + return; +} Index: gcc/fortran/trans-expr.c

--- gcc/fortran/trans-expr.c (Revision 122226) +++ gcc/fortran/trans-expr.c (Arbeitskopie) @@ -1934,40 +1934,12 @@ static void conv_arglist_function (gfc_se *se, gfc_expr *expr, const char name) { - tree type = NULL_TREE; / Pass by value for g77 %VAL(arg), pass the address indirectly for %LOC, else by reference. Thus %REF is a "do-nothing" and %LOC is the same as an F95 pointer. / if (strncmp (name, "%VAL", 4) == 0) - { - gfc_conv_expr (se, expr); - / %VAL converts argument to default kind. / - switch (expr->ts.type) - { - case BT_REAL: - type = gfc_get_real_type (gfc_default_real_kind); - se->expr = fold_convert (type, se->expr); - break; - case BT_COMPLEX: - type = gfc_get_complex_type (gfc_default_complex_kind); - se->expr = fold_convert (type, se->expr); - break; - case BT_INTEGER: - type = gfc_get_int_type (gfc_default_integer_kind); - se->expr = fold_convert (type, se->expr); - break; - case BT_LOGICAL: - type = gfc_get_logical_type (gfc_default_logical_kind); - se->expr = fold_convert (type, se->expr); - break; - / This should have been resolved away. */ - case BT_UNKNOWN: case BT_CHARACTER: case BT_DERIVED: - case BT_PROCEDURE: case BT_HOLLERITH: - gfc_internal_error ("Bad type in conv_arglist_function"); - } -
- } + gfc_conv_expr (se, expr); else if (strncmp (name, "%LOC", 4) == 0) { gfc_conv_expr_reference (se, expr); Index: gcc/fortran/resolve.c

--- gcc/fortran/resolve.c (Revision 122226) +++ gcc/fortran/resolve.c (Arbeitskopie) @@ -1016,22 +1016,14 @@ since same file external procedures are not resolvable in gfortran, it is a good deal easier to leave them to intrinsic.c. */ - if (ptype != PROC_UNKNOWN && ptype != PROC_EXTERNAL) + if (ptype != PROC_UNKNOWN + && ptype != PROC_DUMMY + && ptype != PROC_EXTERNAL) { gfc_error ("By-value argument at %L is not allowed " "in this context", &e->where); return FAILURE; }

•      if (((e->ts.type == BT_REAL || e->ts.type == BT_COMPLEX)

•      && e->ts.kind > gfc_default_real_kind)

•     || (e->ts.kind > gfc_default_integer_kind))

•   {

•     gfc_error ("Kind of by-value argument at %L is larger "

•           "than default kind", &e->where);

•     return FAILURE;

•   }

•     }
  
    /* Statement functions have already been excluded above.  */

• Follow-Ups:
  • Re: [Patch, fortran] PR30887 and PR30888 - overdone constraints on %VAL
    * From: Jerry DeLisle
• References:
  • [Patch, fortran] PR30887 and PR30888 - overdone constraints on %VAL
    * From: Paul Richard Thomas
  • Re: [Patch, fortran] PR30887 and PR30888 - overdone constraints on %VAL
    * From: Tobias Burnus