* dependency.c (gfc_check_dependency): Remove unused vars and nvars

[pf3gnuchains/gcc-fork.git] / gcc / fortran / trans-decl.c

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index dce4095..2a92f5d 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1,5 +1,6 @@
 /* Backend function setup
-   Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+   Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation,
+   Inc.
    Contributed by Paul Brook
 
 This file is part of GCC.
@@ -87,6 +88,9 @@ tree gfor_fndecl_select_string;
 tree gfor_fndecl_runtime_error;
 tree gfor_fndecl_set_fpe;
 tree gfor_fndecl_set_std;
+tree gfor_fndecl_ctime;
+tree gfor_fndecl_fdate;
+tree gfor_fndecl_ttynam;
 tree gfor_fndecl_in_pack;
 tree gfor_fndecl_in_unpack;
 tree gfor_fndecl_associated;
@@ -365,13 +369,13 @@ gfc_finish_cray_pointee (tree decl, gfc_symbol *sym)
 
   /* Parameters need to be dereferenced.  */
   if (sym->cp_pointer->attr.dummy) 
-    ptr_decl = gfc_build_indirect_ref (ptr_decl);
+    ptr_decl = build_fold_indirect_ref (ptr_decl);
 
   /* Check to see if we're dealing with a variable-sized array.  */
   if (sym->attr.dimension
       && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE) 
     {  
-      /* These decls will be derefenced later, so we don't dereference
+      /* These decls will be dereferenced later, so we don't dereference
         them here.  */
       value = convert (TREE_TYPE (decl), ptr_decl);
     }
@@ -379,7 +383,7 @@ gfc_finish_cray_pointee (tree decl, gfc_symbol *sym)
     {
       ptr_decl = convert (build_pointer_type (TREE_TYPE (decl)),
                          ptr_decl);
-      value = gfc_build_indirect_ref (ptr_decl);
+      value = build_fold_indirect_ref (ptr_decl);
     }
 
   SET_DECL_VALUE_EXPR (decl, value);
@@ -806,7 +810,9 @@ tree
 gfc_get_symbol_decl (gfc_symbol * sym)
 {
   tree decl;
+  tree etype = NULL_TREE;
   tree length = NULL_TREE;
+  tree tmp = NULL_TREE;
   int byref;
 
   gcc_assert (sym->attr.referenced);
@@ -845,6 +851,21 @@ gfc_get_symbol_decl (gfc_symbol * sym)
                  gfc_defer_symbol_init (sym);
                }
            }
+
+         /* Set the element size of automatic and assumed character length
+            length, dummy, pointer arrays.  */
+         if (sym->attr.pointer && sym->attr.dummy
+               && sym->attr.dimension)
+           {
+             tmp = build_fold_indirect_ref (sym->backend_decl);
+             etype = gfc_get_element_type (TREE_TYPE (tmp));
+             if (TYPE_SIZE_UNIT (etype) == NULL_TREE)
+               {
+                 tmp = TYPE_SIZE_UNIT (gfc_character1_type_node);
+                 tmp = fold_convert (TREE_TYPE (tmp), sym->ts.cl->backend_decl);
+                 TYPE_SIZE_UNIT (etype) = tmp;
+               }
+           }
        }
 
       /* Use a copy of the descriptor for dummy arrays.  */
@@ -1073,7 +1094,7 @@ gfc_get_extern_function_decl (gfc_symbol * sym)
      sense.  */
   if (sym->attr.pure || sym->attr.elemental)
     {
-      if (sym->attr.function)
+      if (sym->attr.function && !gfc_return_by_reference (sym))
        DECL_IS_PURE (fndecl) = 1;
       /* TODO: check if pure SUBROUTINEs don't have INTENT(OUT)
         parameters and don't use alternate returns (is this
@@ -1200,7 +1221,7 @@ build_function_decl (gfc_symbol * sym)
       /* TODO: check if a pure SUBROUTINE has no INTENT(OUT) arguments
         including a alternate return. In that case it can also be
         marked as PURE. See also in gfc_get_extern_function_decl().  */
-      if (attr.function)
+      if (attr.function && !gfc_return_by_reference (sym))
        DECL_IS_PURE (fndecl) = 1;
       TREE_SIDE_EFFECTS (fndecl) = 0;
     }
@@ -1525,7 +1546,7 @@ build_entry_thunks (gfc_namespace * ns)
       args = nreverse (args);
       args = chainon (args, nreverse (string_args));
       tmp = ns->proc_name->backend_decl;
