https://gcc.gnu.org/bugzilla/show_bug.cgi?id=68544

kargl at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|kargl at gcc dot gnu.org           |

--- Comment #8 from kargl at gcc dot gnu.org ---
(In reply to Gerhard Steinmetz from comment #3)
> Update :
> 
> 
> $ cat z1.f90
> program p
>    type t
>    end type
>    call f(t)
> end
> 
> 
> $ gfortran-7-20161120 z1.f90
> z1.f90:2:0:
> 
>     type t
> 
> internal compiler error: Segmentation fault
> 0xc4265f crash_signal
>         ../../gcc/toplev.c:333
> 0x74c990 gfc_sym_identifier
>         ../../gcc/fortran/trans-decl.c:339
> 0x74e2e3 build_function_decl
>         ../../gcc/fortran/trans-decl.c:2197
> 0x75806a gfc_get_symbol_decl(gfc_symbol*)
>         ../../gcc/fortran/trans-decl.c:1622
> 0x77005f gfc_conv_variable
>         ../../gcc/fortran/trans-expr.c:2494
> 0x76bcf2 gfc_conv_expr(gfc_se*, gfc_expr*)
>         ../../gcc/fortran/trans-expr.c:7704
> 0x773aa6 gfc_conv_expr_reference(gfc_se*, gfc_expr*)
>         ../../gcc/fortran/trans-expr.c:7804
> 0x767220 gfc_conv_procedure_call(gfc_se*, gfc_symbol*, gfc_actual_arglist*,
> gfc_expr*, vec<tree_node*, va_gc, vl_embed>*)
>         ../../gcc/fortran/trans-expr.c:5169
> 0x7b0fe4 gfc_trans_call(gfc_code*, bool, tree_node*, tree_node*, bool)
>         ../../gcc/fortran/trans-stmt.c:407
> 0x72c59a trans_code
>         ../../gcc/fortran/trans.c:1774
> 0x75c578 gfc_generate_function_code(gfc_namespace*)
>         ../../gcc/fortran/trans-decl.c:6261
> 0x6e53e0 translate_all_program_units
>         ../../gcc/fortran/parse.c:6038
> 0x6e53e0 gfc_parse_file()
>         ../../gcc/fortran/parse.c:6238
> 0x729052 gfc_be_parse_file
>         ../../gcc/fortran/f95-lang.c:202

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c       (revision 266281)
+++ gcc/fortran/resolve.c       (working copy)
@@ -1863,7 +1863,19 @@ resolve_procedure_expression (gfc_expr* expr)
   return true;
 }

+/* Check that name is not a derived type.  */

+static bool
+is_dt_name (const char *name)
+{
+  gfc_symbol *dt_list;
+
+  for (dt_list = gfc_derived_types; dt_list; dt_list = dt_list->dt_next)
+    if (strcmp(dt_list->name, name) == 0)
+      return true;
+  return false;
+}
+
 /* Resolve an actual argument list.  Most of the time, this is just
    resolving the expressions in the list.
    The exception is that we sometimes have to decide whether arguments
@@ -1964,6 +1976,14 @@ resolve_actual_arglist (gfc_actual_arglist *arg, proce
              gfc_error ("ELEMENTAL non-INTRINSIC procedure %qs is not "
                         "allowed as an actual argument at %L", sym->name,
                         &e->where);
+           }
+
+         /* Check to see if the argument is actually a derived type.  */
+         if (is_dt_name (sym->name))
+           {
+             gfc_error ("Derived type %qs is used as an actual "
+                        "argument at %L", sym->name, &e->where);
+             goto cleanup;
            }

          /* Check if a generic interface has a specific procedure
Index: gcc/testsuite/gfortran.dg/pr68544.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr68544.f90       (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr68544.f90       (working copy)
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! PF fortran/68544
+program p
+   real x
+   type t
+   end type
+   x = f(t)             ! { dg-error "used as an actual argument" }
+end
+subroutine b
+   type t
+   end type
+   print *, shape(t)    ! { dg-error "used as an actual argument" }
+end
Index: gcc/testsuite/gfortran.dg/pr85687.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr85687.f90       (revision 266281)
+++ gcc/testsuite/gfortran.dg/pr85687.f90       (working copy)
@@ -1,8 +1,9 @@
 ! { dg-do compile }
 ! PR fortran/85687
 ! Code original contributed by Gerhard Steinmetz gscfq at t-oline dot de
+! Originally, error message superceded by fix for PR fortran/68544.
 program p
    type t
    end type
-   print *, rank(t)  ! { dg-error "must be a data object" }
+   print *, rank(t)  ! { dg-error "used as an actual argument" }
 end

Reply via email to