re PR fortran/56226 (Add support for DEC UNION and MAP extensions)

2016-05-07  Fritz Reese  <fritzoreese@gmail.com>

	PR fortran/56226
	* module.c (dt_upper_string): Rename to gfc_dt_upper_string
	(dt_lower_string): Likewise.
	* gfortran.h: Make new gfc_dt_upper/lower_string global.
	* class.c: Use gfc_dt_upper_string.
	* decl.c: Likewise.
	* symbol.c: Likewise.
	* resolve.c (resolve_component): New function.
	(resolve_fl_derived0): Move component loop code to resolve_component.
	* parse.c (check_component): New function.
	(parse_derived): Move loop code to check_component.
	* lang.opt, invoke.texi, options.c : New option -fdec-structure.
	* libgfortran.h (bt): New basic type BT_UNION.
	* gfortran.h (gfc_option): New option -fdec-structure.
	(gfc_get_union_type, gfc_compare_union_types): New prototypes.
	(gfc_bt_struct, gfc_fl_struct, case_bt_struct, case_fl_struct): New
	macros.
	(gfc_find_component): Change prototype.
	* match.h (gfc_match_member_sep, gfc_match_map, gfc_match_union,
	gfc_match_structure_decl): New prototypes.
	* parse.h (gfc_comp_struct): New macro.
	* symbol.c (gfc_find_component): Search for components in nested unions
	* class.c (insert_component_ref, gfc_add_component_ref, add_proc_comp,
	copy_vtab_proc_comps): Update calls to gfc_find_component.
	* primary.c (gfc_convert_to_structure_constructor): Likewise.
	* symbol.c (gfc_add_component): Likewise.
	* resolve.c (resolve_typebound_function, resolve_typebound_subroutine,
	resolve_typebound_procedure, resolve_component, resolve_fl_derived):
	Likewise.
	* expr.c (get_union_init, component_init): New functions.
	* decl.c (match_clist_expr, match_record_decl, get_struct_decl,
	gfc_match_map, gfc_match_union, gfc_match_structure_decl): Likewise.
	* interface.c (compare_components, gfc_compare_union_types): Likewise.
	* match.c (gfc_match_member_sep): Likewise.
	* parse.c (check_component, parse_union, parse_struct_map): Likewise.
	* resolve.c (resolve_fl_struct): Likewise.
	* symbol.c (find_union_component): Likewise.
	* trans-types.c (gfc_get_union_type): Likewise.
	* parse.c (parse_derived): Use new functions.
	* interface.c (gfc_compare_derived_types, gfc_compare_types): Likewise.
	* expr.c (gfc_default_initializer): Likewise.
	* gfortran.texi: Support for DEC structures, unions, and maps.
	* gfortran.h (gfc_statement, sym_flavor): Likewise.
	* check.c (gfc_check_kill_sub): Likewise.
	* expr.c (gfc_copy_expr, simplify_const_ref,
	gfc_has_default_initializer): Likewise.
	* decl.c (build_sym, match_data_constant, add_init_expr_to_sym,
	match_pointer_init, build_struct, variable_decl,
	gfc_match_decl_type_spec, gfc_mach_data-decl, gfc_match_entry,
	gfc_match_end, gfc_match_derived_decl): Likewise.
	* interface.c (check_interface0, check_interface1,
	gfc_search_interface): Likewise.
	* misc.c (gfc_basic_typename, gfc_typename): Likewise.
	* module.c (add_true_name, build_tnt, bt_types, mio_typespec,
	fix_mio_expr, load_needed, mio_symbol, read_module, write_symbol,
	gfc_get_module_backend_decl): Likewise.
	* parse.h (gfc_compile_state): Likewise.
	* parse.c (decode_specification_statement, decode_statement,
	gfc_ascii_statement, verify_st_order, parse_spec): Likewise.
	* primary.c (gfc_match_varspec, gfc_match_structure_constructor,
	gfc_match_rvalue, match_variable): Likewise.
	* resolve.c (find_arglists, resolve_structure_cons,
	is_illegal_recursion, resolve_generic_f, get_declared_from_expr,
	resolve_typebound_subroutine, resolve_allocate_expr,
	nonscalar_typebound_assign, generate_component_assignments,
	resolve_fl_variable_derived, check_defined_assignments,
	resolve_component, resolve_symbol, resolve_equivalence_derived):
	Likewise.
	* symbol.c (flavors, check_conflict, gfc_add_flavor, gfc_use_derived,
	gfc_restore_last_undo_checkpoint, gfc_type_compatible,
	gfc_find_dt_in_generic): Likewise.
	* trans-decl.c (gfc_get_module_backend_decl, create_function_arglist,
	gfc_create_module_variable, check_constant_initializer): Likewise.
	* trans-expr.c (gfc_conv_component_ref, gfc_conv_initializer,
	gfc_trans_alloc_subarray_assign, gfc_trans_subcomponent_assign,
	gfc_conv_structure, gfc_trans_scalar_assign, copyable_array_p):
	Likewise.
	* trans-io.c (transfer_namelist_element, transfer_expr,
	gfc_trans_transfer): Likewise.
	* trans-stmt.c (gfc_trans_deallocate): Likewise.
	* trans-types.c (gfc_typenode_for_spec, gfc_copy_dt_decls_ifequal,
	gfc_get_derived_type): Likewise.