-      tmp = gfc_build_function_call (tmp, args);
+      tmp = build_function_call_expr (tmp, args);
       if (ns->proc_name->attr.mixed_entry_master)
        {
          tree union_decl, field;
@@ -1780,6 +1801,7 @@ gfc_build_intrinsic_function_decls (void)
   tree gfc_complex8_type_node = gfc_get_complex_type (8);
   tree gfc_complex10_type_node = gfc_get_complex_type (10);
   tree gfc_complex16_type_node = gfc_get_complex_type (16);
+  tree gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
 
   /* String functions.  */
   gfor_fndecl_copy_string =
@@ -1849,6 +1871,29 @@ gfc_build_intrinsic_function_decls (void)
                                      pchar_type_node,
                                      gfc_int4_type_node);
 
+  gfor_fndecl_ttynam =
+    gfc_build_library_function_decl (get_identifier (PREFIX("ttynam")),
+                                     void_type_node,
+                                     3,
+                                     pchar_type_node,
+                                     gfc_charlen_type_node,
+                                     gfc_c_int_type_node);
+
+  gfor_fndecl_fdate =
+    gfc_build_library_function_decl (get_identifier (PREFIX("fdate")),
+                                     void_type_node,
+                                     2,
+                                     pchar_type_node,
+                                     gfc_charlen_type_node);
+
+  gfor_fndecl_ctime =
+    gfc_build_library_function_decl (get_identifier (PREFIX("ctime")),
+                                     void_type_node,
+                                     3,
+                                     pchar_type_node,
+                                     gfc_charlen_type_node,
+                                     gfc_int8_type_node);
+
   gfor_fndecl_adjustl =
     gfc_build_library_function_decl (get_identifier (PREFIX("adjustl")),
                                     void_type_node,
@@ -2339,7 +2384,8 @@ gfc_create_module_variable (gfc_symbol * sym)
     return;
 
   /* Equivalenced variables arrive here after creation.  */
-  if (sym->backend_decl && sym->equiv_built)
+  if (sym->backend_decl
+       && (sym->equiv_built || sym->attr.in_equivalence))
       return;
 
   if (sym->backend_decl)
@@ -2513,9 +2559,6 @@ gfc_generate_function_code (gfc_namespace * ns)
 
   trans_function_start (sym);
 
-  /* Will be created as needed.  */
-  current_fake_result_decl = NULL_TREE;
-
   gfc_start_block (&block);
 
   if (ns->entries && ns->proc_name->ts.type == BT_CHARACTER)
@@ -2537,7 +2580,9 @@ gfc_generate_function_code (gfc_namespace * ns)
   gfc_generate_contained_functions (ns);
 
   generate_local_vars (ns);
-
+  
+  /* Will be created as needed.  */
+  current_fake_result_decl = NULL_TREE;
   current_function_return_label = NULL;
 
   /* Now generate the code for the body of this function.  */
@@ -2557,7 +2602,7 @@ gfc_generate_function_code (gfc_namespace * ns)
       arglist = gfc_chainon_list (arglist,
                                  build_int_cst (gfc_int4_type_node,
                                                 gfc_option.allow_std));
-      tmp = gfc_build_function_call (gfor_fndecl_set_std, arglist);
+      tmp = build_function_call_expr (gfor_fndecl_set_std, arglist);
       gfc_add_expr_to_block (&body, tmp);
     }
 
@@ -2572,7 +2617,7 @@ gfc_generate_function_code (gfc_namespace * ns)
       arglist = gfc_chainon_list (NULL_TREE,
                                  build_int_cst (gfc_c_int_type_node,
                                                 gfc_option.fpe));
-      tmp = gfc_build_function_call (gfor_fndecl_set_fpe, arglist);
+      tmp = build_function_call_expr (gfor_fndecl_set_fpe, arglist);
       gfc_add_expr_to_block (&body, tmp);
     }
 
@@ -2719,7 +2764,7 @@ gfc_generate_constructors (void)
   for (; gfc_static_ctors; gfc_static_ctors = TREE_CHAIN (gfc_static_ctors))
     {
       tmp =
-       gfc_build_function_call (TREE_VALUE (gfc_static_ctors), NULL_TREE);
+       build_function_call_expr (TREE_VALUE (gfc_static_ctors), NULL_TREE);
       DECL_SAVED_TREE (fndecl) = build_stmt (EXPR_STMT, tmp);
     }