+2008-08-04 Doug Rupp <rupp@adacore.com>
+
+ * gcc-interface/utils2.c:
+ (fill_vms_descriptor): Raise CE if attempt made to pass 64bit pointer
+ in 32bit descriptor.
+
+2008-08-04 Robert Dewar <dewar@adacore.com>
+
+ * par-ch10.adb: Minor reformatting
+
+ * i-cobol.adb: Minor reformatting.
+
+2008-08-04 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <celier@adacore.com>
+
+ * 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 <charlet@adacore.com>
+
+ * sem_prag.adb (Check_Form_Of_Interface_Name): Fix handling for CLI
+ target.
+
+2008-08-04 Thomas Quinot <quinot@adacore.com>
+
+ * sem_ch10.adb: Minor comment fix.
+
2008-08-04 Robert Dewar <dewar@adacore.com>
* restrict.adb: Improved messages for restriction warnings
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));
}