re PR fortran/40569 (F2008: Support COMPILER_OPTIONS() / COMPILER_VERSION())

2010-09-27  Tobias Burnus  <burnus@net-b.de>

        PR fortran/40569
        PR fortran/40568
        * intrinsic.h (gfc_simplify_compiler_options,
        gfc_simplify_compiler_version): New prototypes.
        * intrinsic.c (gfc_intrinsic_function_by_id,
        make_from_module): New functions.
        (gfc_find_function, gfc_find_subroutine, gfc_generic_intrinsic,
        gfc_specific_intrinsic): Don't return module intrinsics.
        (add_functions): Add compiler_options, compiler_version.
        (gfc_intrinsic_func_interface): Also lookup symbol by ISYM ID.
        * symbol.c (std_for_isocbinding_symbol): Add version check for
        NAMED_FUNCTIONS.
        * iso-fortran-env.def: Add compiler_options, compiler_version.
        * iso-c-binding.def: Add c_sizeof.
        * gfortran.h (gfc_intrinsic_sym): Add from_module:1.
        (iso_c_binding_symbol, iso_fortran_env_symbol): Add NAMED_FUNCTIONS.
        (gfc_intrinsic_function_by_id): New prototype.
        * module.c (create_intrinsic_function): New function.
        (import_iso_c_binding_module, use_iso_fortran_env_module): Use it.
        * trans-types.c (init_c_interop_kinds): Add NAMED_FUNCTIONS.
        * resolve.c (resolve_intrinsic): Try also to resolve intrinsics
        by ISYM ID.
        * simplify.c (gfc_simplify_compiler_options,
        gfc_simplify_compiler_version): New functions.

2010-09-27  Tobias Burnus  <burnus@net-b.de>

        PR fortran/40569
        PR fortran/40568
        * gfortran.dg/storage_size_2.f08: Fix test.
        * gfortran.dg/c_sizeof_1.f90: Fix test.
        * gfortran.dg/c_sizeof_2.f90: Update dg-error.
        * gfortran.dg/c_sizeof_3.f90: New.
        * gfortran.dg/c_sizeof_4.f90: New.
        * gfortran.dg/iso_c_binding_compiler_1.f90: New.
        * gfortran.dg/iso_c_binding_compiler_2.f90: New.

From-SVN: r164639

1 files changed, 56 insertions, 7 deletions

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 795c8ca..625ff03 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -814,6 +814,24 @@ find_sym (gfc_intrinsic_sym *start, int n, const char *name)
 }
 
 
+gfc_intrinsic_sym *
+gfc_intrinsic_function_by_id (gfc_isym_id id)
+{
+  gfc_intrinsic_sym *start = functions;
+  int n = nfunc;
+
+  while (true)
+    {
+      gcc_assert (n > 0);
+      if (id == start->id)
+	return start;
+
+      start++;
+      n--;
+    }
+}
+
+
 /* Given a name, find a function in the intrinsic function table.
    Returns NULL if not found.  */
 
@@ -823,10 +841,10 @@ gfc_find_function (const char *name)
   gfc_intrinsic_sym *sym;
 
   sym = find_sym (functions, nfunc, name);
-  if (!sym)
+  if (!sym || sym->from_module)
     sym = find_sym (conversion, nconv, name);
 
-  return sym;
+  return (!sym || sym->from_module) ? NULL : sym;
 }
 
 
@@ -836,7 +854,9 @@ gfc_find_function (const char *name)
 gfc_intrinsic_sym *
 gfc_find_subroutine (const char *name)
 {
-  return find_sym (subroutines, nsub, name);
+  gfc_intrinsic_sym *sym;
+  sym = find_sym (subroutines, nsub, name);
+  return (!sym || sym->from_module) ? NULL : sym;
 }
 
 
@@ -849,7 +869,7 @@ gfc_generic_intrinsic (const char *name)
   gfc_intrinsic_sym *sym;
 
   sym = gfc_find_function (name);
-  return (sym == NULL) ? 0 : sym->generic;
+  return (!sym || sym->from_module) ? 0 : sym->generic;
 }
 
 
@@ -862,7 +882,7 @@ gfc_specific_intrinsic (const char *name)
   gfc_intrinsic_sym *sym;
 
   sym = gfc_find_function (name);
-  return (sym == NULL) ? 0 : sym->specific;
+  return (!sym || sym->from_module) ? 0 : sym->specific;
 }
 
 
@@ -1014,6 +1034,15 @@ make_noreturn (void)
     next_sym[-1].noreturn = 1;
 }
 
+
+/* Mark current intrinsic as module intrinsic.  */
+static void
+make_from_module (void)
+{
+  if (sizing == SZ_NOTHING)
+    next_sym[-1].from_module = 1;
+}
+
 /* Set the attr.value of the current procedure.  */
 
 static void
@@ -2607,10 +2636,23 @@ add_functions (void)
 	     x, BT_UNKNOWN, 0, REQUIRED);
 
   make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
-  
+
+  /* C_SIZEOF is part of ISO_C_BINDING.  */
   add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF, CLASS_INQUIRY, ACTUAL_NO,
 	     BT_INTEGER, ii, GFC_STD_F2008, gfc_check_c_sizeof, NULL, NULL,
 	     x, BT_UNKNOWN, 0, REQUIRED);
+  make_from_module();
+
+  /* COMPILER_OPTIONS and COMPILER_VERSION are part of ISO_FORTRAN_ENV.  */  
+  add_sym_0 ("compiler_options", GFC_ISYM_COMPILER_OPTIONS, CLASS_IMPURE,
+	     ACTUAL_NO, BT_CHARACTER, 1, GFC_STD_F2008,
+	     NULL, gfc_simplify_compiler_options, NULL);
+  make_from_module();
+
+  add_sym_0 ("compiler_version", GFC_ISYM_COMPILER_VERSION, CLASS_IMPURE,
+	     ACTUAL_NO, BT_CHARACTER, 1, GFC_STD_F2008,
+	     NULL, gfc_simplify_compiler_version, NULL);
+  make_from_module();
 
   add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
 	     gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
@@ -4012,7 +4054,14 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
 
   name = expr->symtree->n.sym->name;
 
-  isym = specific = gfc_find_function (name);
+  if (expr->symtree->n.sym->intmod_sym_id)
+    {
+      int id = expr->symtree->n.sym->intmod_sym_id;
+      isym = specific = gfc_intrinsic_function_by_id ((gfc_isym_id) id);
+    }
+  else
+    isym = specific = gfc_find_function (name);
+
   if (isym == NULL)
     {
       if (!error_flag)