* builtin-types.def (BT_FN_PTR_PTR_SIZE): New type.

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

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index b196315..f900ec5 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -8,7 +8,7 @@ This file is part of GCC.
 
 GCC is free software; you can redistribute it and/or modify it under
 the terms of the GNU General Public License as published by the Free
-Software Foundation; either version 2, or (at your option) any later
+Software Foundation; either version 3, or (at your option) any later
 version.
 
 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
@@ -17,9 +17,8 @@ FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
 for more details.
 
 You should have received a copy of the GNU General Public License
-along with GCC; see the file COPYING.  If not, write to the Free
-Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
-02110-1301, USA.  */
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
 
 
 #include "config.h"
@@ -154,8 +153,8 @@ gfc_trans_goto (gfc_code * code)
   tmp = GFC_DECL_STRING_LEN (se.expr);
   tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp,
                     build_int_cst (TREE_TYPE (tmp), -1));
-  gfc_trans_runtime_check (tmp, "Assigned label is not a target label",
-                          &se.pre, &loc);
+  gfc_trans_runtime_check (tmp, &se.pre, &loc,
+                          "Assigned label is not a target label");
 
   assigned_goto = GFC_DECL_ASSIGN_ADDR (se.expr);
 
@@ -180,8 +179,8 @@ gfc_trans_goto (gfc_code * code)
       code = code->block;
     }
   while (code != NULL);
-  gfc_trans_runtime_check (boolean_true_node,
-                          "Assigned label is not in the list", &se.pre, &loc);
+  gfc_trans_runtime_check (boolean_true_node, &se.pre, &loc,
+                          "Assigned label is not in the list");
 
   return gfc_finish_block (&se.pre); 
 }
@@ -447,7 +446,8 @@ gfc_trans_return (gfc_code * code ATTRIBUTE_UNUSED)
 
       gfc_conv_expr (&se, code->expr);
 
-      tmp = build2 (MODIFY_EXPR, TREE_TYPE (result), result, se.expr);
+      tmp = build2 (MODIFY_EXPR, TREE_TYPE (result), result,
+                   fold_convert (TREE_TYPE (result), se.expr));
       gfc_add_expr_to_block (&se.pre, tmp);
 
       tmp = build1_v (GOTO_EXPR, gfc_get_return_label ());
@@ -1320,7 +1320,6 @@ static tree
 gfc_trans_character_select (gfc_code *code)
 {
   tree init, node, end_label, tmp, type, case_num, label;
-  tree gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
   stmtblock_t block, body;
   gfc_case *cp, *d;
   gfc_code *c;
@@ -1351,7 +1350,7 @@ gfc_trans_character_select (gfc_code *code)
       ADD_FIELD (string2, pchar_type_node);
       ADD_FIELD (string2_len, gfc_int4_type_node);
 
-      ADD_FIELD (target, gfc_c_int_type_node);
+      ADD_FIELD (target, integer_type_node);
 #undef ADD_FIELD
 
       gfc_finish_type (select_struct);
@@ -1425,7 +1424,7 @@ gfc_trans_character_select (gfc_code *code)
           node = tree_cons (ss_string2_len, se.string_length, node);
         }
 
-      node = tree_cons (ss_target, build_int_cst (gfc_c_int_type_node, d->n),
+      node = tree_cons (ss_target, build_int_cst (integer_type_node, d->n),
                        node);
 
       tmp = build_constructor_from_list (select_struct, nreverse (node));
@@ -1459,7 +1458,7 @@ gfc_trans_character_select (gfc_code *code)
   tmp = build_call_expr (gfor_fndecl_select_string, 4, init,
                         build_int_cst (NULL_TREE, n), se.expr,
                         se.string_length);
-  case_num = gfc_create_var (gfc_c_int_type_node, "case_num");
+  case_num = gfc_create_var (integer_type_node, "case_num");
   gfc_add_modify_expr (&block, case_num, tmp);
 
   gfc_add_block_to_block (&block, &se.post);
@@ -3566,11 +3565,7 @@ gfc_trans_allocate (gfc_code * code)
       TREE_USED (error_label) = 1;
     }
   else
-    {
-      pstat = integer_zero_node;
-      stat = error_label = NULL_TREE;
-    }
-
+    pstat = stat = error_label = NULL_TREE;
 
   for (al = code->ext.alloc_list; al != NULL; al = al->next)
     {
@@ -3591,7 +3586,7 @@ gfc_trans_allocate (gfc_code * code)
          if (expr->ts.type == BT_CHARACTER && tmp == NULL_TREE)
            tmp = se.string_length;
 
-         tmp = build_call_expr (gfor_fndecl_allocate, 2, tmp, pstat);
+         tmp = gfc_allocate_with_status (&se.pre, tmp, pstat);
          tmp = build2 (MODIFY_EXPR, void_type_node, se.expr,
                        fold_convert (TREE_TYPE (se.expr), tmp));
          gfc_add_expr_to_block (&se.pre, tmp);
@@ -3680,10 +3675,7 @@ gfc_trans_deallocate (gfc_code * code)
       gfc_add_modify_expr (&block, astat, build_int_cst (TREE_TYPE (astat), 0));
     }
   else
-    {
-      pstat = apstat = null_pointer_node;
-      stat = astat = NULL_TREE;
-    }
+    pstat = apstat = stat = astat = NULL_TREE;
 
   for (al = code->ext.alloc_list; al != NULL; al = al->next)
     {
@@ -3721,7 +3713,7 @@ gfc_trans_deallocate (gfc_code * code)
        tmp = gfc_array_deallocate (se.expr, pstat);
       else
        {
-         tmp = build_call_expr (gfor_fndecl_deallocate, 2, se.expr, pstat);
+         tmp = gfc_deallocate_with_status (se.expr, pstat, false);
          gfc_add_expr_to_block (&se.pre, tmp);
 
          tmp = build2 (MODIFY_EXPR, void_type_node,