2016-05-07  Fritz Reese  <fritzoreese@gmail.com>

	PR fortran/56226
	* gfortran.dg/dec_structure_1.f90: New testcase.
	* gfortran.dg/dec_structure_2.f90: Ditto.
	* gfortran.dg/dec_structure_3.f90: Ditto.
	* gfortran.dg/dec_structure_4.f90: Ditto.
	* gfortran.dg/dec_structure_5.f90: Ditto.
	* gfortran.dg/dec_structure_6.f90: Ditto.
	* gfortran.dg/dec_structure_7.f90: Ditto.
	* gfortran.dg/dec_structure_8.f90: Ditto.
	* gfortran.dg/dec_structure_9.f90: Ditto.
	* gfortran.dg/dec_structure_10.f90: Ditto.
	* gfortran.dg/dec_structure_11.f90: Ditto.
	* gfortran.dg/dec_union_1.f90: Ditto.
	* gfortran.dg/dec_union_2.f90: Ditto.
	* gfortran.dg/dec_union_3.f90: Ditto.
	* gfortran.dg/dec_union_4.f90: Ditto.
	* gfortran.dg/dec_union_5.f90: Ditto.
	* gfortran.dg/dec_union_6.f90: Ditto.
	* gfortran.dg/dec_union_7.f90: Ditto.

From-SVN: r235999

1 files changed, 122 insertions, 0 deletions

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 2490f85..f3a4a43 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -113,6 +113,128 @@ gfc_op2string (gfc_intrinsic_op op)
 
 /******************** Generic matching subroutines ************************/
 
