]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
re PR fortran/47023 (C_Sizeof: Rejects valid code)
authorJanus Weil <janus@gcc.gnu.org>
Sun, 16 Oct 2011 19:42:48 +0000 (21:42 +0200)
committerJanus Weil <janus@gcc.gnu.org>
Sun, 16 Oct 2011 19:42:48 +0000 (21:42 +0200)
2011-10-16  Janus Weil  <janus@gcc.gnu.org>

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  <janus@gcc.gnu.org>

PR fortran/47023
* gfortran.dg/c_kind_tests_3.f03: New.

From-SVN: r180062

gcc/fortran/ChangeLog
gcc/fortran/primary.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/c_kind_tests_3.f03 [new file with mode: 0644]

index a6be321f2c52721d6b40c8c1ddc72584c06acbdb..6d7148dc2f8ad2af97cc67134d890e966ae28c43 100644 (file)
@@ -1,3 +1,11 @@
+2011-10-16  Janus Weil  <janus@gcc.gnu.org>
+
+       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  <janus@gcc.gnu.org>
 
        PR fortran/50547
index bccf7d49cf95ebcc900df8c4cc3484542e76acdf..748185ae72b085e82d51719c5c35ed87edd3ff0f 100644 (file)
@@ -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;
index 9900074e0aa095c730148793e0cf70c2e560c4a2..b57eda18a772d960791197d4c0c3de066fc8fd10 100644 (file)
@@ -1,3 +1,8 @@
+2011-10-16  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/47023
+       * gfortran.dg/c_kind_tests_3.f03: New.
+
 2011-10-16  Janus Weil  <janus@gcc.gnu.org>
 
        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 (file)
index 0000000..5d5f3ab
--- /dev/null
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! PR 47023: [4.6/4.7 regression] C_Sizeof: Rejects valid code
+!
+! Contributed by <florian.rathgeber@gmail.com>
+
+  use iso_c_binding
+  real(c_double) x
+  print *, c_sizeof(x)
+  print *, c_sizeof(0.0_c_double)
+end