From bdc33a55e85d7a895f88f70fb41b258955afd8e0 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 4 Aug 2008 11:07:31 +0200 Subject: [PATCH] 2008-08-04 Doug Rupp * gcc-interface/utils2.c: (fill_vms_descriptor): Raise CE if attempt made to pass 64bit pointer in 32bit descriptor. From-SVN: r138588 --- gcc/ada/ChangeLog | 37 +++++++++++++++++++++++++++++++++++++ gcc/ada/gcc-interface/utils2.c | 34 ++++++++++++++++++++++++++-------- 2 files changed, 63 insertions(+), 8 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 400d61d..65cc4f0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,40 @@ +2008-08-04 Doug Rupp + + * gcc-interface/utils2.c: + (fill_vms_descriptor): Raise CE if attempt made to pass 64bit pointer + in 32bit descriptor. + +2008-08-04 Robert Dewar + + * par-ch10.adb: Minor reformatting + + * i-cobol.adb: Minor reformatting. + +2008-08-04 Ed Schonberg + + * sem_ch3.adb (Access_Definition): Create an itype reference for an + anonymous access return type of a regular function that is not a + compilation unit. + +2008-08-04 Vincent Celier + + * prj-attr.adb: New Builder attribute Global_Compilation_Switches + + * snames.adb: New standard name Global_Compilation_Switches + + * snames.ads: New standard name Global_Compilation_Switches + + * make.adb: Correct spelling error in comment + +2008-08-04 Arnaud Charlet + + * sem_prag.adb (Check_Form_Of_Interface_Name): Fix handling for CLI + target. + +2008-08-04 Thomas Quinot + + * sem_ch10.adb: Minor comment fix. + 2008-08-04 Robert Dewar * restrict.adb: Improved messages for restriction warnings diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c index d1a6786..8cd6155 100644 --- a/gcc/ada/gcc-interface/utils2.c +++ b/gcc/ada/gcc-interface/utils2.c @@ -2169,19 +2169,37 @@ fill_vms_descriptor (tree expr, Entity_Id gnat_formal) tree field; tree parm_decl = get_gnu_tree (gnat_formal); tree const_list = NULL_TREE; - tree record_type; + tree record_type = TREE_TYPE (TREE_TYPE (parm_decl)); + int do_range_check = + strcmp ("MBO", + IDENTIFIER_POINTER (DECL_NAME (TYPE_FIELDS (record_type)))); - record_type = TREE_TYPE (TREE_TYPE (parm_decl)); expr = maybe_unconstrained_array (expr); gnat_mark_addressable (expr); for (field = TYPE_FIELDS (record_type); field; field = TREE_CHAIN (field)) - const_list - = tree_cons (field, - convert (TREE_TYPE (field), - SUBSTITUTE_PLACEHOLDER_IN_EXPR - (DECL_INITIAL (field), expr)), - const_list); + { + tree conexpr = convert (TREE_TYPE (field), + SUBSTITUTE_PLACEHOLDER_IN_EXPR + (DECL_INITIAL (field), expr)); + + /* Check to ensure that only 32bit pointers are passed in + 32bit descriptors */ + if (do_range_check && + strcmp (IDENTIFIER_POINTER (DECL_NAME (field)), "POINTER") == 0) + { + tree t = build3 (COND_EXPR, void_type_node, + build_binary_op (LT_EXPR, integer_type_node, + convert (integer_type_node, + conexpr), + integer_zero_node), + build_call_raise (CE_Range_Check_Failed, Empty, + N_Raise_Constraint_Error), + NULL_TREE); + add_stmt (t); + } + const_list = tree_cons (field, conexpr, const_list); + } return gnat_build_constructor (record_type, nreverse (const_list)); } -- 2.7.4