+/* Matches a member separator. With standard FORTRAN this is '%', but with
+   DEC structures we must carefully match dot ('.').
+   Because operators are spelled ".op.", a dotted string such as "x.y.z..."
+   can be either a component reference chain or a combination of binary
+   operations.
+   There is no real way to win because the string may be grammatically
+   ambiguous. The following rules help avoid ambiguities - they match
+   some behavior of other (older) compilers. If the rules here are changed
+   the test cases should be updated. If the user has problems with these rules
+   they probably deserve the consequences. Consider "x.y.z":
+     (1) If any user defined operator ".y." exists, this is always y(x,z)
+         (even if ".y." is the wrong type and/or x has a member y).
+     (2) Otherwise if x has a member y, and y is itself a derived type,
+         this is (x->y)->z, even if an intrinsic operator exists which 
+         can handle (x,z). 
+     (3) If x has no member y or (x->y) is not a derived type but ".y." 
+         is an intrinsic operator (such as ".eq."), this is y(x,z).
+     (4) Lastly if there is no operator ".y." and x has no member "y", it is an
+         error.  
+   It is worth noting that the logic here does not support mixed use of member
+   accessors within a single string. That is, even if x has component y and y
+   has component z, the following are all syntax errors:
+         "x%y.z"  "x.y%z" "(x.y).z"  "(x%y)%z"
+ */
+
+match
+gfc_match_member_sep(gfc_symbol *sym)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  locus dot_loc, start_loc;
+  gfc_intrinsic_op iop;
+  match m;
+  gfc_symbol *tsym;
+  gfc_component *c = NULL;
+
+  /* What a relief: '%' is an unambiguous member separator.  */
+  if (gfc_match_char ('%') == MATCH_YES)
+    return MATCH_YES;
+
+  /* Beware ye who enter here.  */
+  if (!gfc_option.flag_dec_structure || !sym)
+    return MATCH_NO;
+
+  tsym = NULL;
+
+  /* We may be given either a derived type variable or the derived type
+    declaration itself (which actually contains the components); 
+    we need the latter to search for components.  */
+  if (gfc_fl_struct (sym->attr.flavor))
+    tsym = sym;
+  else if (gfc_bt_struct (sym->ts.type))
+    tsym = sym->ts.u.derived;
+
+  iop = INTRINSIC_NONE;
+  name[0] = '\0';
+  m = MATCH_NO;
+
+  /* If we have to reject come back here later.  */
+  start_loc = gfc_current_locus;
+
+  /* Look for a component access next.  */
+  if (gfc_match_char ('.') != MATCH_YES)
+    return MATCH_NO;
+
+  /* If we accept, come back here.  */
+  dot_loc = gfc_current_locus;
+
+  /* Try to match a symbol name following the dot.  */
+  if (gfc_match_name (name) != MATCH_YES)
+    {
+      gfc_error ("Expected structure component or operator name "
+                 "after '.' at %C");
+      goto error;
+    }
+
+  /* If no dot follows we have "x.y" which should be a component access.  */
+  if (gfc_match_char ('.') != MATCH_YES)
+    goto yes;
+
+  /* Now we have a string "x.y.z" which could be a nested member access
+    (x->y)->z or a binary operation y on x and z.  */
+
+  /* First use any user-defined operators ".y."  */
+  if (gfc_find_uop (name, sym->ns) != NULL)
+    goto no;
+
+  /* Match accesses to existing derived-type components for 
+    derived-type vars: "x.y.z" = (x->y)->z  */
+  c = gfc_find_component(tsym, name, false, true, NULL);
+  if (c && (gfc_bt_struct (c->ts.type) || c->ts.type == BT_CLASS))
+    goto yes;
+
+  /* If y is not a component or has no members, try intrinsic operators.  */
+  gfc_current_locus = start_loc;
+  if (gfc_match_intrinsic_op (&iop) != MATCH_YES)
+    {
+      /* If ".y." is not an intrinsic operator but y was a valid non-
+        structure component, match and leave the trailing dot to be 
+        dealt with later.  */
+      if (c)
+        goto yes;
+
+      gfc_error ("'%s' is neither a defined operator nor a "
+                 "structure component in dotted string at %C", name);
+      goto error;
+    }
+
+  /* .y. is an intrinsic operator, overriding any possible member access.  */
+  goto no;
+
+  /* Return keeping the current locus consistent with the match result.  */
+error:
+  m = MATCH_ERROR;
+no:
+  gfc_current_locus = start_loc;
+  return m;
+yes:
+  gfc_current_locus = dot_loc;
+  return MATCH_YES;
+}
+
+
 /* This function scans the current statement counting the opened and closed
    parenthesis to make sure they are balanced.  */