OSDN Git Service

2013-11-17 Paul Thomas <pault@gcc.gnu.org>
authorpault <pault@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 17 Nov 2013 08:11:33 +0000 (08:11 +0000)
committerpault <pault@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 17 Nov 2013 08:11:33 +0000 (08:11 +0000)
PR fortran/58771
* trans-io.c (transfer_expr): If the backend_decl for a derived
type is missing, build it with gfc_typenode_for_spec.

2013-11-17  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/58771
* gfortran.dg/derived_external_function_1.f90 : New test

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_7-branch@204913 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/trans-io.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/derived_external_function_1.f90 [new file with mode: 0644]

index a42b450..174594b 100644 (file)
@@ -1,3 +1,9 @@
+2013-11-17  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/58771
+       * trans-io.c (transfer_expr): If the backend_decl for a derived
+       type is missing, build it with gfc_typenode_for_spec.
+
 2013-11-02  Janus Weil  <janus@gcc.gnu.org>
 
        Backport from mainline
index 12dfcf8..ab76ac2 100644 (file)
@@ -244,16 +244,16 @@ gfc_trans_io_runtime_check (tree cond, tree var, int error_code,
 
   /* The code to generate the error.  */
   gfc_start_block (&block);
-  
+
   arg1 = gfc_build_addr_expr (NULL_TREE, var);
-  
+
   arg2 = build_int_cst (integer_type_node, error_code),
-  
+
   asprintf (&message, "%s", _(msgid));
   arg3 = gfc_build_addr_expr (pchar_type_node,
                              gfc_build_localized_cstring_const (message));
   free (message);
-  
+
   tmp = build_call_expr_loc (input_location,
                         gfor_fndecl_generate_error, 3, arg1, arg2, arg3);
 
@@ -522,7 +522,7 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type,
       gfc_trans_io_runtime_check (cond, var, LIBERROR_BAD_UNIT,
                               "Unit number in I/O statement too small",
                               &se.pre);
-    
+
       /* UNIT numbers should be less than the max.  */
       val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, 4);
       cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
@@ -1002,7 +1002,7 @@ gfc_trans_open (gfc_code * code)
   if (p->convert)
     mask |= set_string (&block, &post_block, var, IOPARM_open_convert,
                        p->convert);
-                       
+
   if (p->newunit)
     mask |= set_parameter_ref (&block, &post_block, var, IOPARM_open_newunit,
                               p->newunit);
@@ -1236,7 +1236,7 @@ gfc_trans_inquire (gfc_code * code)
     {
       mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_exist,
                                 p->exist);
-    
+
       if (p->unit && !p->iostat)
        {
          p->iostat = create_dummy_iostat ();
@@ -1324,7 +1324,7 @@ gfc_trans_inquire (gfc_code * code)
   if (p->pad)
     mask |= set_string (&block, &post_block, var, IOPARM_inquire_pad,
                        p->pad);
-  
+
   if (p->convert)
     mask |= set_string (&block, &post_block, var, IOPARM_inquire_convert,
                        p->convert);
@@ -1546,7 +1546,7 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
   tree dtype;
   tree dt_parm_addr;
   tree decl = NULL_TREE;
-  int n_dim; 
+  int n_dim;
   int itype;
   int rank = 0;
 
@@ -2029,7 +2029,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
       if (gfc_notification_std (GFC_STD_GNU) != SILENT)
        {
          gfc_error_now ("Derived type '%s' at %L has PRIVATE components",
-                        ts->u.derived->name, code != NULL ? &(code->loc) : 
+                        ts->u.derived->name, code != NULL ? &(code->loc) :
                         &gfc_current_locus);
          return;
        }
@@ -2038,7 +2038,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
       ts->kind = ts->u.derived->ts.kind;
       ts->f90_type = ts->u.derived->ts.f90_type;
     }
-  
+
   kind = ts->kind;
   function = NULL;
   arg2 = NULL;
@@ -2120,7 +2120,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
            function = iocall[IOCALL_X_CHARACTER_WIDE];
          else
            function = iocall[IOCALL_X_CHARACTER_WIDE_WRITE];
-           
+
          tmp = gfc_build_addr_expr (NULL_TREE, dt_parm);
          tmp = build_call_expr_loc (input_location,
                                 function, 4, tmp, addr_expr, arg2, arg3);
@@ -2152,6 +2152,12 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
       expr = build_fold_indirect_ref_loc (input_location,
                                      expr);
 
+      /* Make sure that the derived type has been built.  An external
+        function, if only referenced in an io statement requires this
+        check (see PR58771).  */
+      if (ts->u.derived->backend_decl == NULL_TREE)
+       tmp = gfc_typenode_for_spec (ts);
+
       for (c = ts->u.derived->components; c; c = c->next)
        {
          field = c->backend_decl;
@@ -2287,7 +2293,7 @@ gfc_trans_transfer (gfc_code * code)
          transfer_array_desc (&se, &expr->ts, tmp);
          goto finish_block_label;
        }
-      
+
       /* Initialize the scalarizer.  */
       gfc_init_loopinfo (&loop);
       gfc_add_ss_to_loop (&loop, ss);
index 0ffba70..f5a9b9f 100644 (file)
@@ -1,3 +1,8 @@
+2013-11-17  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/58771
+       * gfortran.dg/derived_external_function_1.f90 : New test
+
 2013-11-02  Janus Weil  <janus@gcc.gnu.org>
 
        Backport from mainline
diff --git a/gcc/testsuite/gfortran.dg/derived_external_function_1.f90 b/gcc/testsuite/gfortran.dg/derived_external_function_1.f90
new file mode 100644 (file)
index 0000000..7421c4c
--- /dev/null
@@ -0,0 +1,27 @@
+! { dg-do run }
+!
+! PR fortran/58771
+!
+! Contributed by Vittorio Secca  <zeccav@gmail.com>
+!
+! ICEd on the write statement with f() because the derived type backend
+! declaration not built.
+!
+module m
+  type t
+    integer(4) g
+  end type
+end
+
+type(t) function f() result(ff)
+  use m
+  ff%g = 42
+end
+
+  use m
+  character (20) :: line1, line2
+  type(t)  f
+  write (line1, *) f()
+  write (line2, *) 42_4
+  if (line1 .ne. line2) call abort
+end