From bee64a2b9e0c63a3e731bba71c5e3c709204d288 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Sun, 16 Oct 2011 21:42:48 +0200 Subject: [PATCH] re PR fortran/47023 (C_Sizeof: Rejects valid code) 2011-10-16 Janus Weil PR fortran/47023 * primary.c (match_kind_param): Detect ISO_C_BINDING kinds. (get_kind): Pass on 'is_iso_c' flag. (match_integer_constant,match_real_constant,match_logical_constant): Set 'ts.is_c_interop'. 2011-10-16 Janus Weil PR fortran/47023 * gfortran.dg/c_kind_tests_3.f03: New. From-SVN: r180062 --- gcc/fortran/ChangeLog | 8 ++++ gcc/fortran/primary.c | 39 +++++++++++++------- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/c_kind_tests_3.f03 | 11 ++++++ 4 files changed, 50 insertions(+), 13 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/c_kind_tests_3.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a6be321f2c5..6d7148dc2f8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2011-10-16 Janus Weil + + PR fortran/47023 + * primary.c (match_kind_param): Detect ISO_C_BINDING kinds. + (get_kind): Pass on 'is_iso_c' flag. + (match_integer_constant,match_real_constant,match_logical_constant): + Set 'ts.is_c_interop'. + 2011-10-16 Janus Weil PR fortran/50547 diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index bccf7d49cf9..748185ae72b 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -32,16 +32,20 @@ int matching_actual_arglist = 0; /* Matches a kind-parameter expression, which is either a named symbolic constant or a nonnegative integer constant. If - successful, sets the kind value to the correct integer. */ + successful, sets the kind value to the correct integer. + The argument 'is_iso_c' signals whether the kind is an ISO_C_BINDING + symbol like e.g. 'c_int'. */ static match -match_kind_param (int *kind) +match_kind_param (int *kind, int *is_iso_c) { char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_symbol *sym; const char *p; match m; + *is_iso_c = 0; + m = gfc_match_small_literal_int (kind, NULL); if (m != MATCH_NO) return m; @@ -53,6 +57,8 @@ match_kind_param (int *kind) if (gfc_find_symbol (name, NULL, 1, &sym)) return MATCH_ERROR; + *is_iso_c = sym->attr.is_iso_c; + if (sym == NULL) return MATCH_NO; @@ -77,20 +83,24 @@ match_kind_param (int *kind) /* Get a trailing kind-specification for non-character variables. Returns: - the integer kind value or: - -1 if an error was generated - -2 if no kind was found */ + * the integer kind value or + * -1 if an error was generated, + * -2 if no kind was found. + The argument 'is_iso_c' signals whether the kind is an ISO_C_BINDING + symbol like e.g. 'c_int'. */ static int -get_kind (void) +get_kind (int *is_iso_c) { int kind; match m; + *is_iso_c = 0; + if (gfc_match_char ('_') != MATCH_YES) return -2; - m = match_kind_param (&kind); + m = match_kind_param (&kind, is_iso_c); if (m == MATCH_NO) gfc_error ("Missing kind-parameter at %C"); @@ -188,7 +198,7 @@ match_digits (int signflag, int radix, char *buffer) static match match_integer_constant (gfc_expr **result, int signflag) { - int length, kind; + int length, kind, is_iso_c; locus old_loc; char *buffer; gfc_expr *e; @@ -208,7 +218,7 @@ match_integer_constant (gfc_expr **result, int signflag) match_digits (signflag, 10, buffer); - kind = get_kind (); + kind = get_kind (&is_iso_c); if (kind == -2) kind = gfc_default_integer_kind; if (kind == -1) @@ -221,6 +231,7 @@ match_integer_constant (gfc_expr **result, int signflag) } e = gfc_convert_integer (buffer, kind, 10, &gfc_current_locus); + e->ts.is_c_interop = is_iso_c; if (gfc_range_check (e) != ARITH_OK) { @@ -473,7 +484,7 @@ backup: static match match_real_constant (gfc_expr **result, int signflag) { - int kind, count, seen_dp, seen_digits; + int kind, count, seen_dp, seen_digits, is_iso_c; locus old_loc, temp_loc; char *p, *buffer, c, exp_char; gfc_expr *e; @@ -611,7 +622,7 @@ done: c = gfc_next_ascii_char (); } - kind = get_kind (); + kind = get_kind (&is_iso_c); if (kind == -1) goto cleanup; @@ -665,6 +676,7 @@ done: e = gfc_convert_real (buffer, kind, &gfc_current_locus); if (negate) mpfr_neg (e->value.real, e->value.real, GFC_RND_MODE); + e->ts.is_c_interop = is_iso_c; switch (gfc_range_check (e)) { @@ -1099,13 +1111,13 @@ static match match_logical_constant (gfc_expr **result) { gfc_expr *e; - int i, kind; + int i, kind, is_iso_c; i = match_logical_constant_string (); if (i == -1) return MATCH_NO; - kind = get_kind (); + kind = get_kind (&is_iso_c); if (kind == -1) return MATCH_ERROR; if (kind == -2) @@ -1118,6 +1130,7 @@ match_logical_constant (gfc_expr **result) } e = gfc_get_logical_expr (kind, &gfc_current_locus, i); + e->ts.is_c_interop = is_iso_c; *result = e; return MATCH_YES; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9900074e0aa..b57eda18a77 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-10-16 Janus Weil + + PR fortran/47023 + * gfortran.dg/c_kind_tests_3.f03: New. + 2011-10-16 Janus Weil PR fortran/50547 diff --git a/gcc/testsuite/gfortran.dg/c_kind_tests_3.f03 b/gcc/testsuite/gfortran.dg/c_kind_tests_3.f03 new file mode 100644 index 00000000000..5d5f3ab195f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_kind_tests_3.f03 @@ -0,0 +1,11 @@ +! { dg-do compile } +! +! PR 47023: [4.6/4.7 regression] C_Sizeof: Rejects valid code +! +! Contributed by + + use iso_c_binding + real(c_double) x + print *, c_sizeof(x) + print *, c_sizeof(0.0_c_double) +end -- 2.30.2